summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>2009-03-29 09:47:11 +0000
committerGravatar xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>2009-03-29 09:47:11 +0000
commita5f03d96eee482cd84861fc8cefff9eb451c0cad (patch)
treecbc66cbc183a7c5ef2c044ed9ed04b8011df9cd4
parenta9621943087a5578c995d88b06f87c5158eb5d00 (diff)
Cleaned up configure script.
Distribution of CIL as an expanded source tree with changes applied (instead of original .tar.gz + patches to be applied at config time). git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1020 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
-rw-r--r--LICENSE14
-rw-r--r--cil-1.3.5.tar.gzbin1139611 -> 0 bytes
-rw-r--r--cil.patch/Makefile.in.patch23
-rw-r--r--cil.patch/astslicer.ml.patch40
-rw-r--r--cil.patch/cabs2cil.ml.patch457
-rw-r--r--cil.patch/cfg.ml.patch55
-rw-r--r--cil.patch/check.ml.patch56
-rw-r--r--cil.patch/cil.ml.patch381
-rw-r--r--cil.patch/cil.mli.patch59
-rw-r--r--cil.patch/clexer.mll.patch24
-rw-r--r--cil.patch/dataflow.ml.patch27
-rw-r--r--cil.patch/dataslicing.ml.patch28
-rw-r--r--cil.patch/formatparse.mly.patch40
-rw-r--r--cil.patch/mergecil.ml.patch25
-rw-r--r--cil.patch/oneret.ml.patch38
-rw-r--r--cil.patch/ptranal.ml.patch28
-rw-r--r--cil.patch/usedef.ml.patch38
-rw-r--r--cil/INSTALL41
-rw-r--r--cil/LICENSE35
-rw-r--r--cil/Makefile.gcc75
-rw-r--r--cil/Makefile.in656
-rw-r--r--cil/Makefile.msvc42
-rw-r--r--cil/README2
-rw-r--r--cil/bin/CilConfig.pm.in6
-rwxr-xr-xcil/bin/cilly152
-rwxr-xr-xcil/bin/cilly.bat.in1
-rwxr-xr-xcil/bin/patcher605
-rwxr-xr-xcil/bin/patcher.bat.in1
-rwxr-xr-xcil/bin/teetwo36
-rwxr-xr-xcil/bin/test-bad202
-rw-r--r--cil/cil.spec90
-rw-r--r--cil/cil.spec.in90
-rwxr-xr-xcil/config.guess1497
-rw-r--r--cil/config.h.in23
-rwxr-xr-xcil/config.sub1469
-rwxr-xr-xcil/configure5697
-rw-r--r--cil/configure.in600
-rw-r--r--cil/doc/CIL-API.pdfbin0 -> 226152 bytes
-rw-r--r--cil/doc/CIL.pdfbin0 -> 269328 bytes
-rw-r--r--cil/doc/api/Alpha.html79
-rw-r--r--cil/doc/api/Cfg.html69
-rw-r--r--cil/doc/api/Cil.cilPrinter.html118
-rw-r--r--cil/doc/api/Cil.cilVisitor.html125
-rw-r--r--cil/doc/api/Cil.defaultCilPrinterClass.html36
-rw-r--r--cil/doc/api/Cil.html3337
-rw-r--r--cil/doc/api/Cil.nopCilVisitor.html35
-rw-r--r--cil/doc/api/Cil.plainCilPrinterClass.html36
-rw-r--r--cil/doc/api/Cillower.html40
-rw-r--r--cil/doc/api/Clist.html118
-rw-r--r--cil/doc/api/Dataflow.BackwardsDataFlow.html54
-rw-r--r--cil/doc/api/Dataflow.BackwardsTransfer.html83
-rw-r--r--cil/doc/api/Dataflow.ForwardsDataFlow.html53
-rw-r--r--cil/doc/api/Dataflow.ForwardsTransfer.html88
-rw-r--r--cil/doc/api/Dataflow.html114
-rw-r--r--cil/doc/api/Dominators.html58
-rw-r--r--cil/doc/api/Errormsg.html141
-rw-r--r--cil/doc/api/Formatcil.html84
-rw-r--r--cil/doc/api/Pretty.MakeMapPrinter.html63
-rw-r--r--cil/doc/api/Pretty.MakeSetPrinter.html63
-rw-r--r--cil/doc/api/Pretty.html268
-rw-r--r--cil/doc/api/Stats.html69
-rw-r--r--cil/doc/api/index.html83
-rw-r--r--cil/doc/api/index_attributes.html30
-rw-r--r--cil/doc/api/index_class_types.html41
-rw-r--r--cil/doc/api/index_classes.html46
-rw-r--r--cil/doc/api/index_exceptions.html53
-rw-r--r--cil/doc/api/index_methods.html228
-rw-r--r--cil/doc/api/index_module_types.html36
-rw-r--r--cil/doc/api/index_modules.html108
-rw-r--r--cil/doc/api/index_types.html271
-rw-r--r--cil/doc/api/index_values.html1964
-rw-r--r--cil/doc/api/style.css32
-rw-r--r--cil/doc/api/type_Alpha.html43
-rw-r--r--cil/doc/api/type_Cfg.html35
-rw-r--r--cil/doc/api/type_Cil.cilPrinter.html48
-rw-r--r--cil/doc/api/type_Cil.cilVisitor.html43
-rw-r--r--cil/doc/api/type_Cil.defaultCilPrinterClass.html25
-rw-r--r--cil/doc/api/type_Cil.html622
-rw-r--r--cil/doc/api/type_Cil.nopCilVisitor.html25
-rw-r--r--cil/doc/api/type_Cil.plainCilPrinterClass.html25
-rw-r--r--cil/doc/api/type_Cillower.html25
-rw-r--r--cil/doc/api/type_Clist.html44
-rw-r--r--cil/doc/api/type_Dataflow.BackwardsDataFlow.html26
-rw-r--r--cil/doc/api/type_Dataflow.BackwardsTransfer.html44
-rw-r--r--cil/doc/api/type_Dataflow.ForwardsDataFlow.html25
-rw-r--r--cil/doc/api/type_Dataflow.ForwardsTransfer.html51
-rw-r--r--cil/doc/api/type_Dataflow.html85
-rw-r--r--cil/doc/api/type_Dominators.html32
-rw-r--r--cil/doc/api/type_Errormsg.html64
-rw-r--r--cil/doc/api/type_Formatcil.html45
-rw-r--r--cil/doc/api/type_Pretty.MakeMapPrinter.html42
-rw-r--r--cil/doc/api/type_Pretty.MakeSetPrinter.html40
-rw-r--r--cil/doc/api/type_Pretty.html111
-rw-r--r--cil/doc/api/type_Stats.html36
-rw-r--r--cil/doc/changes.html486
-rw-r--r--cil/doc/cil.css10
-rw-r--r--cil/doc/cil.html3532
-rw-r--r--cil/doc/cil.version.tex2
-rw-r--r--cil/doc/cil001.html134
-rw-r--r--cil/doc/cil002.html98
-rw-r--r--cil/doc/cil003.html187
-rw-r--r--cil/doc/cil004.html350
-rw-r--r--cil/doc/cil006.html627
-rw-r--r--cil/doc/cil007.html279
-rw-r--r--cil/doc/cil009.html48
-rw-r--r--cil/doc/cil010.html100
-rw-r--r--cil/doc/cil011.html53
-rw-r--r--cil/doc/cil012.html133
-rw-r--r--cil/doc/cil015.html60
-rw-r--r--cil/doc/cil016.html342
-rw-r--r--cil/doc/cil017.html53
-rw-r--r--cil/doc/cil018.html71
-rw-r--r--cil/doc/cil019.html45
-rw-r--r--cil/doc/cilly.html187
-rw-r--r--cil/doc/cilpp.haux64
-rw-r--r--cil/doc/cilpp.htoc65
-rw-r--r--cil/doc/ciltoc.html92
-rw-r--r--cil/doc/contents_motif.gifbin0 -> 316 bytes
-rw-r--r--cil/doc/examples/ex1.txt16
-rw-r--r--cil/doc/examples/ex10.txt10
-rw-r--r--cil/doc/examples/ex11.txt5
-rw-r--r--cil/doc/examples/ex12.txt32
-rw-r--r--cil/doc/examples/ex13.txt21
-rw-r--r--cil/doc/examples/ex14.txt22
-rw-r--r--cil/doc/examples/ex15.txt14
-rw-r--r--cil/doc/examples/ex16.txt22
-rw-r--r--cil/doc/examples/ex17.txt81
-rw-r--r--cil/doc/examples/ex18.txt20
-rw-r--r--cil/doc/examples/ex19.txt42
-rw-r--r--cil/doc/examples/ex2.txt9
-rw-r--r--cil/doc/examples/ex20.txt26
-rw-r--r--cil/doc/examples/ex21.txt25
-rw-r--r--cil/doc/examples/ex22.txt16
-rw-r--r--cil/doc/examples/ex23.txt56
-rw-r--r--cil/doc/examples/ex24.txt59
-rw-r--r--cil/doc/examples/ex25.txt40
-rw-r--r--cil/doc/examples/ex26.txt29
-rw-r--r--cil/doc/examples/ex27.txt51
-rw-r--r--cil/doc/examples/ex28.txt24
-rw-r--r--cil/doc/examples/ex29.txt53
-rw-r--r--cil/doc/examples/ex3.txt20
-rw-r--r--cil/doc/examples/ex30.txt12
-rw-r--r--cil/doc/examples/ex31.txt12
-rw-r--r--cil/doc/examples/ex32.txt16
-rw-r--r--cil/doc/examples/ex33.txt24
-rw-r--r--cil/doc/examples/ex34.txt15
-rw-r--r--cil/doc/examples/ex35.txt32
-rw-r--r--cil/doc/examples/ex36.txt20
-rw-r--r--cil/doc/examples/ex37.txt14
-rw-r--r--cil/doc/examples/ex38.txt12
-rw-r--r--cil/doc/examples/ex39.txt25
-rw-r--r--cil/doc/examples/ex4.txt16
-rw-r--r--cil/doc/examples/ex40.txt20
-rw-r--r--cil/doc/examples/ex41.txt69
-rw-r--r--cil/doc/examples/ex42.txt22
-rw-r--r--cil/doc/examples/ex43.txt46
-rw-r--r--cil/doc/examples/ex44.txt31
-rw-r--r--cil/doc/examples/ex45.txt11
-rw-r--r--cil/doc/examples/ex46.txt23
-rw-r--r--cil/doc/examples/ex47.txt28
-rw-r--r--cil/doc/examples/ex5.txt27
-rw-r--r--cil/doc/examples/ex6.txt7
-rw-r--r--cil/doc/examples/ex7.txt22
-rw-r--r--cil/doc/examples/ex8.txt13
-rw-r--r--cil/doc/examples/ex9.txt16
-rw-r--r--cil/doc/ext.html506
-rw-r--r--cil/doc/header.html18
-rw-r--r--cil/doc/index.html26
-rw-r--r--cil/doc/merger.html167
-rw-r--r--cil/doc/next_motif.gifbin0 -> 317 bytes
-rw-r--r--cil/doc/patcher.html126
-rw-r--r--cil/doc/previous_motif.gifbin0 -> 317 bytes
-rw-r--r--cil/install-sh251
-rw-r--r--cil/lib/Cilly.pm2137
-rw-r--r--cil/lib/KeptFile.pm88
-rw-r--r--cil/lib/OutputFile.pm213
-rw-r--r--cil/lib/TempFile.pm90
-rw-r--r--cil/ocamlutil/Makefile.ocaml395
-rw-r--r--cil/ocamlutil/Makefile.ocaml.build50
-rwxr-xr-xcil/ocamlutil/alpha.ml156
-rwxr-xr-xcil/ocamlutil/alpha.mli50
-rw-r--r--cil/ocamlutil/clist.ml183
-rw-r--r--cil/ocamlutil/clist.mli97
-rw-r--r--cil/ocamlutil/errormsg.ml337
-rw-r--r--cil/ocamlutil/errormsg.mli164
-rw-r--r--cil/ocamlutil/growArray.ml191
-rw-r--r--cil/ocamlutil/growArray.mli131
-rwxr-xr-xcil/ocamlutil/inthash.ml188
-rwxr-xr-xcil/ocamlutil/inthash.mli27
-rwxr-xr-xcil/ocamlutil/intmap.ml171
-rwxr-xr-xcil/ocamlutil/intmap.mli87
-rwxr-xr-xcil/ocamlutil/perfcount.c.in184
-rw-r--r--cil/ocamlutil/pretty.ml859
-rw-r--r--cil/ocamlutil/pretty.mli316
-rw-r--r--cil/ocamlutil/stats.ml146
-rw-r--r--cil/ocamlutil/stats.mli72
-rw-r--r--cil/ocamlutil/trace.ml169
-rw-r--r--cil/ocamlutil/trace.mli106
-rwxr-xr-xcil/ocamlutil/util.ml815
-rw-r--r--cil/ocamlutil/util.mli311
-rw-r--r--cil/src/check.ml1017
-rw-r--r--cil/src/check.mli45
-rw-r--r--cil/src/cil.ml6427
-rw-r--r--cil/src/cil.mli2455
-rwxr-xr-xcil/src/cillower.ml57
-rwxr-xr-xcil/src/cillower.mli42
-rwxr-xr-xcil/src/ciloptions.ml196
-rwxr-xr-xcil/src/ciloptions.mli48
-rw-r--r--cil/src/cilutil.ml72
-rw-r--r--cil/src/escape.ml93
-rw-r--r--cil/src/escape.mli48
-rw-r--r--cil/src/ext/astslicer.ml454
-rw-r--r--cil/src/ext/availexps.ml359
-rw-r--r--cil/src/ext/bitmap.ml224
-rw-r--r--cil/src/ext/bitmap.mli50
-rw-r--r--cil/src/ext/blockinggraph.ml769
-rw-r--r--cil/src/ext/blockinggraph.mli40
-rw-r--r--cil/src/ext/callgraph.ml250
-rw-r--r--cil/src/ext/callgraph.mli123
-rw-r--r--cil/src/ext/canonicalize.ml292
-rw-r--r--cil/src/ext/canonicalize.mli48
-rw-r--r--cil/src/ext/cfg.ml289
-rw-r--r--cil/src/ext/cfg.mli36
-rwxr-xr-xcil/src/ext/ciltools.ml228
-rwxr-xr-xcil/src/ext/dataflow.ml466
-rwxr-xr-xcil/src/ext/dataflow.mli151
-rw-r--r--cil/src/ext/dataslicing.ml462
-rw-r--r--cil/src/ext/dataslicing.mli41
-rw-r--r--cil/src/ext/deadcodeelim.ml173
-rwxr-xr-xcil/src/ext/dominators.ml241
-rwxr-xr-xcil/src/ext/dominators.mli29
-rw-r--r--cil/src/ext/epicenter.ml114
-rw-r--r--cil/src/ext/heap.ml112
-rw-r--r--cil/src/ext/heapify.ml250
-rw-r--r--cil/src/ext/liveness.ml190
-rw-r--r--cil/src/ext/logcalls.ml268
-rw-r--r--cil/src/ext/logcalls.mli41
-rw-r--r--cil/src/ext/logwrites.ml139
-rw-r--r--cil/src/ext/oneret.ml187
-rw-r--r--cil/src/ext/oneret.mli44
-rw-r--r--cil/src/ext/partial.ml851
-rw-r--r--cil/src/ext/pta/golf.ml1657
-rw-r--r--cil/src/ext/pta/golf.mli83
-rw-r--r--cil/src/ext/pta/olf.ml1108
-rw-r--r--cil/src/ext/pta/olf.mli80
-rw-r--r--cil/src/ext/pta/ptranal.ml597
-rw-r--r--cil/src/ext/pta/ptranal.mli156
-rw-r--r--cil/src/ext/pta/setp.ml342
-rw-r--r--cil/src/ext/pta/setp.mli180
-rw-r--r--cil/src/ext/pta/steensgaard.ml1417
-rw-r--r--cil/src/ext/pta/steensgaard.mli71
-rw-r--r--cil/src/ext/pta/uref.ml94
-rw-r--r--cil/src/ext/pta/uref.mli65
-rw-r--r--cil/src/ext/reachingdefs.ml511
-rwxr-xr-xcil/src/ext/sfi.ml337
-rw-r--r--cil/src/ext/simplemem.ml132
-rwxr-xr-xcil/src/ext/simplify.ml845
-rw-r--r--cil/src/ext/ssa.ml696
-rw-r--r--cil/src/ext/ssa.mli45
-rw-r--r--cil/src/ext/stackoverflow.ml246
-rw-r--r--cil/src/ext/stackoverflow.mli43
-rwxr-xr-xcil/src/ext/usedef.ml188
-rw-r--r--cil/src/formatcil.ml215
-rw-r--r--cil/src/formatcil.mli103
-rw-r--r--cil/src/formatlex.mll308
-rw-r--r--cil/src/formatparse.mly1455
-rw-r--r--cil/src/frontc/cabs.ml396
-rw-r--r--cil/src/frontc/cabs2cil.ml6238
-rw-r--r--cil/src/frontc/cabs2cil.mli49
-rw-r--r--cil/src/frontc/cabsvisit.ml577
-rw-r--r--cil/src/frontc/cabsvisit.mli115
-rw-r--r--cil/src/frontc/clexer.mli55
-rw-r--r--cil/src/frontc/clexer.mll664
-rw-r--r--cil/src/frontc/cparser.mly1521
-rw-r--r--cil/src/frontc/cprint.ml1014
-rw-r--r--cil/src/frontc/frontc.ml256
-rw-r--r--cil/src/frontc/frontc.mli55
-rwxr-xr-xcil/src/frontc/lexerhack.ml22
-rw-r--r--cil/src/frontc/patch.ml837
-rw-r--r--cil/src/frontc/patch.mli42
-rw-r--r--cil/src/libmaincil.ml108
-rw-r--r--cil/src/machdep.c220
-rw-r--r--cil/src/main.ml288
-rw-r--r--cil/src/mergecil.ml1770
-rw-r--r--cil/src/mergecil.mli42
-rw-r--r--cil/src/rmtmps.ml778
-rw-r--r--cil/src/rmtmps.mli82
-rw-r--r--cil/src/testcil.ml440
-rw-r--r--cil/test/small1/func.c24
-rw-r--r--cil/test/small1/hello.c8
-rw-r--r--cil/test/small1/init.c177
-rw-r--r--cil/test/small1/init1.c17
-rw-r--r--cil/test/small1/testharness.h17
-rw-r--r--cil/test/small1/vararg1.c47
-rw-r--r--cil/test/small1/wchar1.c24
-rwxr-xr-xconfigure112
296 files changed, 82317 insertions, 1356 deletions
diff --git a/LICENSE b/LICENSE
index 3626820..373ee65 100644
--- a/LICENSE
+++ b/LICENSE
@@ -37,14 +37,12 @@ files are free software and can be used both in commercial and
non-commercial contexts, subject to the terms of the GNU General
Public License.
-This distribution includes a copy of the CIL library and modifications
-to this library in the form of patches. The CIL library is Copyright
-2001-2005 George C. Necula, Scott McPeak, Wes Weimer and Ben Liblit.
-The modifications contained in the sub-directory cil.patches/ of this
-distribution are Copyright 2006, 2007, 2008, 2009 Institut National de
-Recherche en Informatique et en Automatique. The CIL library and the
-modifications contained in the sub-directory cil.patches/ are
-distributed under the terms of the BSD license, included below.
+This distribution includes a modified copy of the CIL library.
+The CIL library is Copyright 2001-2005 George C. Necula, Scott McPeak,
+Wes Weimer and Ben Liblit. The modifications are Copyright 2006,
+2007, 2008, 2009 Institut National de Recherche en Informatique et en
+Automatique. The CIL library and the modifications are distributed
+under the terms of the BSD license, included below.
----------------------------------------------------------------------
diff --git a/cil-1.3.5.tar.gz b/cil-1.3.5.tar.gz
deleted file mode 100644
index 2c19144..0000000
--- a/cil-1.3.5.tar.gz
+++ /dev/null
Binary files differ
diff --git a/cil.patch/Makefile.in.patch b/cil.patch/Makefile.in.patch
deleted file mode 100644
index 7bc4ea1..0000000
--- a/cil.patch/Makefile.in.patch
+++ /dev/null
@@ -1,23 +0,0 @@
---- ../cil/Makefile.in.orig 2008-12-31 19:08:43.000000000 +0100
-+++ ../cil/Makefile.in 2008-12-31 19:09:00.000000000 +0100
-@@ -212,7 +212,7 @@
- # build two libraries
- .PHONY: cillib libcil
- ifeq ($(NATIVECAML),1)
--cillib: $(OBJDIR)/cil.$(CMXA) $(OBJDIR)/libcil.a
-+cillib: $(OBJDIR)/cil.$(CMXA) # $(OBJDIR)/libcil.a
- else
- cillib: $(OBJDIR)/cil.$(CMXA)
- endif
-@@ -243,9 +243,9 @@
- echo " Zrapp.feature;" >> $@
- endif
- # Now the extra features, with the first letter capitalized
-- echo -ne \
-+ echo \
- $(foreach f,@EXTRAFEATURES@, \
-- `echo $f | cut -c 1 | tr "[a-z]" "[A-Z]"``echo $f | cut -c 2-`".feature;\n") >> $@
-+ `echo $f | cut -c 1 | tr "[a-z]" "[A-Z]"``echo $f | cut -c 2-`".feature;") >> $@
- echo "]" >>$@
- # Must delete main.d and remake it, because it may have been made
- # before feature_config existed.
diff --git a/cil.patch/astslicer.ml.patch b/cil.patch/astslicer.ml.patch
deleted file mode 100644
index e8d0195..0000000
--- a/cil.patch/astslicer.ml.patch
+++ /dev/null
@@ -1,40 +0,0 @@
-*** ../cil/src/ext/astslicer.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/astslicer.ml 2006-06-20 17:24:22.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 97,103 ****
---- 99,110 ----
- Printf.fprintf out ")\n" ;
- incr i
- | Switch(_,b,_,_)
-+ (*
- | Loop(b,_,_,_)
-+ *)
-+ | While(_,b,_)
-+ | DoWhile(_,b,_)
-+ | For(_,_,_,b,_)
- | Block(b) ->
- emit base i st_ht s ;
- decr i ;
-***************
-*** 371,377 ****
---- 378,389 ----
- doBlock b2 base'' i'' inside ;
- incr i
- | Switch(_,b,_,_)
-+ (*
- | Loop(b,_,_,_)
-+ *)
-+ | While(_,b,_)
-+ | DoWhile(_,b,_)
-+ | For(_,_,_,b,_)
- | Block(b) ->
- let inside = check base i default in
- mark ws s inside ;
diff --git a/cil.patch/cabs2cil.ml.patch b/cil.patch/cabs2cil.ml.patch
deleted file mode 100644
index 74ae0c7..0000000
--- a/cil.patch/cabs2cil.ml.patch
+++ /dev/null
@@ -1,457 +0,0 @@
-*** ../cil.orig/src/frontc/cabs2cil.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil/src/frontc/cabs2cil.ml 2008-04-19 10:17:27.000000000 +0200
-***************
-*** 1,3 ****
---- 1,11 ----
-+ (* MODIF: allow E.Error to propagate *)
-+
-+ (* MODIF: for pointer comparison, avoid systematic cast to unsigned int *)
-+
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+ (* MODIF: Return statement no longer added when the body of the function
-+ falls-through. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 816,828 ****
- (fun s ->
- if s.labels != [] then
- raise (Failure "cannot duplicate: has labels");
- (match s.skind with
-! If _ | Switch _ | Loop _ | Block _ ->
- raise (Failure "cannot duplicate: complex stmt")
- | Instr il ->
- pCount := !pCount + List.length il
- | _ -> incr pCount);
- if !pCount > 5 then raise (Failure ("cannot duplicate: too many instr"));
- (* We can just copy it because there is nothing to share here.
- * Except maybe for the ref cell in Goto but it is Ok to share
- * that, I think *)
---- 824,839 ----
- (fun s ->
- if s.labels != [] then
- raise (Failure "cannot duplicate: has labels");
-+ (*
- (match s.skind with
-! If _ | Switch _ | (*Loop _*)
-! While _ | DoWhile _ | For _ | Block _ ->
- raise (Failure "cannot duplicate: complex stmt")
- | Instr il ->
- pCount := !pCount + List.length il
- | _ -> incr pCount);
- if !pCount > 5 then raise (Failure ("cannot duplicate: too many instr"));
-+ *)
- (* We can just copy it because there is nothing to share here.
- * Except maybe for the ref cell in Goto but it is Ok to share
- * that, I think *)
-***************
-*** 838,843 ****
---- 849,855 ----
- let canDrop (c: chunk) =
- List.for_all canDropStatement c.stmts
-
-+ (*
- let loopChunk (body: chunk) : chunk =
- (* Make the statement *)
- let loop = mkStmt (Loop (c2block body, !currentLoc, None, None)) in
-***************
-*** 845,850 ****
---- 857,889 ----
- postins = [];
- cases = body.cases;
- }
-+ *)
-+
-+ let whileChunk (e: exp) (body: chunk) : chunk =
-+ let loop = mkStmt (While (e, c2block body, !currentLoc)) in
-+
-+ { stmts = [ loop ];
-+ postins = [];
-+ cases = body.cases;
-+ }
-+
-+ let doWhileChunk (e: exp) (body: chunk) : chunk =
-+ let loop = mkStmt (DoWhile (e, c2block body, !currentLoc)) in
-+
-+ { stmts = [ loop ];
-+ postins = [];
-+ cases = body.cases;
-+ }
-+
-+ let forChunk (bInit: chunk) (e: exp) (bIter: chunk)
-+ (body: chunk) : chunk =
-+ let loop = mkStmt (For (c2block bInit, e, c2block bIter,
-+ c2block body, !currentLoc)) in
-+
-+ { stmts = [ loop ];
-+ postins = [];
-+ cases = body.cases;
-+ }
-
- let breakChunk (l: location) : chunk =
- { stmts = [ mkStmt (Break l) ];
-***************
-*** 959,964 ****
---- 998,1004 ----
-
-
- (************ Labels ***********)
-+ (*
- (* Since we turn dowhile and for loops into while we need to take care in
- * processing the continue statement. For each loop that we enter we place a
- * marker in a list saying what kinds of loop it is. When we see a continue
-***************
-*** 971,980 ****
---- 1011,1041 ----
-
- let startLoop iswhile =
- continues := (if iswhile then While else NotWhile (ref "")) :: !continues
-+ *)
-+
-+ (* We need to take care while processing the continue statement...
-+ * For each loop that we enter we place a marker in a list saying what
-+ * chunk of code we must duplicate before each continue statement
-+ * in order to preserve the semantics. *)
-+ type loopMarker =
-+ | DuplicateBeforeContinue of chunk
-+ | ContinueUnchanged
-+
-+ let continues : loopMarker list ref = ref []
-+
-+ let startLoop lstate =
-+ continues := lstate :: !continues
-+
-+ let continueDuplicateChunk (l: location) : chunk =
-+ match !continues with
-+ | [] -> E.s (error "continue not in a loop")
-+ | DuplicateBeforeContinue c :: _ -> c @@ continueChunk l
-+ | ContinueUnchanged :: _ -> continueChunk l
-
- (* Sometimes we need to create new label names *)
- let newLabelName (base: string) = fst (newAlphaName false "label" base)
-
-+ (*
- let continueOrLabelChunk (l: location) : chunk =
- match !continues with
- [] -> E.s (error "continue not in a loop")
-***************
-*** 990,995 ****
---- 1051,1057 ----
- [] -> E.s (error "labContinue not in a loop")
- | While :: rest -> c
- | NotWhile lr :: rest -> if !lr = "" then c else consLabel !lr c !currentLoc false
-+ *)
-
- let exitLoop () =
- match !continues with
-***************
-*** 4141,4151 ****
- | _ -> E.s (error "%a operator on a non-integer type" d_binop bop)
- in
- let pointerComparison e1 t1 e2 t2 =
-! (* Cast both sides to an integer *)
-! let commontype = !upointType in
- intType,
-! optConstFoldBinOp false bop (mkCastT e1 t1 commontype)
-! (mkCastT e2 t2 commontype) intType
- in
-
- match bop with
---- 4203,4211 ----
- | _ -> E.s (error "%a operator on a non-integer type" d_binop bop)
- in
- let pointerComparison e1 t1 e2 t2 =
-! (* XL: Do not cast both sides -- what's the point? *)
- intType,
-! optConstFoldBinOp false bop e1 e2 intType
- in
-
- match bop with
-***************
-*** 4194,4207 ****
-
- | (Eq|Ne|Le|Lt|Ge|Gt) when isPointerType t1 && isArithmeticType t2 ->
- ignore (warnOpt "Comparison of pointer and non-pointer");
-! (* Cast both values to upointType *)
-! doBinOp bop (mkCastT e1 t1 !upointType) !upointType
-! (mkCastT e2 t2 !upointType) !upointType
- | (Eq|Ne|Le|Lt|Ge|Gt) when isArithmeticType t1 && isPointerType t2 ->
- ignore (warnOpt "Comparison of pointer and non-pointer");
-! (* Cast both values to upointType *)
-! doBinOp bop (mkCastT e1 t1 !upointType) !upointType
-! (mkCastT e2 t2 !upointType) !upointType
-
- | _ -> E.s (error "doBinOp: %a\n" d_plainexp (BinOp(bop,e1,e2,intType)))
-
---- 4254,4267 ----
-
- | (Eq|Ne|Le|Lt|Ge|Gt) when isPointerType t1 && isArithmeticType t2 ->
- ignore (warnOpt "Comparison of pointer and non-pointer");
-! (* Cast both values to void * *)
-! doBinOp bop (mkCastT e1 t1 voidPtrType) voidPtrType
-! (mkCastT e2 t2 voidPtrType) voidPtrType
- | (Eq|Ne|Le|Lt|Ge|Gt) when isArithmeticType t1 && isPointerType t2 ->
- ignore (warnOpt "Comparison of pointer and non-pointer");
-! (* Cast both values to void * *)
-! doBinOp bop (mkCastT e1 t1 voidPtrType) voidPtrType
-! (mkCastT e2 t2 voidPtrType) voidPtrType
-
- | _ -> E.s (error "doBinOp: %a\n" d_plainexp (BinOp(bop,e1,e2,intType)))
-
-***************
-*** 5465,5473 ****
---- 5525,5538 ----
- * then the switch falls through. *)
- blockFallsThrough b || blockCanBreak b
- end
-+ (*
- | Loop (b, _, _, _) ->
- (* A loop falls through if it can break. *)
- blockCanBreak b
-+ *)
-+ | While (_, b, _) -> blockCanBreak b
-+ | DoWhile (_, b, _) -> blockCanBreak b
-+ | For (_, _, _, b, _) -> blockCanBreak b
- | Block b -> blockFallsThrough b
- | TryFinally (b, h, _) -> blockFallsThrough h
- | TryExcept (b, _, h, _) -> true (* Conservative *)
-***************
-*** 5512,5518 ****
- | Break _ -> true
- | If (_, b1, b2, _) ->
- blockCanBreak b1 || blockCanBreak b2
-! | Switch _ | Loop _ ->
- (* switches and loops catch any breaks in their bodies *)
- false
- | Block b -> blockCanBreak b
---- 5577,5583 ----
- | Break _ -> true
- | If (_, b1, b2, _) ->
- blockCanBreak b1 || blockCanBreak b2
-! | Switch _ | (*Loop _*) While _ | DoWhile _ | For _ ->
- (* switches and loops catch any breaks in their bodies *)
- false
- | Block b -> blockCanBreak b
-***************
-*** 5522,5527 ****
---- 5587,5593 ----
- List.exists stmtCanBreak b.bstmts
- in
- if blockFallsThrough !currentFunctionFDEC.sbody then begin
-+ (*
- let retval =
- match unrollType !currentReturnType with
- TVoid _ -> None
-***************
-*** 5537,5549 ****
- !currentFunctionFDEC.sbody.bstmts <-
- !currentFunctionFDEC.sbody.bstmts
- @ [mkStmt (Return(retval, endloc))]
- end;
-
- (* ignore (E.log "The env after finishing the body of %s:\n%t\n"
- n docEnv); *)
- cabsPushGlobal (GFun (!currentFunctionFDEC, funloc));
- empty
-! with e -> begin
- ignore (E.log "error in collectFunction %s: %s\n"
- n (Printexc.to_string e));
- cabsPushGlobal (GAsm("error in function " ^ n, !currentLoc));
---- 5603,5617 ----
- !currentFunctionFDEC.sbody.bstmts <-
- !currentFunctionFDEC.sbody.bstmts
- @ [mkStmt (Return(retval, endloc))]
-+ *)
- end;
-
- (* ignore (E.log "The env after finishing the body of %s:\n%t\n"
- n docEnv); *)
- cabsPushGlobal (GFun (!currentFunctionFDEC, funloc));
- empty
-! with E.Error as e -> raise e
-! | e -> begin
- ignore (E.log "error in collectFunction %s: %s\n"
- n (Printexc.to_string e));
- cabsPushGlobal (GAsm("error in function " ^ n, !currentLoc));
-***************
-*** 5596,5609 ****
- * local context *)
- addLocalToEnv (kindPlusName "type" n) (EnvTyp namedTyp);
- cabsPushGlobal (GType (ti, !currentLoc))
-! with e -> begin
- ignore (E.log "Error on A.TYPEDEF (%s)\n"
- (Printexc.to_string e));
- cabsPushGlobal (GAsm ("booo_typedef:" ^ n, !currentLoc))
- end
- in
- List.iter createTypedef nl
-! with e -> begin
- ignore (E.log "Error on A.TYPEDEF (%s)\n"
- (Printexc.to_string e));
- let fstname =
---- 5664,5679 ----
- * local context *)
- addLocalToEnv (kindPlusName "type" n) (EnvTyp namedTyp);
- cabsPushGlobal (GType (ti, !currentLoc))
-! with E.Error as e -> raise e
-! | e -> begin
- ignore (E.log "Error on A.TYPEDEF (%s)\n"
- (Printexc.to_string e));
- cabsPushGlobal (GAsm ("booo_typedef:" ^ n, !currentLoc))
- end
- in
- List.iter createTypedef nl
-! with E.Error as e -> raise e
-! | e -> begin
- ignore (E.log "Error on A.TYPEDEF (%s)\n"
- (Printexc.to_string e));
- let fstname =
-***************
-*** 5650,5656 ****
- | _ ->
- ignore (warn "Ignoring un-named typedef that does not introduce a struct or enumeration type\n")
-
-! with e -> begin
- ignore (E.log "Error on A.ONLYTYPEDEF (%s)\n"
- (Printexc.to_string e));
- cabsPushGlobal (GAsm ("booo_typedef", !currentLoc))
---- 5720,5727 ----
- | _ ->
- ignore (warn "Ignoring un-named typedef that does not introduce a struct or enumeration type\n")
-
-! with E.Error as e -> raise e
-! | e -> begin
- ignore (E.log "Error on A.ONLYTYPEDEF (%s)\n"
- (Printexc.to_string e));
- cabsPushGlobal (GAsm ("booo_typedef", !currentLoc))
-***************
-*** 5738,5743 ****
---- 5809,5815 ----
- doCondition false e st' sf'
-
- | A.WHILE(e,s,loc) ->
-+ (*
- startLoop true;
- let s' = doStatement s in
- exitLoop ();
-***************
-*** 5746,5753 ****
---- 5818,5844 ----
- loopChunk ((doCondition false e skipChunk
- (breakChunk loc'))
- @@ s')
-+ *)
-+ (** We need to convert A.WHILE(e,s) where e may have side effects
-+ into Cil.While(e',s') where e' is side-effect free. *)
-+
-+ (* Let e == (sCond , eCond) with sCond a sequence of statements
-+ and eCond a side-effect free expression. *)
-+ let (sCond, eCond, _) = doExp false e (AExp None) in
-+
-+ (* Then doStatement(A.WHILE((sCond , eCond), s))
-+ = sCond ; Cil.While(eCond, (doStatement(s) ; sCond))
-+ where doStatement(A.CONTINUE) = (sCond ; Cil.Continue). *)
-+
-+ startLoop (DuplicateBeforeContinue sCond);
-+ let s' = doStatement s in
-+ exitLoop ();
-+ let loc' = convLoc loc in
-+ currentLoc := loc';
-+ sCond @@ (whileChunk eCond (s' @@ sCond))
-
- | A.DOWHILE(e,s,loc) ->
-+ (*
- startLoop false;
- let s' = doStatement s in
- let loc' = convLoc loc in
-***************
-*** 5757,5764 ****
- in
- exitLoop ();
- loopChunk (s' @@ s'')
-
-! | A.FOR(fc1,e2,e3,s,loc) -> begin
- let loc' = convLoc loc in
- currentLoc := loc';
- enterScope (); (* Just in case we have a declaration *)
---- 5848,5874 ----
- in
- exitLoop ();
- loopChunk (s' @@ s'')
-+ *)
-+ (** We need to convert A.DOWHILE(e,s) where e may have side effects
-+ into Cil.DoWhile(e',s') where e' is side-effect free. *)
-+
-+ (* Let e == (sCond , eCond) with sCond a sequence of statements
-+ and eCond a side-effect free expression. *)
-+ let (sCond, eCond, _) = doExp false e (AExp None) in
-+
-+ (* Then doStatement(A.DOWHILE((sCond , eCond), s))
-+ = Cil.DoWhile(eCond, (doStatement(s) ; sCond))
-+ where doStatement(A.CONTINUE) = (sCond ; Cil.Continue). *)
-+
-+ startLoop (DuplicateBeforeContinue sCond);
-+ let s' = doStatement s in
-+ exitLoop ();
-+ let loc' = convLoc loc in
-+ currentLoc := loc';
-+ doWhileChunk eCond (s' @@ sCond)
-
-! | A.FOR(fc1,e2,e3,s,loc) ->
-! (*begin
- let loc' = convLoc loc in
- currentLoc := loc';
- enterScope (); (* Just in case we have a declaration *)
-***************
-*** 5784,5789 ****
---- 5894,5928 ----
- exitScope ();
- res
- end
-+ *)
-+ (** We need to convert A.FOR(e1,e2,e3,s) where e1, e2 and e3 may
-+ have side effects into Cil.For(bInit,e2',bIter,s') where e2'
-+ is side-effect free. **)
-+
-+ (* Let e1 == bInit be a block of statements
-+ Let e2 == (bCond , eCond) with bCond a block of statements
-+ and eCond a side-effect free expression
-+ Let e3 == bIter be a sequence of statements. *)
-+ let (bInit, _, _) = match fc1 with
-+ | FC_EXP e1 -> doExp false e1 ADrop
-+ | FC_DECL d1 -> (doDecl false d1, zero, voidType) in
-+ let (bCond, eCond, _) = doExp false e2 (AExp None) in
-+ let eCond' = match eCond with
-+ | Const(CStr "exp_nothing") -> Cil.one
-+ | _ -> eCond in
-+ let (bIter, _, _) = doExp false e3 ADrop in
-+
-+ (* Then doStatement(A.FOR(bInit, (bCond , eCond), bIter, s))
-+ = Cil.For({bInit; bCond}, eCond', {bIter; bCond}, {doStatement(s)})
-+ where doStatement(A.CONTINUE) = Cil.Continue. *)
-+
-+ startLoop ContinueUnchanged;
-+ let s' = doStatement s in
-+ exitLoop ();
-+ let loc' = convLoc loc in
-+ currentLoc := loc';
-+ (forChunk (bInit @@ bCond) eCond' (bIter @@ bCond) s')
-+
- | A.BREAK loc ->
- let loc' = convLoc loc in
- currentLoc := loc';
-***************
-*** 5792,5798 ****
---- 5931,5940 ----
- | A.CONTINUE loc ->
- let loc' = convLoc loc in
- currentLoc := loc';
-+ (*
- continueOrLabelChunk loc'
-+ *)
-+ continueDuplicateChunk loc'
-
- | A.RETURN (A.NOTHING, loc) ->
- let loc' = convLoc loc in
diff --git a/cil.patch/cfg.ml.patch b/cil.patch/cfg.ml.patch
deleted file mode 100644
index 9629d46..0000000
--- a/cil.patch/cfg.ml.patch
+++ /dev/null
@@ -1,55 +0,0 @@
-*** ../cil/src/ext/cfg.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/cfg.ml 2006-06-20 17:42:04.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2003,
-***************
-*** 156,162 ****
---- 158,169 ----
- then
- addOptionSucc next;
- cfgBlock blk next next cont
-+ (*
- | Loop(blk,_,_,_) ->
-+ *)
-+ | While(_,blk,_)
-+ | DoWhile(_,blk,_)
-+ | For(_,_,_,blk,_) ->
- addBlockSucc blk;
- cfgBlock blk (Some s) next (Some s)
- (* Since all loops have terminating condition true, we don't put
-***************
-*** 184,190 ****
---- 191,202 ----
- | Block b -> fasBlock todo b
- | If (_, tb, fb, _) -> (fasBlock todo tb; fasBlock todo fb)
- | Switch (_, b, _, _) -> fasBlock todo b
-+ (*
- | Loop (b, _, _, _) -> fasBlock todo b
-+ *)
-+ | While (_, b, _) -> fasBlock todo b
-+ | DoWhile (_, b, _) -> fasBlock todo b
-+ | For (_, _, _, b, _) -> fasBlock todo b
- | (Return _ | Break _ | Continue _ | Goto _ | Instr _) -> ()
- | TryExcept _ | TryFinally _ -> E.s (E.unimp "try/except/finally")
- end
-***************
-*** 201,207 ****
---- 213,224 ----
- begin
- match s.skind with
- | If (e, _, _, _) -> "if" (*sprint ~width:999 (dprintf "if %a" d_exp e)*)
-+ (*
- | Loop _ -> "loop"
-+ *)
-+ | While _ -> "while"
-+ | DoWhile _ -> "dowhile"
-+ | For _ -> "for"
- | Break _ -> "break"
- | Continue _ -> "continue"
- | Goto _ -> "goto"
diff --git a/cil.patch/check.ml.patch b/cil.patch/check.ml.patch
deleted file mode 100644
index 7fe183f..0000000
--- a/cil.patch/check.ml.patch
+++ /dev/null
@@ -1,56 +0,0 @@
-*** ../cil/src/check.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/check.ml 2006-06-21 11:13:35.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 661,667 ****
- (fun _ ->
- (* Print context only for certain small statements *)
- match s.skind with
-! Loop _ | If _ | Switch _ -> nil
- | _ -> dprintf "checkStmt: %a" d_stmt s)
- (fun _ ->
- (* Check the labels *)
---- 663,669 ----
- (fun _ ->
- (* Print context only for certain small statements *)
- match s.skind with
-! (*Loop _*) While _ | DoWhile _ | For _ | If _ | Switch _ -> nil
- | _ -> dprintf "checkStmt: %a" d_stmt s)
- (fun _ ->
- (* Check the labels *)
-***************
-*** 704,710 ****
---- 706,731 ----
- | None, _ -> ignore (warn "Invalid return value")
- | Some re', rt' -> checkExpType false re' rt'
- end
-+ (*
- | Loop (b, l, _, _) -> checkBlock b
-+ *)
-+ | While (e, b, l) ->
-+ currentLoc := l;
-+ let te = checkExp false e in
-+ checkBooleanType te;
-+ checkBlock b;
-+ | DoWhile (e, b, l) ->
-+ currentLoc := l;
-+ let te = checkExp false e in
-+ checkBooleanType te;
-+ checkBlock b;
-+ | For (bInit, e, bIter, b, l) ->
-+ currentLoc := l;
-+ checkBlock bInit;
-+ let te = checkExp false e in
-+ checkBooleanType te;
-+ checkBlock bIter;
-+ checkBlock b;
- | Block b -> checkBlock b
- | If (e, bt, bf, l) ->
- currentLoc := l;
diff --git a/cil.patch/cil.ml.patch b/cil.patch/cil.ml.patch
deleted file mode 100644
index a49b73d..0000000
--- a/cil.patch/cil.ml.patch
+++ /dev/null
@@ -1,381 +0,0 @@
-*** ../cil/src/cil.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/cil.ml 2006-07-25 10:57:30.686790845 +0200
-***************
-*** 1,3 ****
---- 1,6 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+ (* MODIF: useLogicalOperators flag set to true by default. *)
-+
- (*
- *
- * Copyright (c) 2001-2003,
-***************
-*** 63,69 ****
- * print output for the MS VC
- * compiler. Default is GCC *)
-
-! let useLogicalOperators = ref false
-
-
- module M = Machdep
---- 66,72 ----
- * print output for the MS VC
- * compiler. Default is GCC *)
-
-! let useLogicalOperators = ref (*false*) true
-
-
- module M = Machdep
-***************
-*** 684,692 ****
- | Goto of stmt ref * location (** A goto statement. Appears from
- actual goto's in the code. *)
- | Break of location (** A break to the end of the nearest
-! enclosing Loop or Switch *)
- | Continue of location (** A continue to the start of the
-! nearest enclosing [Loop] *)
- | If of exp * block * block * location (** A conditional.
- Two successors, the "then" and
- the "else" branches. Both
---- 687,695 ----
- | Goto of stmt ref * location (** A goto statement. Appears from
- actual goto's in the code. *)
- | Break of location (** A break to the end of the nearest
-! enclosing loop or Switch *)
- | Continue of location (** A continue to the start of the
-! nearest enclosing loop *)
- | If of exp * block * block * location (** A conditional.
- Two successors, the "then" and
- the "else" branches. Both
-***************
-*** 701,706 ****
---- 704,710 ----
- you can get from the labels of the
- statement *)
-
-+ (*
- | Loop of block * location * (stmt option) * (stmt option)
- (** A [while(1)] loop. The
- * termination test is implemented
-***************
-*** 713,718 ****
---- 717,726 ----
- * and the second will point to
- * the stmt containing the break
- * label for this loop. *)
-+ *)
-+ | While of exp * block * location (** A while loop. *)
-+ | DoWhile of exp * block * location (** A do...while loop. *)
-+ | For of block * exp * block * block * location (** A for loop. *)
-
- | Block of block (** Just a block of statements. Use it
- as a way to keep some attributes
-***************
-*** 1040,1046 ****
---- 1048,1059 ----
- | Continue(loc) -> loc
- | If(_, _, _, loc) -> loc
- | Switch (_, _, _, loc) -> loc
-+ (*
- | Loop (_, loc, _, _) -> loc
-+ *)
-+ | While (_, _, loc) -> loc
-+ | DoWhile (_, _, loc) -> loc
-+ | For (_, _, _, _, loc) -> loc
- | Block b -> if b.bstmts == [] then lu
- else get_stmtLoc ((List.hd b.bstmts).skind)
- | TryFinally (_, _, l) -> l
-***************
-*** 1524,1533 ****
---- 1537,1549 ----
-
- let mkWhile ~(guard:exp) ~(body: stmt list) : stmt list =
- (* Do it like this so that the pretty printer recognizes it *)
-+ (*
- [ mkStmt (Loop (mkBlock (mkStmt (If(guard,
- mkBlock [ mkEmptyStmt () ],
- mkBlock [ mkStmt (Break lu)], lu)) ::
- body), lu, None, None)) ]
-+ *)
-+ [ mkStmt (While (guard, mkBlock body, lu)) ]
-
-
-
-***************
-*** 3448,3453 ****
---- 3464,3471 ----
- ++ self#pExp () e
- ++ text ") "
- ++ self#pBlock () b)
-+
-+ (*
- | Loop(b, l, _, _) -> begin
- (* Maybe the first thing is a conditional. Turn it into a WHILE *)
- try
-***************
-*** 3484,3489 ****
---- 3502,3540 ----
- ++ text "ile (1) "
- ++ self#pBlock () b)
- end
-+ *)
-+
-+ | While (e, b, l) ->
-+ self#pLineDirective l
-+ ++ (align
-+ ++ text "while ("
-+ ++ self#pExp () e
-+ ++ text ") "
-+ ++ self#pBlock () b)
-+
-+ | DoWhile (e, b, l) ->
-+ self#pLineDirective l
-+ ++ (align
-+ ++ text "do "
-+ ++ self#pBlock () b
-+ ++ text " while ("
-+ ++ self#pExp () e
-+ ++ text ");")
-+
-+ | For (bInit, e, bIter, b, l) ->
-+ ignore (E.warn
-+ "in for loops, the 1st and 3rd expressions are not printed");
-+ self#pLineDirective l
-+ ++ (align
-+ ++ text "for ("
-+ ++ text "/* ??? */" (* self#pBlock () bInit *)
-+ ++ text "; "
-+ ++ self#pExp () e
-+ ++ text "; "
-+ ++ text "/* ??? */" (* self#pBlock() bIter *)
-+ ++ text ") "
-+ ++ self#pBlock () b)
-+
- | Block b -> align ++ self#pBlock () b
-
- | TryFinally (b, h, l) ->
-***************
-*** 4705,4713 ****
---- 4756,4781 ----
- | Return (Some e, l) ->
- let e' = fExp e in
- if e' != e then Return (Some e', l) else s.skind
-+ (*
- | Loop (b, l, s1, s2) ->
- let b' = fBlock b in
- if b' != b then Loop (b', l, s1, s2) else s.skind
-+ *)
-+ | While (e, b, l) ->
-+ let e' = fExp e in
-+ let b' = fBlock b in
-+ if e' != e || b' != b then While (e', b', l) else s.skind
-+ | DoWhile (e, b, l) ->
-+ let b' = fBlock b in
-+ let e' = fExp e in
-+ if e' != e || b' != b then DoWhile (e', b', l) else s.skind
-+ | For (bInit, e, bIter, b, l) ->
-+ let bInit' = fBlock bInit in
-+ let e' = fExp e in
-+ let bIter' = fBlock bIter in
-+ let b' = fBlock b in
-+ if bInit' != bInit || e' != e || bIter' != bIter || b' != b then
-+ For (bInit', e', bIter', b', l) else s.skind
- | If(e, s1, s2, l) ->
- let e' = fExp e in
- (*if e queued any instructions, pop them here and remember them so that
-***************
-*** 5180,5186 ****
---- 5248,5262 ----
- peepHole1 doone tb.bstmts;
- peepHole1 doone eb.bstmts
- | Switch (e, b, _, _) -> peepHole1 doone b.bstmts
-+ (*
- | Loop (b, l, _, _) -> peepHole1 doone b.bstmts
-+ *)
-+ | While (_, b, _) -> peepHole1 doone b.bstmts
-+ | DoWhile (_, b, _) -> peepHole1 doone b.bstmts
-+ | For (bInit, _, bIter, b, _) ->
-+ peepHole1 doone bInit.bstmts;
-+ peepHole1 doone bIter.bstmts;
-+ peepHole1 doone b.bstmts
- | Block b -> peepHole1 doone b.bstmts
- | TryFinally (b, h, l) ->
- peepHole1 doone b.bstmts;
-***************
-*** 5214,5220 ****
---- 5290,5304 ----
- peepHole2 dotwo tb.bstmts;
- peepHole2 dotwo eb.bstmts
- | Switch (e, b, _, _) -> peepHole2 dotwo b.bstmts
-+ (*
- | Loop (b, l, _, _) -> peepHole2 dotwo b.bstmts
-+ *)
-+ | While (_, b, _) -> peepHole2 dotwo b.bstmts
-+ | DoWhile (_, b, _) -> peepHole2 dotwo b.bstmts
-+ | For (bInit, _, bIter, b, _) ->
-+ peepHole2 dotwo bInit.bstmts;
-+ peepHole2 dotwo bIter.bstmts;
-+ peepHole2 dotwo b.bstmts
- | Block b -> peepHole2 dotwo b.bstmts
- | TryFinally (b, h, l) -> peepHole2 dotwo b.bstmts;
- peepHole2 dotwo h.bstmts
-***************
-*** 5887,5892 ****
---- 5971,5977 ----
- [] -> trylink s fallthrough
- | hd :: tl -> (link s hd ; succpred_block b2 fallthrough ))
-
-+ (*
- | Loop(b,l,_,_) ->
- begin match b.bstmts with
- [] -> failwith "computeCFGInfo: empty loop"
-***************
-*** 5894,5899 ****
---- 5979,6011 ----
- link s hd ;
- succpred_block b (Some(hd))
- end
-+ *)
-+
-+ | While (e, b, l) -> begin match b.bstmts with
-+ | [] -> failwith "computeCFGInfo: empty loop"
-+ | hd :: tl -> link s hd ;
-+ succpred_block b (Some(hd))
-+ end
-+
-+ | DoWhile (e, b, l) ->begin match b.bstmts with
-+ | [] -> failwith "computeCFGInfo: empty loop"
-+ | hd :: tl -> link s hd ;
-+ succpred_block b (Some(hd))
-+ end
-+
-+ | For (bInit, e, bIter, b, l) ->
-+ (match bInit.bstmts with
-+ | [] -> failwith "computeCFGInfo: empty loop"
-+ | hd :: tl -> link s hd ;
-+ succpred_block bInit (Some(hd))) ;
-+ (match bIter.bstmts with
-+ | [] -> failwith "computeCFGInfo: empty loop"
-+ | hd :: tl -> link s hd ;
-+ succpred_block bIter (Some(hd))) ;
-+ (match b.bstmts with
-+ | [] -> failwith "computeCFGInfo: empty loop"
-+ | hd :: tl -> link s hd ;
-+ succpred_block b (Some(hd))) ;
-
- | Block(b) -> begin match b.bstmts with
- [] -> trylink s fallthrough
-***************
-*** 5985,5991 ****
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
-! [Label((Printf.sprintf "switch_%d_break" i),l,false)] ;
- let break_block = mkBlock [ break_stmt ] in
- let body_block = b in
- let body_if_stmtkind = (If(zero,body_block,break_block,l)) in
---- 6097,6103 ----
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
-! [Label((Printf.sprintf "switch_%d_break" i),l,false)] ;
- let break_block = mkBlock [ break_stmt ] in
- let body_block = b in
- let body_if_stmtkind = (If(zero,body_block,break_block,l)) in
-***************
-*** 6026,6039 ****
- s.skind <- handle_choices (List.sort compare_choices sl) ;
- xform_switch_block b (fun () -> ref break_stmt) cont_dest i
- end
- | Loop(b,l,_,_) ->
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
-! [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
- let cont_stmt = mkStmt (Instr []) in
- cont_stmt.labels <-
-! [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
- b.bstmts <- cont_stmt :: b.bstmts ;
- let this_stmt = mkStmt
- (Loop(b,l,Some(cont_stmt),Some(break_stmt))) in
---- 6138,6152 ----
- s.skind <- handle_choices (List.sort compare_choices sl) ;
- xform_switch_block b (fun () -> ref break_stmt) cont_dest i
- end
-+ (*
- | Loop(b,l,_,_) ->
- let i = get_switch_count () in
- let break_stmt = mkStmt (Instr []) in
- break_stmt.labels <-
-! [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
- let cont_stmt = mkStmt (Instr []) in
- cont_stmt.labels <-
-! [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
- b.bstmts <- cont_stmt :: b.bstmts ;
- let this_stmt = mkStmt
- (Loop(b,l,Some(cont_stmt),Some(break_stmt))) in
-***************
-*** 6043,6048 ****
---- 6156,6217 ----
- break_stmt.succs <- s.succs ;
- let new_block = mkBlock [ this_stmt ; break_stmt ] in
- s.skind <- Block new_block
-+ *)
-+ | While (e, b, l) ->
-+ let i = get_switch_count () in
-+ let break_stmt = mkStmt (Instr []) in
-+ break_stmt.labels <-
-+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
-+ let cont_stmt = mkStmt (Instr []) in
-+ cont_stmt.labels <-
-+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
-+ b.bstmts <- cont_stmt :: b.bstmts ;
-+ let this_stmt = mkStmt
-+ (While(e,b,l)) in
-+ let break_dest () = ref break_stmt in
-+ let cont_dest () = ref cont_stmt in
-+ xform_switch_block b break_dest cont_dest label_index ;
-+ break_stmt.succs <- s.succs ;
-+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
-+ s.skind <- Block new_block
-+
-+ | DoWhile (e, b, l) ->
-+ let i = get_switch_count () in
-+ let break_stmt = mkStmt (Instr []) in
-+ break_stmt.labels <-
-+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
-+ let cont_stmt = mkStmt (Instr []) in
-+ cont_stmt.labels <-
-+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
-+ b.bstmts <- cont_stmt :: b.bstmts ;
-+ let this_stmt = mkStmt
-+ (DoWhile(e,b,l)) in
-+ let break_dest () = ref break_stmt in
-+ let cont_dest () = ref cont_stmt in
-+ xform_switch_block b break_dest cont_dest label_index ;
-+ break_stmt.succs <- s.succs ;
-+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
-+ s.skind <- Block new_block
-+
-+ | For (bInit, e, bIter , b, l) ->
-+ let i = get_switch_count () in
-+ let break_stmt = mkStmt (Instr []) in
-+ break_stmt.labels <-
-+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
-+ let cont_stmt = mkStmt (Instr []) in
-+ cont_stmt.labels <-
-+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
-+ b.bstmts <- cont_stmt :: b.bstmts ;
-+ let this_stmt = mkStmt
-+ (For(bInit,e,bIter,b,l)) in
-+ let break_dest () = ref break_stmt in
-+ let cont_dest () = ref cont_stmt in
-+ xform_switch_block b break_dest cont_dest label_index ;
-+ break_stmt.succs <- s.succs ;
-+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
-+ s.skind <- Block new_block
-+
-+
- | Block(b) -> xform_switch_block b break_dest cont_dest label_index
-
- | TryExcept _ | TryFinally _ ->
diff --git a/cil.patch/cil.mli.patch b/cil.patch/cil.mli.patch
deleted file mode 100644
index d0e0363..0000000
--- a/cil.patch/cil.mli.patch
+++ /dev/null
@@ -1,59 +0,0 @@
-*** ../cil/src/cil.mli 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/cil.mli 2006-06-21 10:56:23.555126082 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 918,927 ****
- * statement. The target statement MUST have at least a label. *)
-
- | Break of location
-! (** A break to the end of the nearest enclosing Loop or Switch *)
-
- | Continue of location
-! (** A continue to the start of the nearest enclosing [Loop] *)
- | If of exp * block * block * location
- (** A conditional. Two successors, the "then" and the "else" branches.
- * Both branches fall-through to the successor of the If statement. *)
---- 920,929 ----
- * statement. The target statement MUST have at least a label. *)
-
- | Break of location
-! (** A break to the end of the nearest enclosing loop or Switch *)
-
- | Continue of location
-! (** A continue to the start of the nearest enclosing loop *)
- | If of exp * block * block * location
- (** A conditional. Two successors, the "then" and the "else" branches.
- * Both branches fall-through to the successor of the If statement. *)
-***************
-*** 932,943 ****
---- 934,956 ----
- * among its labels what cases it implements. The statements that
- * implement the cases are somewhere within the provided [block]. *)
-
-+ (*
- | Loop of block * location * (stmt option) * (stmt option)
- (** A [while(1)] loop. The termination test is implemented in the body of
- * a loop using a [Break] statement. If prepareCFG has been called,
- * the first stmt option will point to the stmt containing the continue
- * label for this loop and the second will point to the stmt containing
- * the break label for this loop. *)
-+ *)
-+
-+ | While of exp * block * location
-+ (** A [while] loop. *)
-+
-+ | DoWhile of exp * block * location
-+ (** A [do...while] loop. *)
-+
-+ | For of block * exp * block * block * location
-+ (** A [for] loop. *)
-
- | Block of block
- (** Just a block of statements. Use it as a way to keep some block
diff --git a/cil.patch/clexer.mll.patch b/cil.patch/clexer.mll.patch
deleted file mode 100644
index edbe8be..0000000
--- a/cil.patch/clexer.mll.patch
+++ /dev/null
@@ -1,24 +0,0 @@
-*** ../cil.orig/src/frontc/clexer.mll 2006-05-21 06:14:15.000000000 +0200
---- ../cil/src/frontc/clexer.mll 2009-03-29 10:34:34.000000000 +0200
-***************
-*** 584,590 ****
- | blank { hash lexbuf}
- | intnum { (* We are seeing a line number. This is the number for the
- * next line *)
-! E.setCurrentLine (int_of_string (Lexing.lexeme lexbuf) - 1);
- (* A file name must follow *)
- file lexbuf }
- | "line" { hash lexbuf } (* MSVC line number info *)
---- 584,595 ----
- | blank { hash lexbuf}
- | intnum { (* We are seeing a line number. This is the number for the
- * next line *)
-! let s = Lexing.lexeme lexbuf in
-! begin try
-! E.setCurrentLine (int_of_string s - 1)
-! with Failure _ ->
-! E.warn "Bad line number in preprocessed file: %s" s
-! end;
- (* A file name must follow *)
- file lexbuf }
- | "line" { hash lexbuf } (* MSVC line number info *)
diff --git a/cil.patch/dataflow.ml.patch b/cil.patch/dataflow.ml.patch
deleted file mode 100644
index 87b00de..0000000
--- a/cil.patch/dataflow.ml.patch
+++ /dev/null
@@ -1,27 +0,0 @@
-*** ../cil/src/ext/dataflow.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/dataflow.ml 2006-06-20 17:28:35.000000000 +0200
-***************
-*** 1,3 ****
---- 1,4 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-
- module IH = Inthash
- module E = Errormsg
-***************
-*** 219,225 ****
-
- | Goto _ | Break _ | Continue _ | If _
- | TryExcept _ | TryFinally _
-! | Switch _ | Loop _ | Return _ | Block _ -> curr
- in
- currentLoc := get_stmtLoc s.skind;
-
---- 220,227 ----
-
- | Goto _ | Break _ | Continue _ | If _
- | TryExcept _ | TryFinally _
-! | Switch _ | (*Loop _*) While _ | DoWhile _ | For _
-! | Return _ | Block _ -> curr
- in
- currentLoc := get_stmtLoc s.skind;
-
diff --git a/cil.patch/dataslicing.ml.patch b/cil.patch/dataslicing.ml.patch
deleted file mode 100644
index cebf2e3..0000000
--- a/cil.patch/dataslicing.ml.patch
+++ /dev/null
@@ -1,28 +0,0 @@
-*** ../cil/src/ext/dataslicing.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/dataslicing.ml 2006-06-21 11:14:58.866051623 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2004,
-***************
-*** 357,365 ****
---- 359,373 ----
- | Return (eo, l) -> sliceReturnExp eo l
- | Switch (e, b, sl, l) -> Switch (sliceExp 1 e, sliceBlock b,
- List.map sliceStmt sl, l)
-+ (*
- | Loop (b, l, so1, so2) -> Loop (sliceBlock b, l,
- applyOption sliceStmt so1,
- applyOption sliceStmt so2)
-+ *)
-+ | While (e, b, l) -> While (sliceExp 1 e, sliceBlock b, l)
-+ | DoWhile (e, b, l) -> DoWhile (sliceExp 1 e, sliceBlock b, l)
-+ | For (bInit, e, bIter, b, l) ->
-+ For (sliceBlock bInit, sliceExp 1e, sliceBlock bIter, sliceBlock b, l)
- | Goto _ -> sk
- | _ -> E.s (unimp "statement")
-
diff --git a/cil.patch/formatparse.mly.patch b/cil.patch/formatparse.mly.patch
deleted file mode 100644
index 09e161b..0000000
--- a/cil.patch/formatparse.mly.patch
+++ /dev/null
@@ -1,40 +0,0 @@
-*** ../cil/src/formatparse.mly 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/formatparse.mly 2006-06-20 16:22:57.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ /* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. */
-+
- /*(* Parser for constructing CIL from format strings *)
- (*
- *
-***************
-*** 1352,1357 ****
---- 1354,1360 ----
- mkCast e !upointType
- else e
- in
-+ (*
- mkStmt
- (Loop (mkBlock [ mkStmt
- (If(e,
-***************
-*** 1360,1366 ****
- (Break loc) ],
- loc));
- $5 mkTemp loc args ],
-! loc, None, None)))
- }
- | instr_list { (fun mkTemp loc args ->
- mkStmt (Instr ($1 loc args)))
---- 1363,1372 ----
- (Break loc) ],
- loc));
- $5 mkTemp loc args ],
-! loc, None, None))
-! *)
-! mkStmt
-! (While (e, mkBlock [ $5 mkTemp loc args ], loc)))
- }
- | instr_list { (fun mkTemp loc args ->
- mkStmt (Instr ($1 loc args)))
diff --git a/cil.patch/mergecil.ml.patch b/cil.patch/mergecil.ml.patch
deleted file mode 100644
index cc976ec..0000000
--- a/cil.patch/mergecil.ml.patch
+++ /dev/null
@@ -1,25 +0,0 @@
-*** ../cil/src/mergecil.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/mergecil.ml 2006-06-20 17:20:05.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 1151,1157 ****
---- 1153,1164 ----
- + 41*(stmtListSum b2.bstmts)
- | Switch(_,b,_,_) -> 43 + 47*(stmtListSum b.bstmts)
- (* don't look at stmt list b/c is not part of tree *)
-+ (*
- | Loop(b,_,_,_) -> 49 + 53*(stmtListSum b.bstmts)
-+ *)
-+ | While(_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
-+ | DoWhile(_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
-+ | For(_,_,_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
- | Block(b) -> 59 + 61*(stmtListSum b.bstmts)
- | TryExcept (b, (il, e), h, _) ->
- 67 + 83*(stmtListSum b.bstmts) + 97*(stmtListSum h.bstmts)
diff --git a/cil.patch/oneret.ml.patch b/cil.patch/oneret.ml.patch
deleted file mode 100644
index d4c13d5..0000000
--- a/cil.patch/oneret.ml.patch
+++ /dev/null
@@ -1,38 +0,0 @@
-*** ../cil/src/ext/oneret.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/oneret.ml 2006-06-21 11:15:54.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 133,142 ****
---- 135,159 ----
- currentLoc := l;
- s.skind <- If(eb, scanBlock false t, scanBlock false e, l);
- s :: scanStmts mainbody rests
-+ (*
- | ({skind=Loop(b,l,lb1,lb2)} as s) :: rests ->
- currentLoc := l;
- s.skind <- Loop(scanBlock false b, l,lb1,lb2);
- s :: scanStmts mainbody rests
-+ *)
-+ | ({skind=While(e,b,l)} as s) :: rests ->
-+ currentLoc := l;
-+ s.skind <- While(e, scanBlock false b, l);
-+ s :: scanStmts mainbody rests
-+ | ({skind=DoWhile(e,b,l)} as s) :: rests ->
-+ currentLoc := l;
-+ s.skind <- DoWhile(e, scanBlock false b, l);
-+ s :: scanStmts mainbody rests
-+ | ({skind=For(bInit,e,bIter,b,l)} as s) :: rests ->
-+ currentLoc := l;
-+ s.skind <- For(scanBlock false bInit, e, scanBlock false bIter,
-+ scanBlock false b, l);
-+ s :: scanStmts mainbody rests
- | ({skind=Switch(e, b, cases, l)} as s) :: rests ->
- currentLoc := l;
- s.skind <- Switch(e, scanBlock false b, cases, l);
diff --git a/cil.patch/ptranal.ml.patch b/cil.patch/ptranal.ml.patch
deleted file mode 100644
index 8b5cf9f..0000000
--- a/cil.patch/ptranal.ml.patch
+++ /dev/null
@@ -1,28 +0,0 @@
-*** ../cil/src/ext/pta/ptranal.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/pta/ptranal.ml 2006-06-21 11:55:25.414890423 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
- (*
- *
- * Copyright (c) 2001-2002,
-***************
-*** 312,318 ****
---- 314,328 ----
- | Switch (e, b, sl, l) ->
- analyze_block b;
- List.iter analyze_stmt sl
-+ (*
- | Loop (b, l, _, _) -> analyze_block b
-+ *)
-+ | While (_, b, _) -> analyze_block b
-+ | DoWhile (_, b, _) -> analyze_block b
-+ | For (bInit, _, bIter, b, _) ->
-+ analyze_block bInit;
-+ analyze_block bIter;
-+ analyze_block b
- | Block b -> analyze_block b
- | TryFinally (b, h, _) ->
- analyze_block b;
diff --git a/cil.patch/usedef.ml.patch b/cil.patch/usedef.ml.patch
deleted file mode 100644
index d075316..0000000
--- a/cil.patch/usedef.ml.patch
+++ /dev/null
@@ -1,38 +0,0 @@
-*** ../cil/src/ext/usedef.ml 2006-05-21 06:14:15.000000000 +0200
---- ../cil_patch/src/ext/usedef.ml 2006-06-20 17:36:16.000000000 +0200
-***************
-*** 1,3 ****
---- 1,5 ----
-+ (* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
-+
-
- open Cil
- open Pretty
-***************
-*** 130,136 ****
---- 132,141 ----
- | Return (Some e, _) -> ve e
- | If (e, _, _, _) -> ve e
- | Break _ | Goto _ | Continue _ -> ()
-+ (*
- | Loop (_, _, _, _) -> ()
-+ *)
-+ | While _ | DoWhile _ | For _ -> ()
- | Switch (e, _, _, _) -> ve e
- | Instr il ->
- List.iter (fun i -> ignore (visitCilInstr useDefVisitor i)) il
-***************
-*** 165,171 ****
---- 170,181 ----
- let u'', d'' = handle_block fb in
- (VS.union (VS.union u u') u'', VS.union (VS.union d d') d'')
- | Break _ | Goto _ | Continue _ -> !varUsed, !varDefs
-+ (*
- | Loop (b, _, _, _) -> handle_block b
-+ *)
-+ | While (_, b, _) -> handle_block b
-+ | DoWhile (_, b, _) -> handle_block b
-+ | For (_, _, _, b, _) -> handle_block b
- | Switch (e, b, _, _) ->
- let _ = ve e in
- let u, d = !varUsed, !varDefs in
diff --git a/cil/INSTALL b/cil/INSTALL
new file mode 100644
index 0000000..ef7846f
--- /dev/null
+++ b/cil/INSTALL
@@ -0,0 +1,41 @@
+
+ (For more complete installation instructions see the documentation in
+ doc/html.)
+
+ Building from source (see below for installing binary distributions)
+---------------------------------------------------------------------
+
+ 1. If you use Windows, you must first install cygwin.
+
+ 2. You must install OCaml version 3.08 or higher (see instructions at
+ http://caml.inria.fr/ocaml). The recommended build process is using
+ the cygwin version of ocaml.
+
+ You can also build with Microsoft Visual Studio, but you must still have
+ cygwin during the build process. See msvcbuild.cmd.
+
+ 3. Download and unpack the distribution.
+
+ 4. Run ./configure (from within bash if on Windows)
+
+ 5. Run make
+
+ 6. Run make check
+
+ Now you can start using bin/cilly and bin/ccured as explained in the
+ documentation (in doc/html).
+
+
+ Installing binary distributions (Windows-only)
+-----------------------------------------------
+
+ 1. Unpack the installation package
+
+ 2. Change CILHOME to the full path of the diretory where you put cil, in
+ the following files: bin/CilConfig.pm, bin/cilly.bat, bin/patcher.bat
+ 3. Go to test/small1 directory and run
+ ..\..\cilly /c hello.c
+
+
+
+ \ No newline at end of file
diff --git a/cil/LICENSE b/cil/LICENSE
new file mode 100644
index 0000000..5a7dab5
--- /dev/null
+++ b/cil/LICENSE
@@ -0,0 +1,35 @@
+Copyright (c) 2001-2005,
+ George C. Necula <necula@cs.berkeley.edu>
+ Scott McPeak <smcpeak@cs.berkeley.edu>
+ Wes Weimer <weimer@cs.berkeley.edu>
+ Ben Liblit <liblit@cs.wisc.edu>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+3. The names of the contributors may not be used to endorse or promote
+products derived from this software without specific prior written
+permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+
+(See http://www.opensource.org/licenses/bsd-license.php)
diff --git a/cil/Makefile.gcc b/cil/Makefile.gcc
new file mode 100644
index 0000000..8fae4e3
--- /dev/null
+++ b/cil/Makefile.gcc
@@ -0,0 +1,75 @@
+# -*-makefile-*-
+# Makefile for CCured. The gcc part
+
+
+COMPILERNAME := GNUCC
+
+CC := gcc
+ifdef RELEASELIB
+ # sm: I will leave this here, but only use it for compiling our runtime lib
+ CFLAGS := -D_GNUCC -Wall -O3
+else
+ CFLAGS := -D_GNUCC -Wall -g -ggdb -D_DEBUG
+endif
+
+# dsw: added optional -pg flag
+ifdef USE_PG
+ CFLAGS += -pg
+endif
+
+ifdef NO_OPTIMIZATION
+ OPT_O2 :=
+else
+ OPT_O2 := -O2
+endif
+CONLY := -c
+OBJOUT := -o
+OBJEXT := o
+LIBEXT := a
+EXEOUT := -o
+LDEXT :=
+DEF := -D
+ASMONLY := -S -o
+WARNALL := -Wall
+# sm: shuffled around a couple things so I could use CPPSTART for patch2
+CPPSTART := gcc -E -x c -Dx86_LINUX -D_GNUCC -I/usr/include/sys
+CPPOUT := -o %o
+CPP := $(CPPSTART) -include fixup.h %i $(CPPOUT)
+INC := -I
+
+# sm: disable patching for now ('true' has no output)
+# (set it to 'echo' to re-enable)
+ifndef PATCHECHO
+ PATCHECHO := echo
+endif
+
+AR := ar
+LIBOUT := -rs
+
+# The system include files to be patched
+PATCH_SYSINCLUDES := crypt.h ctype.h fcntl.h glob.h grp.h malloc.h netdb.h \
+ pthread.h pwd.h signal.h stdarg.h stdio.h stdlib.h \
+ string.h time.h unistd.h varargs.h arpa/inet.h \
+ sys/cdefs.h sys/fcntl.h sys/ioctl.h sys/socket.h \
+ sys/stat.h sys/types.h sys/uio.h malloc.h setjmp.h
+
+ifneq ($(ARCHOS), x86_WIN32)
+PATCH_SYSINCLUDES += sys/shm.h
+endif
+
+# dsw & sm: DON'T DO THIS. See comment in ccured_GNUCC.patch, search for 'sys/io.h'.
+# PATCH_SYSINCLUDES += sys/io.h
+
+# matth: reent.h is only in Cygwin, and Cygwin defines struct sigaction
+# in sys/signal.h:
+ifeq ($(ARCHOS), x86_WIN32)
+PATCH_SYSINCLUDES += sys/reent.h sys/signal.h
+endif
+
+# matth: these files are not in Cygwin
+ifeq ($(ARCHOS), x86_LINUX)
+PATCH_SYSINCLUDES += nl_types.h bits/sigaction.h bits/select.h sys/prctl.h \
+ libgen.h shadow.h
+endif
+
+
diff --git a/cil/Makefile.in b/cil/Makefile.in
new file mode 100644
index 0000000..a16d60c
--- /dev/null
+++ b/cil/Makefile.in
@@ -0,0 +1,656 @@
+# -*- Mode: makefile -*-
+
+# Makefile for the cil wrapper
+# @do_not_edit@ Makefile.in
+#
+# author: George Necula
+
+#
+# If you want to add extra CIL features, you do not always need to change
+# this file. Just invoke
+# ./configure EXTRASRCDIRS=/home/foodir EXTRAFEATURES="foo bar"
+# This will add two features that must be defined in foo.ml and bar.ml
+#
+
+# Debugging. Set ECHO= to debug this Makefile
+.PHONY: setup quickbuild doc distrib machdep cilversion
+ECHO = @
+
+# It is important to build quickbuild first, to generate the proper dependencies
+all: quickbuild setup
+
+# Now add the defines for the CIL features
+@CIL_FEATURES_DEFINES@
+
+
+# look out for outdated Makefile; if it's out of date, this will automatically
+# re-run ./config.status, then re-exec make with the same arguments
+Makefile: config.status Makefile.in
+ ./$<
+
+config.status: configure
+ ./$@ --recheck
+
+configure: configure.in
+ autoconf
+
+ocamlutil/perfcount.c: config.status ocamlutil/perfcount.c.in
+ ./$<
+
+@DEFAULT_COMPILER@=1
+
+
+
+ifdef RELEASE
+ NATIVECAML := 1
+ UNSAFE := 1
+endif
+
+ifndef ARCHOS
+ ARCHOS=@ARCHOS@
+endif
+
+# Put here all the byproducts of make
+OBJDIR := obj/$(ARCHOS)
+DEPENDDIR := obj/.depend
+
+CILLY_FEATURES :=
+ifdef USE_BLOCKINGGRAPH
+ CILLY_FEATURES += blockinggraph
+endif
+ifdef USE_RAND
+ CILLY_FEATURES += rand
+endif
+ifdef USE_ARITHABS
+ CILLY_FEATURES += arithabs
+endif
+ifdef USE_SMALLOC
+ CILLY_FEATURES += smalloc
+endif
+ifdef USE_CQUALANN
+ CILLY_FEATURES += cqualann
+endif
+ifdef USE_ZRAPP
+ CILLY_FEATURES += rmciltmps zrapp
+endif
+# Add the EXTRAFEATURES
+CILLY_FEATURES += @EXTRAFEATURES@
+
+ # Now rules to make cilly
+CILLY_LIBRARY_MODULES = pretty inthash errormsg alpha trace stats util clist \
+ cilutil escape growArray\
+ cabs cabsvisit cprint lexerhack machdep cparser clexer \
+ cilversion cil cillower formatparse formatlex formatcil cabs2cil \
+ patch frontc check mergecil \
+ dataflow dominators bitmap ssa ciltools \
+ usedef logcalls logwrites rmtmps \
+ callgraph epicenter heapify \
+ setp uref olf ptranal \
+ canonicalize heap oneret partial simplemem simplify \
+ dataslicing sfi \
+ cfg reachingdefs deadcodeelim availexps \
+ liveness \
+ testcil \
+ $(CILLY_FEATURES) \
+ ciloptions feature_config
+# ww: we don't want "main" in an external cil library (cil.cma),
+# otherwise every program that links against that library will get
+# main's argument checking and whatnot ...
+CILLY_MODULES = $(CILLY_LIBRARY_MODULES) main
+CILLY_CMODULES =
+CILLY_LIBS = unix str
+
+SOURCEDIRS += src src/frontc src/ext src/ext/pta ocamlutil @EXTRASRCDIRS@
+MLLS += clexer.mll formatlex.mll
+MLYS += cparser.mly formatparse.mly
+MODULES += $(CILLY_MODULES) libmaincil
+
+
+
+ # Include now the common set of rules for OCAML
+include ocamlutil/Makefile.ocaml
+
+
+ # Now the rule to make cilly
+
+PROJECT_EXECUTABLE = $(OBJDIR)/cilly$(EXE)
+PROJECT_MODULES = $(CILLY_MODULES)
+PROJECT_CMODULES = perfcount $(CILLY_CMODULES)
+PROJECT_LIBS = $(CILLY_LIBS)
+cilly: $(PROJECT_EXECUTABLE)
+include ocamlutil/Makefile.ocaml.build
+
+
+quickbuild: cilversion machdep cilly
+
+# Setup also makes the native code versions
+#
+# sm: cillib is only built with NATIVECAML=1 because it builds libcil.a,
+# which requires native-code .cmx compiled modules... could break it
+# into two targets so we build cil.cma both ways, but no one is using
+# cil.cma now so I'll leave it alone
+setup: cilversion machdep
+ $(MAKE) cilly NATIVECAML=
+ $(MAKE) cilly NATIVECAML=1
+ $(MAKE) cillib NATIVECAML=
+ $(MAKE) cillib NATIVECAML=1
+
+# Create the machine dependency module
+# If the cl command cannot be run then the MSVC part will be identical to GCC
+.PHONY : machdep
+machdep: $(OBJDIR)/machdep.ml
+$(OBJDIR)/machdep.ml : src/machdep.c configure.in Makefile.in
+ rm -f $@
+ echo "(* This module was generated automatically by code in Makefile and machdep.c *)" >$@
+# Now generate the type definition
+ echo "type mach = {" >> $@
+ echo " version_major: int; (* Major version number *)" >> $@
+ echo " version_minor: int; (* Minor version number *)" >> $@
+ echo " version: string; (* version number *)" >> $@
+ echo " underscore_name: bool; (* If assembly names have leading underscore *)" >> $@
+ echo " sizeof_short: int; (* Size of \"short\" *)" >> $@
+ echo " sizeof_int: int; (* Size of \"int\" *)" >> $@
+ echo " sizeof_long: int ; (* Size of \"long\" *)" >> $@
+ echo " sizeof_longlong: int; (* Size of \"long long\" *)" >> $@
+ echo " sizeof_ptr: int; (* Size of pointers *)" >> $@
+ echo " sizeof_enum: int; (* Size of enum types *)" >> $@
+ echo " sizeof_float: int; (* Size of \"float\" *)" >> $@
+ echo " sizeof_double: int; (* Size of \"double\" *)" >> $@
+ echo " sizeof_longdouble: int; (* Size of \"long double\" *)" >> $@
+ echo " sizeof_sizeof: int; (* Size of \"sizeof(T)\" *)" >> $@
+ echo " sizeof_wchar: int; (* Size of \"wchar_t\" *)" >> $@
+ echo " sizeof_void: int; (* Size of \"void\" *)" >> $@
+ echo " sizeof_fun: int; (* Size of function *)" >> $@
+ echo " alignof_short: int; (* Alignment of \"short\" *)" >> $@
+ echo " alignof_int: int; (* Alignment of \"int\" *)" >> $@
+ echo " alignof_long: int; (* Alignment of \"long\" *)" >> $@
+ echo " alignof_longlong: int; (* Alignment of \"long long\" *)" >> $@
+ echo " alignof_ptr: int; (* Alignment of pointers *)" >> $@
+ echo " alignof_enum: int; (* Alignment of enum types *)" >> $@
+ echo " alignof_float: int; (* Alignment of \"float\" *)" >> $@
+ echo " alignof_double: int; (* Alignment of \"double\" *)" >> $@
+ echo " alignof_longdouble: int; (* Alignment of \"long double\" *)" >> $@
+ echo " alignof_str: int; (* Alignment of strings *)" >> $@
+ echo " alignof_fun: int; (* Alignment of function *)" >> $@
+ echo " char_is_unsigned: bool; (* Whether \"char\" is unsigned *)">> $@
+ echo " const_string_literals: bool; (* Whether string literals have const chars *)">> $@
+ echo " little_endian: bool; (* whether the machine is little endian *)">>$@
+ echo "}" >> $@
+ if gcc -D_GNUCC $< -o $(OBJDIR)/machdep.exe ;then \
+ echo "machdep.exe created succesfull." \
+ ;else \
+ rm -f $@; exit 1 \
+ ;fi
+ echo "let gcc = {" >>$@
+ $(OBJDIR)/machdep.exe >>$@
+ echo " underscore_name = @UNDERSCORE_NAME@ ;" >> $@
+ echo "}" >>$@
+ if cl /D_MSVC $< /Fe$(OBJDIR)/machdep.exe /Fo$(OBJDIR)/machdep.obj ;then \
+ echo "let hasMSVC = true" >>$@ \
+ ;else \
+ echo "let hasMSVC = false" >>$@ ;fi
+ echo "let msvc = {" >>$@
+ $(OBJDIR)/machdep.exe >>$@
+ echo " underscore_name = true ;" >> $@
+ echo "}" >>$@
+ echo "let gccHas__builtin_va_list = @HAVE_BUILTIN_VA_LIST@" >>$@
+ echo "let __thread_is_keyword = @THREAD_IS_KEYWORD@" >>$@
+
+#
+# Create the version information module
+.PHONY: cilversion
+cilversion: $(OBJDIR)/cilversion.ml
+$(OBJDIR)/cilversion.ml: configure.in Makefile.in
+ rm -f $@
+ echo "(* This module was generated automatically by code in Makefile *)" >$@
+# Generate here the version information
+ echo "let cilVersionMajor = @CIL_VERSION_MAJOR@" >>$@
+ echo "let cilVersionMinor = @CIL_VERSION_MINOR@" >>$@
+ echo "let cilVersionRev = @CIL_VERSION_REV@" >>$@
+ echo "let cilVersion = \"@CIL_VERSION@\"" >>$@
+
+# build two libraries
+.PHONY: cillib libcil
+ifeq ($(NATIVECAML),1)
+cillib: $(OBJDIR)/cil.$(CMXA) # $(OBJDIR)/libcil.a
+else
+cillib: $(OBJDIR)/cil.$(CMXA)
+endif
+
+
+$(OBJDIR)/feature_config.ml: Makefile config.status
+ rm -f $(OBJDIR)/feature_config.*
+ echo "(* This module was generated automatically by code in Makefile.in *)" >$@
+# The Cilly feature options. A list of Cil.featureDescr
+ echo "open Cil" >>$@
+ echo "let features : featureDescr list = [" >> $@
+ifdef USE_BLOCKINGGRAPH
+ echo " Blockinggraph.feature;" >> $@
+endif
+ifdef USE_RAND
+ echo " Rand.feature;" >> $@
+endif
+ifdef USE_ARITHABS
+ echo " Arithabs.feature;" >>$@
+endif
+ifdef USE_SMALLOC
+ echo " Smalloc.feature;" >> $@
+endif
+ifdef USE_CQUALANN
+ echo " Cqualann.feature;" >> $@
+endif
+ifdef USE_ZRAPP
+ echo " Zrapp.feature;" >> $@
+endif
+# Now the extra features, with the first letter capitalized
+ echo \
+ $(foreach f,@EXTRAFEATURES@, \
+ `echo $f | cut -c 1 | tr "[a-z]" "[A-Z]"``echo $f | cut -c 2-`".feature;") >> $@
+ echo "]" >>$@
+# Must delete main.d and remake it, because it may have been made
+# before feature_config existed.
+ rm -f $(DEPENDDIR)/main.d
+ $(MAKE) $(DEPENDDIR)/main.d
+
+
+
+
+
+
+OCAML_CIL_LIB_MODULES := $(CILLY_LIBRARY_MODULES)
+OCAML_CIL_LIB_CMODULES := perfcount
+
+# list of modules to use for building a library; remove 'main'
+# and add 'libmaincil'
+OCAML_CIL_C_LIB_MODULES := $(CILLY_MODULES:main=) libmaincil
+
+# Build an OCAML library (CMA / CMXA) that exports our Cil stuff
+$(OBJDIR)/cil.$(CMXA): $(OCAML_CIL_LIB_CMODULES:%=$(OBJDIR)/lib%.a) \
+ $(OCAML_CIL_LIB_MODULES:%=$(OBJDIR)/%.$(CMO))
+ $(CAMLLINK) -a -o $@ -ccopt -L$(pkglibdir) \
+ $(OCAML_CIL_LIB_CMODULES:%=-cclib -l%) \
+ $(OCAML_CIL_LIB_MODULES:%=$(OBJDIR)/%.$(CMO))
+
+$(OBJDIR)/libperfcount.a: %: %($(OBJDIR)/perfcount.$(CMC))
+ ranlib $@
+
+# sm: for Simon: build a library of CIL functions which can
+# be called from C code; this is like the target above, except
+# it is callable from C instead of from Ocaml
+ifeq ($(NATIVECAML),1)
+$(OBJDIR)/libcil.a: $(OCAML_CIL_LIB_CMODULES:%=$(OBJDIR)/lib%.a) \
+ $(OCAML_CIL_LIB_MODULES:%=$(OBJDIR)/%.$(CMO))
+ ocamlopt -output-obj -o $@ unix.cmxa str.cmxa $^
+else
+$(OBJDIR)/libcil.a:
+ @echo "Can only build $@ when NATIVECAML is 1."
+ exit 2
+endif
+
+# Test cil
+ifdef _MSVC
+TESTCILARG=--MSVC --testcil "bash msvctestcil"
+else
+TESTCILARG= --testcil "bash gcctestcil"
+endif
+
+.PHONY: testcil
+testcil: $(OBJDIR)/cilly$(EXE)
+ cd test; ../$(OBJDIR)/cilly$(EXE) $(TESTCILARG)
+
+.PHONY: odoc texdoc pdfdoc
+
+###
+### DOCUMENTATION
+###
+### The following are available
+###
+### make doc - creates the documentation
+### make publish_doc - creates the documentation and puts it on the web page
+
+# Documentation generated by "ocamldoc"
+odoc: $(OBJDIR)/pretty.cmi $(OBJDIR)/cil.cmi
+ -rm -rf doc/html/cil/api
+ -mkdir doc/html/cil/api
+ -mkdir doc/html/cil/api-latex
+ -rm -f doc/ocamldoc.sty
+ ocamldoc -d doc/html/cil/api -v -stars \
+ -html \
+ -t "CIL API Documentation (version @CIL_VERSION@)" \
+ -I $(OBJDIR) \
+ ocamlutil/pretty.mli ocamlutil/errormsg.mli \
+ ocamlutil/clist.mli \
+ ocamlutil/stats.mli src/cil.mli src/formatcil.mli \
+ ocamlutil/alpha.mli src/cillower.mli \
+ src/ext/cfg.mli src/ext/dataflow.mli \
+ src/ext/dominators.mli
+
+doc/cilpp.tex: doc/cilcode.pl doc/cil.tex
+ -rm -rf doc/html/cil
+ -mkdir doc/html/cil
+ -mkdir doc/html/cil/examples
+ cd doc; perl cilcode.pl cil.tex >cilpp.tex.tmp
+ mv doc/cilpp.tex.tmp $@
+
+# Documentation generated from latex files using "hevea"
+texdoc: doc/cilpp.tex
+# Create the version document
+ cd doc/html/cil; echo "\def\cilversion{@CIL_VERSION@}" >cil.version.tex
+ cd doc/html/cil; echo "\def\ccuredversion{@CCURED_VERSION@}" >>cil.version.tex
+ cd doc/html/cil; hevea -exec xxdate.exe ../../cilpp
+ cd doc/html/cil; hevea -exec xxdate.exe ../../cilpp
+ cd doc/html/cil; mv cilpp.html cil.html
+ cd doc/html/cil; hacha -o ciltoc.html cil.html
+ cp -f doc/index.html doc/html/cil/index.html
+ cp -f doc/header.html doc/html/cil
+
+pdfdoc: doc/cilpp.tex $(OBJDIR)/pretty.cmi $(OBJDIR)/cil.cmi
+ cd doc; echo "\def\cilversion{@CIL_VERSION@}" >cil.version.tex
+ cd doc; echo "\def\ccuredversion{@CCURED_VERSION@}" >>cil.version.tex
+ cd doc; pdflatex cilpp.tex; pdflatex cilpp.tex
+ cd doc; mv cilpp.pdf html/cil/CIL.pdf
+ ocamldoc -o doc/cil-api.tex -v -stars \
+ -latex \
+ -t "CIL API Documentation (version @CIL_VERSION@)" \
+ -I $(OBJDIR) \
+ ocamlutil/pretty.mli ocamlutil/errormsg.mli \
+ ocamlutil/clist.mli \
+ ocamlutil/stats.mli src/cil.mli src/formatcil.mli \
+ ocamlutil/alpha.mli
+
+ cd doc ; TEXINPUTS="$$TEXINPUTS:/usr/local/lib/ocaml/ocamldoc:/usr/lib/ocaml/ocamldoc" pdflatex cil-api.tex
+ cd doc ; mv cil-api.pdf html/cil/CIL-API.pdf
+
+doc: texdoc pdfdoc odoc
+
+
+#----------------------------------------------------------------------
+# Generate the CIL distribution
+# This will create a file cil.tar.gz. It includes the HTML documentation
+# so that people can use it even if they don't have ocamldoc, hevea etc.
+
+.PHONY: distrib distrib-nocheck checkdistrib
+CIL_TAR_GZ:=cil-@CIL_VERSION@.tar.gz
+## Make a distribution and check it
+distrib: distrib-nocheck checkdistrib
+
+# Work in a temporary directory
+TEMP_DIR = TEMP_cil-distrib
+
+# The tar archive members will be relative to this directory
+TOP_DIR = $(TEMP_DIR)/cil
+
+DISTRIB_ROOT = README LICENSE INSTALL Makefile.in \
+ config.h.in Makefile.gcc Makefile.msvc \
+ configure configure.in install-sh config.guess config.sub \
+ cil.spec cil.spec.in
+
+DISTRIB_SRC = cilutil.ml cil.ml cil.mli check.ml check.mli \
+ rmtmps.ml rmtmps.mli formatlex.mll formatparse.mly \
+ formatcil.mli formatcil.ml testcil.ml \
+ mergecil.ml mergecil.mli main.ml machdep.c \
+ ciloptions.ml ciloptions.mli libmaincil.ml \
+ escape.ml escape.mli cillower.mli cillower.ml
+
+DISTRIB_OCAMLUTIL = pretty.ml pretty.mli errormsg.ml errormsg.mli \
+ trace.ml trace.mli stats.ml stats.mli util.ml util.mli \
+ inthash.ml inthash.mli alpha.ml alpha.mli \
+ intmap.ml intmap.mli clist.ml clist.mli \
+ growArray.ml growArray.mli \
+ perfcount.c.in Makefile.ocaml Makefile.ocaml.build
+
+
+DISTRIB_SRC_FRONTC = cabs.ml cprint.ml clexer.mli clexer.mll \
+ cparser.mly lexerhack.ml \
+ cabs2cil.ml cabs2cil.mli frontc.ml frontc.mli \
+ cabsvisit.mli cabsvisit.ml patch.mli patch.ml
+
+DISTRIB_SRC_EXT = logcalls.ml logcalls.mli \
+ astslicer.ml heap.ml partial.ml \
+ logwrites.ml heapify.ml callgraph.ml callgraph.mli \
+ epicenter.ml usedef.ml ciltools.ml \
+ cfg.ml deadcodeelim.ml availexps.ml \
+ dataflow.ml dataflow.mli \
+ dominators.ml dominators.mli \
+ bitmap.ml bitmap.mli \
+ ssa.ml ssa.mli \
+ stackoverflow.mli stackoverflow.ml \
+ canonicalize.ml canonicalize.mli \
+ oneret.ml oneret.mli sfi.ml \
+ simplemem.ml simplify.ml \
+ blockinggraph.ml blockinggraph.mli \
+ dataslicing.ml dataslicing.mli \
+ reachingdefs.ml \
+ cfg.ml cfg.mli \
+ liveness.ml
+
+DISTRIB_SRC_EXT_PTA = setp.ml setp.mli golf.ml golf.mli \
+ ptranal.ml ptranal.mli \
+ steensgaard.mli steensgaard.ml \
+ uref.ml uref.mli olf.ml olf.mli
+
+DISTRIB_LIB = Cilly.pm KeptFile.pm OutputFile.pm TempFile.pm
+
+DISTRIB_BIN = CilConfig.pm.in cilly cilly.bat.in \
+ patcher patcher.bat.in test-bad teetwo
+
+DISTRIB_SMALL1=hello.c func.c init.c init1.c wchar1.c vararg1.c testharness.h
+
+distrib-nocheck: $(DISTRIB_ROOT) doc
+ # Create the distribution from scratch
+ rm -rf $(TEMP_DIR)
+ mkdir $(TEMP_DIR)
+
+ rm -rf $(CIL_TAR_GZ)
+ mkdir $(TOP_DIR) \
+ $(TOP_DIR)/src \
+ $(TOP_DIR)/src/frontc \
+ $(TOP_DIR)/src/ext \
+ $(TOP_DIR)/src/ext/pta \
+ $(TOP_DIR)/obj \
+ $(TOP_DIR)/doc \
+ $(TOP_DIR)/lib \
+ $(TOP_DIR)/bin \
+ $(TOP_DIR)/doc/api \
+ $(TOP_DIR)/obj/.depend \
+ $(TOP_DIR)/obj/x86_WIN32 \
+ $(TOP_DIR)/obj/x86_LINUX \
+ $(TOP_DIR)/obj/ppc_DARWIN \
+ $(TOP_DIR)/obj/sparc_SOLARIS \
+ $(TOP_DIR)/test \
+ $(TOP_DIR)/test/small1 \
+ $(TOP_DIR)/ocamlutil
+
+ cp $(patsubst %,%,$(DISTRIB_ROOT)) $(TOP_DIR)
+
+ cp $(patsubst %,src/%,$(DISTRIB_SRC)) $(TOP_DIR)/src
+ cp $(patsubst %,ocamlutil/%,$(DISTRIB_OCAMLUTIL)) $(TOP_DIR)/ocamlutil
+ cp $(patsubst %,src/ext/%,$(DISTRIB_SRC_EXT)) $(TOP_DIR)/src/ext
+ cp $(patsubst %,src/ext/pta/%,$(DISTRIB_SRC_EXT_PTA)) \
+ $(TOP_DIR)/src/ext/pta
+ cp $(patsubst %,src/frontc/%,$(DISTRIB_SRC_FRONTC)) \
+ $(TOP_DIR)/src/frontc
+ cp $(patsubst %,lib/%,$(DISTRIB_LIB)) $(TOP_DIR)/lib
+ cp $(patsubst %,bin/%,$(DISTRIB_BIN)) $(TOP_DIR)/bin
+ cp $(patsubst %,test/small1/%,$(DISTRIB_SMALL1)) $(TOP_DIR)/test/small1
+
+ cp -r doc/html/cil/* $(TOP_DIR)/doc
+# Delete all CVS directories
+ if find $(TEMP_DIR) -name CVS -print >cvss.txt ; then \
+ rm -rf `cat cvss.txt` ;fi
+# Now make the TAR ball
+ cd $(TEMP_DIR); tar cfz $(CIL_TAR_GZ) cil
+ mv $(TEMP_DIR)/$(CIL_TAR_GZ) .
+
+# rm -rf $(TEMP_DIR)
+
+## Check a distribution
+checkdistrib:
+ cd $(TOP_DIR) && ./configure && \
+ $(MAKE) && $(MAKE) quicktest
+
+distclean: clean
+ rm -f src/frontc/cparser.output
+ rm -f src/formatparse.output
+ rm -f ocamlutil/perfcount.c
+ rm -f bin/cilly.bat
+ rm -f bin/patcher.bat
+ rm -f bin/CilConfig.pm
+ rm -f config.log
+ rm -f config.h
+ rm -f Makefile
+
+## Publish the distribution
+CILHTMLDEST=/var/www/cil
+publish_distrib: publish_doc
+ if test -d $(CILHTMLDEST); then \
+ cp -rf doc/html/cil/* $(CILHTMLDEST); \
+ cp -f $(CIL_TAR_GZ) $(CILHTMLDEST)/distrib; \
+ ln -sf $(CILHTMLDEST)/distrib/$(CIL_TAR_GZ) $(CILHTMLDEST)/distrib/cil-latest.tar.gz ; \
+ echo "Publish succeeded"; \
+ else \
+ error "Cannot publish because $(CILHTMLDEST) does not exist" ; \
+ fi
+
+publish_doc: doc
+ if test -d $(CILHTMLDEST); then \
+ cp -rf doc/html/cil/* $(CILHTMLDEST); echo "Done publishing doc"; \
+ else \
+ error "Cannot publish because $(CILHTMLDEST) does not exist" ; \
+ fi
+
+cleancheck:
+ rm -f test/small1/*.o
+ rm -f test/small1/hello
+ rm -f test/small1/vararg1
+ rm -f test/small1/wchar1
+
+clean: cleancaml cleancheck
+ rm -f $(OBJDIR)/machdep.ml
+
+# Now include the compiler specific stuff
+ifdef _MSVC
+ include Makefile.msvc
+else
+ ifdef _GNUCC
+ include Makefile.gcc
+ endif
+endif
+
+test/%:
+ bin/cilly $(CONLY) test/small1/$*.c $(OBJOUT)test/small1/$*.o
+
+testrun/%:
+ bin/cilly test/small1/$*.c $(OBJOUT)test/small1/$*
+ test/small1/$*
+
+
+
+.PHONY: quicktest
+quicktest: $(patsubst %,test/%,func init init1) \
+ $(patsubst %,testrun/%,hello wchar1 vararg1)
+
+.PHONY: check
+check: quicktest
+
+############# Binary distribution ################
+.PHONY: bindistrb checkbindistrib
+
+BINCIL_TAR_GZ:=cil-win32-@CIL_VERSION@.tar.gz
+
+# Work in a temporary directory
+BINTEMP_DIR = TEMP_cil-bindistrib
+
+# The tar archive members will be relative to this directory
+BINTOP_DIR = $(BINTEMP_DIR)/cil
+
+BINDISTRIB_ROOT = README LICENSE
+
+BINDISTRIB_LIB = Cilly.pm KeptFile.pm OutputFile.pm TempFile.pm
+
+BINDISTRIB_BIN = CilConfig.pm.in cilly cilly.bat.in \
+ patcher patcher.bat.in
+
+BINDISTRIB_OBJ = cilly.byte.exe cilly.asm.exe
+
+BINDISTRIB_SMALL1=hello.c
+
+bindistrib-nocheck: $(BINDISTRIB_ROOT) obj/x86_WIN32/cilly.asm.exe
+ # Create the distribution from scratch
+ rm -rf $(BINTEMP_DIR)
+ mkdir $(BINTEMP_DIR)
+
+ mkdir $(BINTOP_DIR) \
+ $(BINTOP_DIR)/obj \
+ $(BINTOP_DIR)/doc \
+ $(BINTOP_DIR)/lib \
+ $(BINTOP_DIR)/bin \
+ $(BINTOP_DIR)/doc/api \
+ $(BINTOP_DIR)/obj/.depend \
+ $(BINTOP_DIR)/obj/x86_WIN32 \
+ $(BINTOP_DIR)/test \
+ $(BINTOP_DIR)/test/small1
+
+ cp $(patsubst %,%,$(BINDISTRIB_ROOT)) $(BINTOP_DIR)
+ cp $(patsubst %,lib/%,$(BINDISTRIB_LIB)) $(BINTOP_DIR)/lib
+ cat bin/CilConfig.pm.in \
+ | sed -e "s|@||g" \
+ | sed -e "s|CC|cl|" \
+ | sed -e "s|DEFAULT_CIL_MODE|MSVC|" \
+ | sed -e "s|ARCHOS|x86_WIN32|" \
+ > $(BINTOP_DIR)/bin/CilConfig.pm
+ cat bin/patcher.bat.in | sed -e "s|@||g" >$(BINTOP_DIR)/bin/patcher.bat
+ cp bin/patcher $(BINTOP_DIR)/bin
+ cp bin/cilly $(BINTOP_DIR)/bin
+ cat bin/cilly.bat.in | sed -e "s|@||g" > $(BINTOP_DIR)/bin/cilly.bat
+ cp $(patsubst %,test/small1/%,$(BINDISTRIB_SMALL1)) \
+ $(BINTOP_DIR)/test/small1
+ cp $(patsubst %,obj/x86_WIN32/%,$(BINDISTRIB_OBJ)) \
+ $(BINTOP_DIR)/obj/x86_WIN32
+
+ cp -r doc/html/cil/* $(BINTOP_DIR)/doc
+# Delete all CVS directories
+ if find $(BINTEMP_DIR) -name CVS -print >cvss.txt ; then \
+ rm -rf `cat cvss.txt` ;fi
+# Now make the TAR ball
+ cd $(BINTEMP_DIR); tar cfz $(BINCIL_TAR_GZ) cil
+ mv $(BINTEMP_DIR)/$(BINCIL_TAR_GZ) .
+
+# rm -rf $(TEMP_DIR)
+
+## Check a distribution
+checkbindistrib:
+
+########################################################################
+
+
+INSTALL = @INSTALL@
+INSTALL_DATA = @INSTALL_DATA@
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+libdir = @libdir@
+pkglibdir = $(libdir)/cil
+datadir = @datadir@
+pkgdatadir = $(datadir)/cil
+
+all_mli := $(filter %.mli, $(DISTRIB_OCAMLUTIL) $(DISTRIB_SRC) $(DISTRIB_SRC_FRONTC) $(DISTRIB_SRC_EXT) $(DISTRIB_SRC_EXT_PTA))
+install_mli := $(filter $(OCAML_CIL_LIB_MODULES:=.mli), $(all_mli))
+install_cmi := $(install_mli:%.mli=$(OBJDIR)/%.cmi)
+install_cma := $(addprefix $(OBJDIR)/cil., cma cmxa a)
+install_lib := $(OCAML_CIL_LIB_CMODULES:%=$(OBJDIR)/lib%.a)
+
+install: $(install_cmi) $(install_cma) $(install_lib)
+ $(INSTALL) -d $(DESTDIR)$(pkglibdir)
+ $(INSTALL_DATA) $(install_cma) $(DESTDIR)$(pkglibdir)
+ $(INSTALL_DATA) $(install_cmi) $(DESTDIR)$(pkglibdir)
+ $(INSTALL_DATA) $(install_lib) $(DESTDIR)$(pkglibdir)
+ $(INSTALL) -d $(DESTDIR)$(pkgdatadir)
+ $(INSTALL_DATA) $(addprefix lib/, $(filter %.pm, $(DISTRIB_LIB))) $(DESTDIR)$(pkgdatadir)
+
+cil.spec: cil.spec.in
+ ./config.status $@
+
+rpms: distrib
+ rpmbuild -ta $(CIL_TAR_GZ)
+
diff --git a/cil/Makefile.msvc b/cil/Makefile.msvc
new file mode 100644
index 0000000..be1bb38
--- /dev/null
+++ b/cil/Makefile.msvc
@@ -0,0 +1,42 @@
+#
+# Makefile for CCured. The Microsoft Visual C part
+#
+COMPILERNAME=MSVC
+
+CC:=cl /nologo
+ifdef RELEASELIB
+#matth: we need the frame pointer for CHECK_GETFRAME, so
+# use /Oy- to prevent that optimization.
+ CFLAGS:=/DRELEASE /D_MSVC /Ox /Ob2 /G6 /Oy-
+else
+ CFLAGS:=/D_DEBUG /D_MSVC /Zi /MLd
+endif
+CONLY:=/c
+
+OPT_O2:= /Ox /Ob2 /G6
+
+OBJOUT:=/Fo
+OBJEXT:=obj
+
+EXEOUT:=/Fe
+LIBEXT:=lib
+LDEXT:=.exe
+
+DEF:=/D
+ASMONLY:=/Fa
+INC:=/I
+
+CPPSTART:=cl /Dx86_WIN32 /D_MSVC /E /TC /I./lib /DCCURED
+CPPOUT:= >%o
+CPP:=$(CPPSTART) /FI fixup.h %i $(CPPOUT)
+
+PATCHECHO:=echo
+
+AR:=lib
+LIBOUT:=/OUT:
+
+# The system include files to be patched
+PATCH_SYSINCLUDES:=stdio.h ctype.h string.h io.h stdarg.h crtdbg.h \
+ varargs.h stdlib.h time.h malloc.h
+
+
diff --git a/cil/README b/cil/README
new file mode 100644
index 0000000..52710f2
--- /dev/null
+++ b/cil/README
@@ -0,0 +1,2 @@
+
+ See the documentation in doc/html.
diff --git a/cil/bin/CilConfig.pm.in b/cil/bin/CilConfig.pm.in
new file mode 100644
index 0000000..94241b1
--- /dev/null
+++ b/cil/bin/CilConfig.pm.in
@@ -0,0 +1,6 @@
+
+$::archos = "@ARCHOS@";
+$::cc = "@CC@";
+$::cilhome = "@CILHOME@";
+$::default_mode = "@DEFAULT_CIL_MODE@";
+
diff --git a/cil/bin/cilly b/cil/bin/cilly
new file mode 100755
index 0000000..e4bf737
--- /dev/null
+++ b/cil/bin/cilly
@@ -0,0 +1,152 @@
+#!/usr/bin/perl
+# A simple use of the Cilly module
+#
+#
+#
+# Copyright (c) 2001-2002,
+# George C. Necula <necula@cs.berkeley.edu>
+# Scott McPeak <smcpeak@cs.berkeley.edu>
+# Wes Weimer <weimer@cs.berkeley.edu>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# 3. The names of the contributors may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+use strict;
+use Data::Dumper;
+use FindBin;
+use lib "$FindBin::Bin";
+use lib "$FindBin::Bin/../lib"; # The libraries are in the lib directory
+# Read the configuration script
+use CilConfig;
+
+use Cilly;
+
+$::default_is_merge = 0;
+my $stub = CilCompiler->new(@ARGV);
+
+$stub->setVersion ();
+
+# print Dumper($stub);
+$stub->doit();
+
+
+# Define here your favorite compiler by overriding Merger methods
+package CilCompiler;
+use File::Basename;
+use strict;
+BEGIN {
+ @CilCompiler::ISA = qw(Cilly);
+ $CilCompiler::base = "$::cilhome/obj/$::archos/cilly";
+ # Use the most recent version of cilly
+ $CilCompiler::mtime_asm = int((stat("$CilCompiler::base.asm.exe"))[9]);
+ $CilCompiler::mtime_byte = int((stat("$CilCompiler::base.byte.exe"))[9]);
+ $CilCompiler::use_debug =
+ grep(/--bytecode/, @ARGV) ||
+ grep(/--ocamldebug/, @ARGV) ||
+ ($CilCompiler::mtime_asm < $CilCompiler::mtime_byte);
+ $CilCompiler::compiler =
+ $CilCompiler::base .
+ ($CilCompiler::use_debug ? ".byte" : ".asm") . ".exe";
+ if($CilCompiler::use_debug) {
+ $ENV{"OCAMLRUNPARAM"} = "b" . $ENV{"OCAMLRUNPARAM"};
+ }
+}
+
+# We need to customize the collection of arguments
+sub collectOneArgument {
+ my($self, $arg, $pargs) = @_;
+ if($arg =~ m|--transval=(.+)$|) {
+ $self->{TRANSVAL} = $1; return 1;
+ }
+ if($arg eq '--ocamldebug') {
+ $self->{OCAMLDEBUG} = 1; return 1;
+ }
+ if($arg eq '--cabsonly') {
+ $self->{CABSONLY} = 1; return 1;
+ }
+ # See if the super class understands this
+ return $self->SUPER::collectOneArgument($arg, $pargs);
+}
+
+sub usage {
+ print "Usage: cilly [options] [gcc_or_mscl arguments]\n";
+}
+
+sub helpMessage {
+ my($self) = @_;
+ # Print first the original
+ $self->SUPER::helpMessage();
+ print <<EOF;
+
+ All other arguments starting with -- are passed to the Cilly process.
+
+The following are the arguments of the Cilly process
+EOF
+ my @cmd = ($CilCompiler::compiler, '-help');
+ $self->runShell(@cmd);
+}
+
+
+sub CillyCommand {
+ my ($self, $ppsrc, $dest) = @_;
+
+ my $aftercil;
+ my @cmd = ($CilCompiler::compiler);
+
+ if(defined $ENV{OCAMLDEBUG} || $self->{OCAMLDEBUG}) {
+ print "OCAMLDEBUG is on\n";
+ my @idirs = ("src", "src/frontc", "src/ccured", "src/ext",
+ "ocamlutil",
+ "obj/$::archos");
+ my @iflags = map { ('-I', "$::cilhome/$_") } @idirs;
+ unshift @cmd, 'ocamldebug', '-emacs', @iflags;
+ }
+ if($::docxx) {
+ push @cmd, '--cxx';
+ }
+ if($self->{CABSONLY}) {
+ $aftercil = $self->cilOutputFile($dest, 'cabs.c');
+ push @cmd, '--cabsonly', $aftercil;
+ } else {
+ if(defined $self->{CILLY_OUT}) {
+ $aftercil = new OutputFile($dest, $self->{CILLY_OUT});
+ return ($aftercil, @cmd);
+ }
+ $aftercil = $self->cilOutputFile($dest, 'cil.c');
+ }
+ return ($aftercil, @cmd, '--out', $aftercil);
+}
+
+sub MergeCommand {
+ my ($self, $ppsrc, $dir, $base) = @_;
+
+ return ('', $CilCompiler::compiler);
+}
+
+
+1;
diff --git a/cil/bin/cilly.bat.in b/cil/bin/cilly.bat.in
new file mode 100755
index 0000000..9e5a36e
--- /dev/null
+++ b/cil/bin/cilly.bat.in
@@ -0,0 +1 @@
+perl @CILHOME@/bin/cilly %*
diff --git a/cil/bin/patcher b/cil/bin/patcher
new file mode 100755
index 0000000..6eb7d15
--- /dev/null
+++ b/cil/bin/patcher
@@ -0,0 +1,605 @@
+#!/usr/bin/perl
+# A Perl script that patches a bunch of files
+#
+#
+#
+# Copyright (c) 2001-2002,
+# George C. Necula <necula@cs.berkeley.edu>
+# Scott McPeak <smcpeak@cs.berkeley.edu>
+# Wes Weimer <weimer@cs.berkeley.edu>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# 3. The names of the contributors may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+use strict;
+use File::Basename;
+use File::Copy;
+use Getopt::Long; # Command-line option processing
+use Data::Dumper;
+use FindBin;
+use lib "$FindBin::Bin";
+use lib "$FindBin::Bin/../lib";
+# Read the configuration script
+use CilConfig;
+
+$::iswin32 = $^O eq 'MSWin32' || $^O eq 'cygwin';
+# matth: On cygwin, ^O is either MSWin32 or cygwin, depending on how you build
+# perl. We don't care about the distinction, so just treat all windows
+# platforms the same when looking at "system=cygwin" tags on patches.
+$::platform = $::iswin32 ? 'cygwin' : $^O;
+
+
+# Set filename parsing according to current operating system.
+File::Basename::fileparse_set_fstype($^O);
+
+sub printHelp {
+ print <<EOL;
+Patch include files
+Usage: patcher [options] args
+
+options:
+ --help Prints this help message
+ --verbose Prints a lot of information about what is being done
+ --mode=xxx What tool to emulate:
+ GNUCC - GNU CC
+ MSVC - MS VC cl compiler
+ EDG - EDG front end
+
+ --dest=xxx The destination directory. Will make one if it does not exist
+ --patch=xxx Patch file (can be specified multiple times)
+
+ --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
+ --sfile=xxx A system-include file to be patched (treated as \#include <xxx>)
+
+ --clean Remove all files in the destination directory
+ --dumpversion Print the version name used for the current compiler
+
+ All of the other arguments are passed to the preprocessor.
+
+We will use \"$::platform\" as your system type.
+
+Send bugs to necula\@cs.berkeley.edu.
+EOL
+}
+
+
+my %option;
+&Getopt::Long::Configure("pass_through");
+&Getopt::Long::GetOptions
+ (\%option,
+ "--help", # Display help information
+ "--verbose|v", # Display information about programs invoked
+ "--mode=s", # The mode (GNUCC, MSVC)
+ "--dest=s", # The destination directory
+ "--patch=s@", # Patch files
+ "--ufile=s@", # User include files
+ "--sfile=s@", # System include files
+ "--dumpversion",
+ "--clean",
+ );
+
+if($option{help}) {
+ &printHelp();
+ exit 0;
+}
+
+# print Dumper({"option" => \%option, "ARGV" => \@ARGV});
+
+my $cversion; # Compiler version
+my $cname; # Compiler name
+my @patches; # A list of the patches to apply
+
+my $ppargs = join(' ', @ARGV);
+
+my %groups;
+
+&findCompilerVersion();
+
+if($option{dumpversion}) {
+ print $cversion;
+ exit 0;
+}
+
+# Find the destination directory
+if(!defined($option{dest})) {
+ die "Must give a --dest directory\n";
+}
+if(! -d $option{dest}) {
+ die "The destination directory $option{dest} does not exist\n";
+}
+
+if($option{clean}) {
+ # Find the destination directory for a dummy file
+ my $dest = &destinationFileName("");
+ chop $dest; # The final /
+ print "Cleaning all files in $dest\n";
+ (!system("rm -rf $dest")) || die "Cannot remove directory\n";
+ exit 0;
+}
+
+print "Patching files for $cname version $cversion\n";
+
+# Prepare the patches
+if(defined($option{patch})) {
+ my $pFile;
+ foreach $pFile (@{$option{patch}}) {
+ &preparePatchFile($pFile);
+ }
+}
+
+# print Dumper(\@patches);
+
+my $file;
+foreach $file (@{$option{ufile}}) {
+ &patchOneFile($file, 0);
+}
+foreach $file (@{$option{sfile}}) {
+ &patchOneFile($file, 1);
+}
+
+# Now check whether we have used all the patches
+my $hadError = 0;
+foreach my $patch (@patches) {
+ # It was optional
+ if(defined $patch->{FLAGS}->{optional} ||
+ defined $patch->{FLAGS}->{disabled}) { next; }
+ # It was for another system
+ if(defined $patch->{FLAGS}->{system} &&
+ $patch->{FLAGS}->{system} ne $::platform) { next; }
+ # Its group was done
+ if(defined $patch->{FLAGS}->{group}) {
+ if(! defined $groups{$patch->{FLAGS}->{group}}) {
+ $hadError = 1;
+ print "None of the following patches from group $patch->{FLAGS}->{group} was used:\n";
+ foreach my $gp (@patches) {
+ if($gp->{FLAGS}->{group} eq $patch->{FLAGS}->{group}) {
+ print "\tfrom $gp->{PATCHFILE} at $gp->{PATCHLINENO}\n";
+ }
+ }
+ $groups{$patch->{FLAGS}->{group}} = 1; # We're done with it
+ }
+ next;
+ }
+ # It was not in a group and was not optional
+ if(! defined $patch->{USED}) {
+ $hadError = 1;
+ print "Non-optional patch was not used:\n\tfrom $patch->{PATCHFILE} at $patch->{PATCHLINENO}\n";
+ next;
+ }
+}
+exit $hadError;
+
+
+############# SUBROUTINES
+sub findCompilerVersion {
+ $cname = "";
+ $cversion = 0;
+ if($option{mode} eq "GNUCC") {
+ $cname = "GNU CC";
+ open(VER, "$::cc -dumpversion $ppargs|")
+ || die "Cannot start $cname";
+ while(<VER>) {
+ # sm: had to modify this to match "egcs-2.91.66", which is
+ # how egcs responds to the -dumpversion request
+ if($_ =~ m|^(\d+\S+)| ||
+ $_ =~ m|^(egcs-\d+\S+)|) {
+ $cversion = "gcc_$1";
+ close(VER) || die "Cannot start $cname\n";
+ return;
+ }
+ }
+ die "Cannot find the version for GCC\n";
+ }
+ if($option{mode} eq "MSVC") {
+ $cname = "Microsoft cl";
+ $ppargs =~ s|/nologo||g;
+ open(VER, "cl $ppargs 2>&1|") || die "Cannot start $cname: cl $ppargs\n";
+ while(<VER>) {
+ if($_ =~ m|Compiler Version (\S+) |) {
+ $cversion = "cl_$1";
+ close(VER);
+ return;
+ }
+ }
+ die "Cannot find the version for Microsoft CL\n";
+ }
+ die "You must specify a --mode (either GNUCC or MSVC)";
+}
+
+sub lineDirective {
+ my ($fileName, $lineno) = @_;
+ if($::iswin32) {
+ $fileName =~ s|\\|/|g;
+ }
+ if($option{mode} eq "MSVC") {
+ return "#line $lineno \"$fileName\"\n";
+ }
+ if($option{mode} eq "GNUCC" || $option{mode} eq "EDG") {
+ return "# $lineno \"$fileName\"\n";
+ }
+ die "lineDirective: invalid mode";
+}
+
+# Find the absolute name for a file
+sub patchOneFile {
+ my ($fname, $issys) = @_;
+ my $fname1 = $issys ? "<$fname>" : "\"$fname\"";
+ print "Patching $fname1\n";
+ my $preprocfile = "__topreproc";
+ unlink "$preprocfile.i";
+ open(TOPREPROC, ">$preprocfile.c") || die "Cannot open preprocessor file";
+ print TOPREPROC "#include $fname1\n";
+ close(TOPREPROC);
+ # Do not test for error while running the preprocessor because the
+ # error might be due to an #error directive
+ my $preproccmd = "";
+ if($option{mode} eq "GNUCC") {
+ $preproccmd = "$::cc -E $ppargs $preprocfile.c >$preprocfile.i";
+ if ($^O ne 'MSWin32') { # Windows has no /dev/null
+ # ignore stderr (e.g. #error directives)
+ $preproccmd .= " 2>/dev/null";
+ }
+ } elsif($option{mode} eq "MSVC") {
+ $preproccmd = "cl /nologo /P $ppargs $preprocfile.c";
+ } else { die "Invalid --mode"; }
+
+ if(system($preproccmd) && $option{mode} eq "MSVC" ) {
+ # For some reason the gcc returns spurious error codes
+ die "Error running preprocessor: $preproccmd"
+ }
+
+ # Now scan the resulting file and get the real name of the file
+ my $absname = "";
+ open(PPOUT, "<$preprocfile.i") || die "Cannot find $preprocfile.i";
+ while(<PPOUT>) {
+ if($_ =~ m|^\#.+\"(.+$fname)\"|) {
+ $absname = $1;
+ last;
+ }
+ }
+ close(PPOUT);
+ if($absname eq "") {
+ die "Cannot find the absolute name of $fname1 in $preprocfile.i\n";
+ }
+ unlink "$preprocfile.c";
+ unlink "$preprocfile.i";
+ # If we fail then maybe we are using cygwin paths in a Win32 system
+ if($option{mode} eq "GNUCC" && $::iswin32) {
+ open(WINNAME, "cygpath -w $absname|")
+ || die "Cannot run cygpath to convert $absname to a Windows name";
+ $absname = <WINNAME>;
+ if($absname =~ m|\n$|) {
+ chop $absname;
+ }
+ # print "Converted $fileName to $newName\n";
+ close(WINNAME) || die "Cannot run cygpath to convert $absname";
+ }
+ if(! -f $absname) { #matth: we need to do this test after calling cygpath
+ die "Cannot find the absolute name of $fname1 (\"$absname\")\n";
+ }
+ print " Absolute name is $absname\n";
+ # Decide where to put the result
+ my $dest = &destinationFileName($fname);
+ print " Destination is $dest\n";
+ &applyPatches($absname, $dest);
+}
+
+# Is absolute path name?
+sub isAbsolute {
+ my($name) = @_;
+ if($::iswin32) {
+ return ($name =~ m%^([a-zA-Z]:)?[/\\]%);
+ } else {
+ return ($name =~ m%^[/\\]%);
+ }
+}
+
+# Compute the destination file name and create all necessary directories
+sub destinationFileName {
+ my ($fname) = @_;
+ if(&isAbsolute($fname)) {
+ die "Cannot process files that have absolute names\n";
+ }
+ my $dest = $option{dest} . "/" . $cversion;
+ # Break the file name into components
+ my @fnamecomp = split(m%[/\\]%, $fname);
+ # Add one component at a time
+ do {
+ if(! -d $dest) {
+ (mkdir $dest, 0777) || die "Cannot create directory $dest\n";
+ }
+ my $comp = shift @fnamecomp;
+ $dest .= ('/' . $comp);
+ } while($#fnamecomp >= 0);
+ return $dest;
+}
+#####################################################################
+# Patching of files
+#
+sub preparePatchFile {
+ my ($pFile) = @_;
+ open(PFILE, "<$pFile") ||
+ die "Cannot read patch file $pFile\n";
+ my $patchLineNo = 0;
+ my $patchStartLine = 0;
+ NextPattern:
+ while(<PFILE>) {
+ $patchLineNo ++;
+ if($_ !~ m|^<<<(.*)$|) {
+ next;
+ }
+ # Process the flags
+ my @patchflags = split(/\s*,\s*/, $1);
+ my %valueflags;
+ foreach my $flg (@patchflags) {
+ $flg = &trimSpaces($flg);
+ if($flg =~ m|^(.+)\s*=\s*(.+)$|) {
+ $valueflags{$1} = $2;
+ } else {
+ $valueflags{$flg} = 1;
+ }
+ }
+ # Now we have found the start
+ $_ = <PFILE>;
+ $patchLineNo ++;
+ my $current_pattern = [];
+ my @all_patterns = ();
+ if($_ =~ m|^===|) {
+ if(! defined $valueflags{ateof} &&
+ ! defined $valueflags{atsof}) {
+ die "A pattern is missing in $pFile";
+ }
+ goto AfterPattern;
+ }
+ if($_ eq "") {
+ die "A pattern is missing in $pFile";
+ }
+ push @{$current_pattern}, $_;
+
+ while(<PFILE>) {
+ $patchLineNo ++;
+ if($_ =~ m|^===|) {
+ last;
+ }
+ if($_ =~ m%^\|\|\|%) {
+ # This is an alternate pattern
+ push @all_patterns, $current_pattern;
+ $current_pattern = [];
+ next;
+ }
+ push @{$current_pattern}, $_;
+ }
+ AfterPattern:
+ # Finish off the last pattern
+ push @all_patterns, $current_pattern;
+ if($_ !~ m|^===|) {
+ die "No separator found after pattern in $pFile";
+ }
+ $patchStartLine = $patchLineNo + 1;
+ my $replacement = "";
+ # If we have more than one non-optional pattern with no group
+ # specified, then create a group
+ if(@all_patterns > 1 &&
+ ! defined $valueflags{group} &&
+ ! defined $valueflags{optional}) {
+ $valueflags{group} = $pFile . "_$patchStartLine";
+ }
+ while(<PFILE>) {
+ $patchLineNo ++;
+ if($_ =~ m|^>>>|) {
+ # For each alternate pattern
+ my $patt;
+ foreach $patt (@all_patterns) {
+ # Maybe the @__pattern__@ string appears in the replacement
+ my $pattern_repl = join('', @{$patt});
+ my $nrlines = int(@{$patt});
+ my $local_repl = $replacement;
+ $local_repl =~ s/\@__pattern__\@/$pattern_repl/g;
+ # Strip the spaces from patterns
+ my @pattern_no_space = ();
+ my $i;
+ foreach $i (@{$patt}) {
+ $i =~ s/\s+//g;
+ push @pattern_no_space, $i;
+ }
+ push @patches, { HEAD => $pattern_no_space[0],
+ FLAGS => \%valueflags,
+ NRLINES => $nrlines,
+ PATTERNS => \@pattern_no_space,
+ REPLACE => $local_repl,
+ PATCHFILE => $pFile,
+ PATCHLINENO => $patchStartLine,
+ };
+ }
+ next NextPattern;
+ }
+ $replacement .= $_;
+ }
+ die "Unfinished replacement for pattern in $pFile";
+ }
+ close(PFILE) ||
+ die "Cannot close patch file $pFile\n";
+ print "Loaded patches from $pFile\n";
+ # print Dumper(\@patches); die "Here\n";
+
+}
+
+sub trimSpaces {
+ my($str) = @_;
+ if($str =~ m|^\s+(\S.*)$|) {
+ $str = $1;
+ }
+ if($str =~ m|^(.*\S)\s+$|) {
+ $str = $1;
+ }
+ return $str;
+}
+
+
+my @includeReadAhead = ();
+sub readIncludeLine {
+ my($infile) = @_;
+ if($#includeReadAhead < 0) {
+ my $newLine = <$infile>;
+ return $newLine;
+ } else {
+ return shift @includeReadAhead;
+ }
+}
+
+sub undoReadIncludeLine {
+ my($line) = @_;
+ push @includeReadAhead, $line;
+}
+
+sub applyPatches {
+ my($in, $out) = @_;
+ # Initialize all the patches
+ my $patch;
+ # And remember the EOF patches that are applicable here
+ my @eof_patches = ();
+ foreach $patch (@patches) {
+ $patch->{USE} = 1;
+ my $infile = $patch->{FLAGS}->{file};
+ if(defined $infile && $in !~ m|$infile$|) {
+# print "Will not use patch ",
+# &lineDirective($patch->{PATCHFILE},$patch->{PATCHLINENO});
+ $patch->{USE} = 0;
+ next;
+ }
+ # Disable the system specific patterns
+ if(defined $patch->{FLAGS}->{system} &&
+ $patch->{FLAGS}->{system} ne $::platform) {
+ $patch->{USE} = 0;
+ next;
+ }
+ # Disable also (for now) the patches that must be applied at EOF
+ if(defined $patch->{FLAGS}->{ateof} ||
+ defined $patch->{FLAGS}->{atsof} ||
+ defined $patch->{FLAGS}->{disabled} ) {
+ $patch->{USE} = 0;
+ push @eof_patches, $patch;
+ }
+
+ }
+
+ open(OUT, ">$out") || die "Cannot open patch output file $out";
+ open(IN, "<$in") || die "Cannot open patch input file $in";
+
+ @includeReadAhead = ();
+
+ my $lineno = 0;
+ my $line; # The current line
+
+ # the file name that should be printed in the line directives
+ my $lineDirectiveFile = $in;
+ # Now apply the SOF patches
+ foreach my $patch (@eof_patches) {
+ if(defined $patch->{FLAGS}->{atsof}) {
+ my $line = &applyOnePatch($patch, &lineDirective($in, $lineno));
+ print OUT $line;
+ }
+ }
+
+ while($line = &readIncludeLine(\*IN)) {
+ $lineno ++;
+ # Now we have a line to print out. See if it needs patching
+ my $patch;
+ my @lines = ($line); # A number of lines
+ my $nrLines = 1; # How many lines
+ my $toundo = 0;
+ NextPatch:
+ foreach $patch (@patches) {
+ if(! $patch->{USE}) { next; } # We are not using this patch
+ my $line_no_spaces = $line;
+ $line_no_spaces =~ s/\s+//g;
+ if($line_no_spaces eq $patch->{HEAD}) {
+ # Now see if all the lines match
+ my $patNrLines = $patch->{NRLINES};
+ if($patNrLines > 1) {
+ # Make sure we have enough lines
+ while($nrLines < $patNrLines) {
+ push @lines, &readIncludeLine(\*IN);
+ $nrLines ++;
+ $toundo ++;
+ }
+ my @checkLines = @{$patch->{PATTERNS}};
+ my $i;
+ # print "check: ", join(":", @checkLines);
+ # print "with $nrLines lines: ", join("+", @lines);
+ for($i=0;$i<$patNrLines;$i++) {
+ $line_no_spaces = $lines[$i];
+ $line_no_spaces =~ s/\s+//g;
+ if($checkLines[$i] ne $line_no_spaces) {
+ # print "No match for $patch->{HEAD}\n";
+ next NextPatch;
+ }
+ }
+ }
+ # print "Using patch from $patch->{PATCHFILE}:$patch->{PATCHLINENO} at $in:$lineno\n";
+ # Now replace
+ $lineno += ($patNrLines - 1);
+ $toundo -= ($patNrLines - 1);
+ $line = &applyOnePatch($patch, &lineDirective($in, $lineno + 1));
+ last;
+ }
+ }
+ print OUT $line;
+ # Now undo all but the first line
+ my $i;
+ for($i=$nrLines - $toundo;$i<$nrLines;$i++) {
+ &undoReadIncludeLine($lines[$i]);
+ }
+ }
+ close(IN) || die "Cannot close file $in";
+ # Now apply the EOF patches
+ foreach $patch (@eof_patches) {
+ if(defined $patch->{FLAGS}->{ateof}) {
+ my $line = &applyOnePatch($patch, &lineDirective($in, $lineno));
+ print OUT $line;
+ }
+ }
+
+ close(OUT);
+ return 1;
+}
+
+
+sub applyOnePatch {
+ my($patch, $after) = @_;
+ my $line = &lineDirective($patch->{PATCHFILE},
+ $patch->{PATCHLINENO});
+ $line .= $patch->{REPLACE};
+ $line .= $after;
+ # Mark that we have used this group
+ $patch->{USED} = 1;
+ if(defined $patch->{FLAGS}->{group}) {
+ $groups{$patch->{FLAGS}->{group}} = 1;
+ }
+ return $line;
+}
diff --git a/cil/bin/patcher.bat.in b/cil/bin/patcher.bat.in
new file mode 100755
index 0000000..2e356ae
--- /dev/null
+++ b/cil/bin/patcher.bat.in
@@ -0,0 +1 @@
+perl @CILHOME@/bin/patcher %*
diff --git a/cil/bin/teetwo b/cil/bin/teetwo
new file mode 100755
index 0000000..2aa68fa
--- /dev/null
+++ b/cil/bin/teetwo
@@ -0,0 +1,36 @@
+#!/bin/bash
+# run a command, sending stdout to one file and stderr to another,
+# but also sending both to this process' stdout/stderr, respectively
+
+if [ "$3" = "" ]; then
+ echo "usage: $0 stdout-file stderr-file cmd [args..]"
+ exit 0
+fi
+
+stdoutFile="$1"
+stderrFile="$2"
+command="$3"
+shift
+shift
+shift
+
+result=0
+handler() {
+ # this signal means the underlying command exit erroneously,
+ # though we don't know the code
+ echo "The command failed!"
+ result=2
+}
+trap handler SIGUSR1
+
+# dup my stdout/err on fd 3,4
+exec 3>&1
+exec 4>&2
+
+
+# run the command with tees to duplicate the data
+mypid=$$
+# echo "mypid = $mypid, command=$command, args=$@, stdout=$stdoutFile, stderr=$stderrFile"
+(("$command" "$@" || kill -s USR1 $mypid) | tee "$stdoutFile" >&3) 2>&1 | tee "$stderrFile" >&4
+
+exit $result
diff --git a/cil/bin/test-bad b/cil/bin/test-bad
new file mode 100755
index 0000000..4eacdc0
--- /dev/null
+++ b/cil/bin/test-bad
@@ -0,0 +1,202 @@
+#!/bin/sh
+# run a regression test containing one or more intentional failures
+#
+# To create a source file to be processed by this script do the following:
+# - the file should be a standalone program with main without any arguments
+# You can add other files as part of the CFLAGS variable
+# - add a comment
+# // NUMERRORS n
+# where n is the number of errors to be tested by this file
+#
+# This file is processed n+1 times. The first time, it should succeed (main returns or
+# exits with code 0) and the other n times it should fail.
+# For each run the preprocessor variable ERROR is defined to be
+# be k (0 <= k <= n).
+# You can mark certain lines in your program so that they are used ONLY in a certain run: put the
+# following comment after a line to make it appear only in the run with ERROR == 3
+#
+# some_code; // ERROR(3)
+#
+#
+# Furthermore, for each run that is intended to fail you can specify a string that
+# must appear in the output.
+#
+# some_code; // ERROR(3):this string must appear in output
+#
+# Do not put any spaces around the :
+#
+# Simple example:
+#
+# #define E(n) {printf("Error %d\n", n); exit(n); }
+# #define SUCCESS {printf("Success\n"); exit(0); }
+#
+# // NUMERRORS 3
+# int main() {
+#
+# char char x; // ERROR(1):invalid type specifier
+# int y;
+# int z = ++y;
+# // This conditional should be true
+# if(z == y) E(2); // ERROR(2):Error 2
+#
+# #if ERROR == 3
+# z = (++y, y--);
+# if(z == y + 1) E(3); // ERROR(3):Error 3
+# #endif
+#
+# SUCCESS;
+# }
+#
+#
+# set RUNONLY=n to run only the test case n
+#
+
+if [ "$1" = "" ]; then
+ # most parameters are passed by name, instead of as positional
+ # arguments, for better impedance match with Makefile; but it's
+ # good to have at least 1 positional arg so when it's missing I
+ # can easily tell, and print this message
+ echo "usage: CILHOME=... CILLY=... CFLAGS=... $0 source-file.c"
+ echo "You can also set RUNONLY=n to run only the nth iteration"
+ exit 0
+fi
+echo "CILLY=$CILLY"
+echo "CFLAGS=$CFLAGS"
+srcfile="$1"
+# Construct the name of the temporary file to use
+srcfilenoext=`echo $srcfile | sed s/.c\$//`
+tmpname="$srcfilenoext-tmp"
+
+# for GCC, use "# xx foo.c". For MSVC, use "#line xx foo.c"
+if [ "$_MSVC" != "" ]; then
+ LINEOPT="line"
+ OUTFLAG="/Fe"
+ OUTEXT=".exe"
+else
+ LINEOPT=""
+ OUTFLAG="-o "
+ OUTEXT=".exe" # So that I can delete the executables
+fi
+
+# Start it in the right directory
+# cd "$CILLYHOME/test/small2" || exit
+
+# read how many failure cases are in the file; expect line of form
+# "// NUMERRORS n"
+numcases=`grep NUMERRORS "$srcfile" | perl -e '$_ = <>; m|(\d+)|; print $1;'`
+if [ -z "$numcases" ]; then
+ echo "didn't find a string of form NUMERRORS <n> in the file"
+ exit 2
+fi
+echo "there are $numcases failure cases in this file"
+
+
+# iterate through the cases; first case (0) is where no errors are present
+i=0
+if [ "$RUNONLY" != "" ] ;then
+ i=$RUNONLY
+fi
+while [ $i -le $numcases ]; do
+ echo
+ echo
+ echo "********************** Iteration $i"
+ echo
+ echo
+ # generate a temporary file; first hide the ERROR tags which identify
+ # the current test, then remove all remaining ERROR lines
+ # (syntax for errors has parentheses so if I have >=10 cases I don't
+ # run into problems where e.g. ERROR1 is a substring of ERROR10)
+ # use the little perl script to put line number directives where we remove
+ # lines
+ echo "generating test $i"
+ rm -f $tmpname.c 2>/dev/null
+ ( echo "#define ERROR $i"; echo "#$LINEOPT 1 \"$srcfile\"";cat "$srcfile") |\
+ sed "s|ERROR($i)|(selected: $i)|" | \
+ perl -e 'my $ln = 0; while(<>) { if($_ =~ m|ERROR\(|) { print "#'$LINEOPT' $ln\n"; } else { print $_; }; $ln ++}' \
+ > "$tmpname.c"
+ chmod a-w "$tmpname.c"
+
+ # Grab the errorline for this test case
+ themsg=`cat "$srcfile" | grep "ERROR($i).*:" | sed "s/^.*ERROR.*://" `
+ if [ "x$themsg" != "x" ] ;then
+ echo "Expecting error message:$themsg"
+ fi
+
+ # compile this with our tool
+ rm -f test-bad.out test-bad.err ${tmpname}$OUTEXT
+ echo $CILLY $CFLAGS $tmpname.c ${OUTFLAG}${tmpname}$OUTEXT
+ $CILHOME/bin/teetwo test-bad.out test-bad.err \
+ $CILLY $CFLAGS -DERROR=$i $tmpname.c ${OUTFLAG}${tmpname}$OUTEXT
+ # cat test-bad.out test-bad.err
+ status=$?
+ runit=1
+ if [ $status != 0 ]; then
+ if [ $i = 0 ] ;then
+ echo "The 0th iteration failed to CURE! It is supposed to succeed."
+ exit $status
+ else
+ if [ "x$themsg" != "x" ] ;then
+ echo "grep \"$themsg\" test-bad.out test-bad.err"
+ if ! grep "$themsg" test-bad.out test-bad.err ;then
+ echo "The ${i}th iteration failed to CURE but cannot find: $themsg"
+ exit 3
+ else
+ echo "The ${i}th iteration failed to CURE, as expected!"
+ fi
+ else
+ echo "The ${i}th iteration failed to CURE. We expected some failure!"
+ fi
+ runit=0
+ fi
+ fi
+
+ # run it
+ if [ $runit != 0 ]; then
+ echo "./$tmpname$OUTEXT"
+ rm -f test-bad.out test-bad.err
+ if $CILHOME/bin/teetwo test-bad.out test-bad.err ./$tmpname$OUTEXT ; then
+ # cat test-bad.out test-bad.err
+ if [ $i = 0 ]; then
+ # expected success on 0th iteration
+ echo "(succeeded as expected)"
+ else
+ # unexpected success on >0th iteration
+ echo "The ${i}th iteration did not fail! It is supposed to fail."
+ exit 2
+ fi
+ else
+ # cat test-bad.out test-bad.err
+ if [ $i = 0 ]; then
+ # unexpected failure on 0th iteration
+ echo "The 0th iteration failed! It is supposed to succeed."
+ #cat $tmpname.c
+ exit 2
+ else
+ # expected failure on >0th iteration
+ if [ "x$themsg" != "x" ] ;then
+ echo "grep \"$themsg\" test-bad.out test-bad.err"
+ if ! grep "$themsg" test-bad.out test-bad.err ;then
+ echo "The ${i}th iteration failed but cannot find:$themsg"
+ exit 3
+ fi
+ fi
+ echo "(failed as expected)"
+ fi
+ fi
+ fi
+
+ # possibly bail after 0th
+ if [ "$TESTBADONCE" != "" ]; then
+ echo "bailing after 0th iteration because TESTBADONCE is set"
+ exit 0
+ fi
+ if [ "$RUNONLY" != "" ]; then
+ echo "bailing after ${RUNONLY}th iteration because RUNONLY is set"
+ exit 0
+ fi
+
+ i=`expr $i + 1`
+done
+
+echo "all $numcases cases in $srcfile failed as expected"
+
diff --git a/cil/cil.spec b/cil/cil.spec
new file mode 100644
index 0000000..5380973
--- /dev/null
+++ b/cil/cil.spec
@@ -0,0 +1,90 @@
+Name: cil
+Version: 1.3.5
+Release: 1
+License: BSD
+URL: http://manju.cs.berkeley.edu/cil/
+Source0: %{name}-%{version}.tar.gz
+BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-buildroot
+BuildRequires: gcc
+BuildRequires: ocaml >= 3.08
+BuildRequires: perl >= 5.6.1
+
+# No ELF executables or shared libraries
+%define debug_package %{nil}
+
+
+########################################################################
+#
+# Package cil
+#
+
+Summary: OCaml library for C program analysis and transformation
+Group: Development/Libraries
+Requires: perl >= 5.6.1
+
+%description
+CIL (C Intermediate Language) is a high-level representation along
+with a set of tools that permit easy analysis and source-to-source
+transformation of C programs.
+
+This package provides Perl modules which are useful for building
+compiler wrappers. A wrapper can use CIL to transform C code before
+passing it along to the native C compiler.
+
+%files
+%defattr(-,root,root,-)
+%doc LICENSE
+%{_datadir}/%{name}
+
+
+########################################################################
+#
+# Package cil-devel
+#
+
+%package devel
+
+Summary: OCaml library for C program analysis and transformation
+Group: Development/Libraries
+Requires: ocaml >= 3.04
+
+%description devel
+CIL (C Intermediate Language) is a high-level representation along
+with a set of tools that permit easy analysis and source-to-source
+transformation of C programs.
+
+This package provides OCaml interfaces and an OCaml library which form
+the CIL API.
+
+%files devel
+%defattr(-,root,root,-)
+%doc LICENSE
+%{_libdir}/%{name}
+
+
+########################################################################
+#
+# General scripts
+#
+
+%prep
+%setup -q -n %{name}
+
+%build
+%configure
+%define cilmake make -f Makefile.cil
+%cilmake cilversion machdep
+%cilmake cillib NATIVECAML=
+%cilmake cillib NATIVECAML=1
+
+%install
+rm -rf $RPM_BUILD_ROOT
+%makeinstall
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+
+%changelog
+* Tue Aug 5 2003 Ben Liblit <liblit@cs.berkeley.edu>
+- Initial build.
diff --git a/cil/cil.spec.in b/cil/cil.spec.in
new file mode 100644
index 0000000..0a47dbd
--- /dev/null
+++ b/cil/cil.spec.in
@@ -0,0 +1,90 @@
+Name: cil
+Version: @CIL_VERSION@
+Release: 1
+License: BSD
+URL: http://manju.cs.berkeley.edu/cil/
+Source0: %{name}-%{version}.tar.gz
+BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-buildroot
+BuildRequires: gcc
+BuildRequires: ocaml >= 3.08
+BuildRequires: perl >= 5.6.1
+
+# No ELF executables or shared libraries
+%define debug_package %{nil}
+
+
+########################################################################
+#
+# Package cil
+#
+
+Summary: OCaml library for C program analysis and transformation
+Group: Development/Libraries
+Requires: perl >= 5.6.1
+
+%description
+CIL (C Intermediate Language) is a high-level representation along
+with a set of tools that permit easy analysis and source-to-source
+transformation of C programs.
+
+This package provides Perl modules which are useful for building
+compiler wrappers. A wrapper can use CIL to transform C code before
+passing it along to the native C compiler.
+
+%files
+%defattr(-,root,root,-)
+%doc LICENSE
+%{_datadir}/%{name}
+
+
+########################################################################
+#
+# Package cil-devel
+#
+
+%package devel
+
+Summary: OCaml library for C program analysis and transformation
+Group: Development/Libraries
+Requires: ocaml >= 3.04
+
+%description devel
+CIL (C Intermediate Language) is a high-level representation along
+with a set of tools that permit easy analysis and source-to-source
+transformation of C programs.
+
+This package provides OCaml interfaces and an OCaml library which form
+the CIL API.
+
+%files devel
+%defattr(-,root,root,-)
+%doc LICENSE
+%{_libdir}/%{name}
+
+
+########################################################################
+#
+# General scripts
+#
+
+%prep
+%setup -q -n %{name}
+
+%build
+%configure
+%define cilmake make -f Makefile.cil
+%cilmake cilversion machdep
+%cilmake cillib NATIVECAML=
+%cilmake cillib NATIVECAML=1
+
+%install
+rm -rf $RPM_BUILD_ROOT
+%makeinstall
+
+%clean
+rm -rf $RPM_BUILD_ROOT
+
+
+%changelog
+* Tue Aug 5 2003 Ben Liblit <liblit@cs.berkeley.edu>
+- Initial build.
diff --git a/cil/config.guess b/cil/config.guess
new file mode 100755
index 0000000..c085f4f
--- /dev/null
+++ b/cil/config.guess
@@ -0,0 +1,1497 @@
+#! /bin/sh
+# Attempt to guess a canonical system name.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation,
+# Inc.
+
+timestamp='2006-05-13'
+
+# This file is free software; you can redistribute it and/or modify it
+# 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 program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
+# 02110-1301, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+
+# Originally written by Per Bothner <per@bothner.com>.
+# Please send patches to <config-patches@gnu.org>. Submit a context
+# diff and a properly formatted ChangeLog entry.
+#
+# This script attempts to guess a canonical system name similar to
+# config.sub. If it succeeds, it prints the system name on stdout, and
+# exits with 0. Otherwise, it exits with 1.
+#
+# The plan is that this can be called by configure scripts if you
+# don't specify an explicit build system type.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION]
+
+Output the configuration name of the system \`$me' is run on.
+
+Operation modes:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.guess ($timestamp)
+
+Originally written by Per Bothner.
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
+Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit ;;
+ --version | -v )
+ echo "$version" ; exit ;;
+ --help | --h* | -h )
+ echo "$usage"; exit ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help" >&2
+ exit 1 ;;
+ * )
+ break ;;
+ esac
+done
+
+if test $# != 0; then
+ echo "$me: too many arguments$help" >&2
+ exit 1
+fi
+
+trap 'exit 1' 1 2 15
+
+# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
+# compiler to aid in system detection is discouraged as it requires
+# temporary files to be created and, as you can see below, it is a
+# headache to deal with in a portable fashion.
+
+# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
+# use `HOST_CC' if defined, but it is deprecated.
+
+# Portable tmp directory creation inspired by the Autoconf team.
+
+set_cc_for_build='
+trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
+trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
+: ${TMPDIR=/tmp} ;
+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
+dummy=$tmp/dummy ;
+tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
+case $CC_FOR_BUILD,$HOST_CC,$CC in
+ ,,) echo "int x;" > $dummy.c ;
+ for c in cc gcc c89 c99 ; do
+ if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
+ CC_FOR_BUILD="$c"; break ;
+ fi ;
+ done ;
+ if test x"$CC_FOR_BUILD" = x ; then
+ CC_FOR_BUILD=no_compiler_found ;
+ fi
+ ;;
+ ,,*) CC_FOR_BUILD=$CC ;;
+ ,*,*) CC_FOR_BUILD=$HOST_CC ;;
+esac ; set_cc_for_build= ;'
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 1994-08-24)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ *:NetBSD:*:*)
+ # NetBSD (nbsd) targets should (where applicable) match one or
+ # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,
+ # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
+ # switched to ELF, *-*-netbsd* would select the old
+ # object file format. This provides both forward
+ # compatibility and a consistent mechanism for selecting the
+ # object file format.
+ #
+ # Note: NetBSD doesn't particularly care about the vendor
+ # portion of the name. We always set it to "unknown".
+ sysctl="sysctl -n hw.machine_arch"
+ UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
+ /usr/sbin/$sysctl 2>/dev/null || echo unknown)`
+ case "${UNAME_MACHINE_ARCH}" in
+ armeb) machine=armeb-unknown ;;
+ arm*) machine=arm-unknown ;;
+ sh3el) machine=shl-unknown ;;
+ sh3eb) machine=sh-unknown ;;
+ *) machine=${UNAME_MACHINE_ARCH}-unknown ;;
+ esac
+ # The Operating System including object format, if it has switched
+ # to ELF recently, or will in the future.
+ case "${UNAME_MACHINE_ARCH}" in
+ arm*|i386|m68k|ns32k|sh3*|sparc|vax)
+ eval $set_cc_for_build
+ if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
+ | grep __ELF__ >/dev/null
+ then
+ # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
+ # Return netbsd for either. FIX?
+ os=netbsd
+ else
+ os=netbsdelf
+ fi
+ ;;
+ *)
+ os=netbsd
+ ;;
+ esac
+ # The OS release
+ # Debian GNU/NetBSD machines have a different userland, and
+ # thus, need a distinct triplet. However, they do not need
+ # kernel version information, so it can be replaced with a
+ # suitable tag, in the style of linux-gnu.
+ case "${UNAME_VERSION}" in
+ Debian*)
+ release='-gnu'
+ ;;
+ *)
+ release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ ;;
+ esac
+ # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
+ # contains redundant information, the shorter form:
+ # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
+ echo "${machine}-${os}${release}"
+ exit ;;
+ *:OpenBSD:*:*)
+ UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
+ echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
+ exit ;;
+ *:ekkoBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
+ exit ;;
+ *:SolidBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
+ exit ;;
+ macppc:MirBSD:*:*)
+ echo powerppc-unknown-mirbsd${UNAME_RELEASE}
+ exit ;;
+ *:MirBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
+ exit ;;
+ alpha:OSF1:*:*)
+ case $UNAME_RELEASE in
+ *4.0)
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
+ ;;
+ *5.*)
+ UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
+ ;;
+ esac
+ # According to Compaq, /usr/sbin/psrinfo has been available on
+ # OSF/1 and Tru64 systems produced since 1995. I hope that
+ # covers most systems running today. This code pipes the CPU
+ # types through head -n 1, so we only detect the type of CPU 0.
+ ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
+ case "$ALPHA_CPU_TYPE" in
+ "EV4 (21064)")
+ UNAME_MACHINE="alpha" ;;
+ "EV4.5 (21064)")
+ UNAME_MACHINE="alpha" ;;
+ "LCA4 (21066/21068)")
+ UNAME_MACHINE="alpha" ;;
+ "EV5 (21164)")
+ UNAME_MACHINE="alphaev5" ;;
+ "EV5.6 (21164A)")
+ UNAME_MACHINE="alphaev56" ;;
+ "EV5.6 (21164PC)")
+ UNAME_MACHINE="alphapca56" ;;
+ "EV5.7 (21164PC)")
+ UNAME_MACHINE="alphapca57" ;;
+ "EV6 (21264)")
+ UNAME_MACHINE="alphaev6" ;;
+ "EV6.7 (21264A)")
+ UNAME_MACHINE="alphaev67" ;;
+ "EV6.8CB (21264C)")
+ UNAME_MACHINE="alphaev68" ;;
+ "EV6.8AL (21264B)")
+ UNAME_MACHINE="alphaev68" ;;
+ "EV6.8CX (21264D)")
+ UNAME_MACHINE="alphaev68" ;;
+ "EV6.9A (21264/EV69A)")
+ UNAME_MACHINE="alphaev69" ;;
+ "EV7 (21364)")
+ UNAME_MACHINE="alphaev7" ;;
+ "EV7.9 (21364A)")
+ UNAME_MACHINE="alphaev79" ;;
+ esac
+ # A Pn.n version is a patched version.
+ # A Vn.n version is a released version.
+ # A Tn.n version is a released field test version.
+ # A Xn.n version is an unreleased experimental baselevel.
+ # 1.2 uses "1.2" for uname -r.
+ echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+ exit ;;
+ Alpha\ *:Windows_NT*:*)
+ # How do we know it's Interix rather than the generic POSIX subsystem?
+ # Should we change UNAME_MACHINE based on the output of uname instead
+ # of the specific Alpha model?
+ echo alpha-pc-interix
+ exit ;;
+ 21064:Windows_NT:50:3)
+ echo alpha-dec-winnt3.5
+ exit ;;
+ Amiga*:UNIX_System_V:4.0:*)
+ echo m68k-unknown-sysv4
+ exit ;;
+ *:[Aa]miga[Oo][Ss]:*:*)
+ echo ${UNAME_MACHINE}-unknown-amigaos
+ exit ;;
+ *:[Mm]orph[Oo][Ss]:*:*)
+ echo ${UNAME_MACHINE}-unknown-morphos
+ exit ;;
+ *:OS/390:*:*)
+ echo i370-ibm-openedition
+ exit ;;
+ *:z/VM:*:*)
+ echo s390-ibm-zvmoe
+ exit ;;
+ *:OS400:*:*)
+ echo powerpc-ibm-os400
+ exit ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ echo arm-acorn-riscix${UNAME_RELEASE}
+ exit ;;
+ arm:riscos:*:*|arm:RISCOS:*:*)
+ echo arm-unknown-riscos
+ exit ;;
+ SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
+ echo hppa1.1-hitachi-hiuxmpp
+ exit ;;
+ Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
+ # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
+ if test "`(/bin/universe) 2>/dev/null`" = att ; then
+ echo pyramid-pyramid-sysv3
+ else
+ echo pyramid-pyramid-bsd
+ fi
+ exit ;;
+ NILE*:*:*:dcosx)
+ echo pyramid-pyramid-svr4
+ exit ;;
+ DRS?6000:unix:4.0:6*)
+ echo sparc-icl-nx6
+ exit ;;
+ DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
+ case `/usr/bin/uname -p` in
+ sparc) echo sparc-icl-nx7; exit ;;
+ esac ;;
+ sun4H:SunOS:5.*:*)
+ echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit ;;
+ sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
+ echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit ;;
+ i86pc:SunOS:5.*:*)
+ echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit ;;
+ sun4*:SunOS:*:*)
+ case "`/usr/bin/arch -k`" in
+ Series*|S4*)
+ UNAME_RELEASE=`uname -v`
+ ;;
+ esac
+ # Japanese Language versions have a version number like `4.1.3-JL'.
+ echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+ exit ;;
+ sun3*:SunOS:*:*)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ exit ;;
+ sun*:*:4.2BSD:*)
+ UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
+ test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
+ case "`/bin/arch`" in
+ sun3)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ ;;
+ sun4)
+ echo sparc-sun-sunos${UNAME_RELEASE}
+ ;;
+ esac
+ exit ;;
+ aushp:SunOS:*:*)
+ echo sparc-auspex-sunos${UNAME_RELEASE}
+ exit ;;
+ # The situation for MiNT is a little confusing. The machine name
+ # can be virtually everything (everything which is not
+ # "atarist" or "atariste" at least should have a processor
+ # > m68000). The system name ranges from "MiNT" over "FreeMiNT"
+ # to the lowercase version "mint" (or "freemint"). Finally
+ # the system name "TOS" denotes a system which is actually not
+ # MiNT. But MiNT is downward compatible to TOS, so this should
+ # be no problem.
+ atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit ;;
+ atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit ;;
+ *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
+ echo m68k-atari-mint${UNAME_RELEASE}
+ exit ;;
+ milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
+ echo m68k-milan-mint${UNAME_RELEASE}
+ exit ;;
+ hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
+ echo m68k-hades-mint${UNAME_RELEASE}
+ exit ;;
+ *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
+ echo m68k-unknown-mint${UNAME_RELEASE}
+ exit ;;
+ m68k:machten:*:*)
+ echo m68k-apple-machten${UNAME_RELEASE}
+ exit ;;
+ powerpc:machten:*:*)
+ echo powerpc-apple-machten${UNAME_RELEASE}
+ exit ;;
+ RISC*:Mach:*:*)
+ echo mips-dec-mach_bsd4.3
+ exit ;;
+ RISC*:ULTRIX:*:*)
+ echo mips-dec-ultrix${UNAME_RELEASE}
+ exit ;;
+ VAX*:ULTRIX*:*:*)
+ echo vax-dec-ultrix${UNAME_RELEASE}
+ exit ;;
+ 2020:CLIX:*:* | 2430:CLIX:*:*)
+ echo clipper-intergraph-clix${UNAME_RELEASE}
+ exit ;;
+ mips:*:*:UMIPS | mips:*:*:RISCos)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+#ifdef __cplusplus
+#include <stdio.h> /* for printf() prototype */
+ int main (int argc, char *argv[]) {
+#else
+ int main (argc, argv) int argc; char *argv[]; {
+#endif
+ #if defined (host_mips) && defined (MIPSEB)
+ #if defined (SYSTYPE_SYSV)
+ printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_SVR4)
+ printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+ #endif
+ #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
+ printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+ #endif
+ #endif
+ exit (-1);
+ }
+EOF
+ $CC_FOR_BUILD -o $dummy $dummy.c &&
+ dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
+ SYSTEM_NAME=`$dummy $dummyarg` &&
+ { echo "$SYSTEM_NAME"; exit; }
+ echo mips-mips-riscos${UNAME_RELEASE}
+ exit ;;
+ Motorola:PowerMAX_OS:*:*)
+ echo powerpc-motorola-powermax
+ exit ;;
+ Motorola:*:4.3:PL8-*)
+ echo powerpc-harris-powermax
+ exit ;;
+ Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
+ echo powerpc-harris-powermax
+ exit ;;
+ Night_Hawk:Power_UNIX:*:*)
+ echo powerpc-harris-powerunix
+ exit ;;
+ m88k:CX/UX:7*:*)
+ echo m88k-harris-cxux7
+ exit ;;
+ m88k:*:4*:R4*)
+ echo m88k-motorola-sysv4
+ exit ;;
+ m88k:*:3*:R3*)
+ echo m88k-motorola-sysv3
+ exit ;;
+ AViiON:dgux:*:*)
+ # DG/UX returns AViiON for all architectures
+ UNAME_PROCESSOR=`/usr/bin/uname -p`
+ if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
+ then
+ if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
+ [ ${TARGET_BINARY_INTERFACE}x = x ]
+ then
+ echo m88k-dg-dgux${UNAME_RELEASE}
+ else
+ echo m88k-dg-dguxbcs${UNAME_RELEASE}
+ fi
+ else
+ echo i586-dg-dgux${UNAME_RELEASE}
+ fi
+ exit ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ echo m88k-dolphin-sysv3
+ exit ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ echo m88k-motorola-sysv3
+ exit ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ echo m88k-tektronix-sysv3
+ exit ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ echo m68k-tektronix-bsd
+ exit ;;
+ *:IRIX*:*:*)
+ echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
+ exit ;;
+ ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
+ echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
+ exit ;; # Note that: echo "'`uname -s`'" gives 'AIX '
+ i*86:AIX:*:*)
+ echo i386-ibm-aix
+ exit ;;
+ ia64:AIX:*:*)
+ if [ -x /usr/bin/oslevel ] ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+ fi
+ echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
+ exit ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #include <sys/systemcfg.h>
+
+ main()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
+ then
+ echo "$SYSTEM_NAME"
+ else
+ echo rs6000-ibm-aix3.2.5
+ fi
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ echo rs6000-ibm-aix3.2.4
+ else
+ echo rs6000-ibm-aix3.2
+ fi
+ exit ;;
+ *:AIX:*:[45])
+ IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
+ if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if [ -x /usr/bin/oslevel ] ; then
+ IBM_REV=`/usr/bin/oslevel`
+ else
+ IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
+ fi
+ echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+ exit ;;
+ *:AIX:*:*)
+ echo rs6000-ibm-aix
+ exit ;;
+ ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+ echo romp-ibm-bsd4.4
+ exit ;;
+ ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
+ echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
+ exit ;; # report: romp-ibm BSD 4.3
+ *:BOSX:*:*)
+ echo rs6000-bull-bosx
+ exit ;;
+ DPX/2?00:B.O.S.:*:*)
+ echo m68k-bull-sysv3
+ exit ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ echo m68k-hp-bsd
+ exit ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ echo m68k-hp-bsd4.4
+ exit ;;
+ 9000/[34678]??:HP-UX:*:*)
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ case "${UNAME_MACHINE}" in
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+ 9000/[678][0-9][0-9])
+ if [ -x /usr/bin/getconf ]; then
+ sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
+ sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
+ case "${sc_cpu_version}" in
+ 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
+ 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
+ 532) # CPU_PA_RISC2_0
+ case "${sc_kernel_bits}" in
+ 32) HP_ARCH="hppa2.0n" ;;
+ 64) HP_ARCH="hppa2.0w" ;;
+ '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20
+ esac ;;
+ esac
+ fi
+ if [ "${HP_ARCH}" = "" ]; then
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+
+ #define _HPUX_SOURCE
+ #include <stdlib.h>
+ #include <unistd.h>
+
+ int main ()
+ {
+ #if defined(_SC_KERNEL_BITS)
+ long bits = sysconf(_SC_KERNEL_BITS);
+ #endif
+ long cpu = sysconf (_SC_CPU_VERSION);
+
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
+ case CPU_PA_RISC2_0:
+ #if defined(_SC_KERNEL_BITS)
+ switch (bits)
+ {
+ case 64: puts ("hppa2.0w"); break;
+ case 32: puts ("hppa2.0n"); break;
+ default: puts ("hppa2.0"); break;
+ } break;
+ #else /* !defined(_SC_KERNEL_BITS) */
+ puts ("hppa2.0"); break;
+ #endif
+ default: puts ("hppa1.0"); break;
+ }
+ exit (0);
+ }
+EOF
+ (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
+ test -z "$HP_ARCH" && HP_ARCH=hppa
+ fi ;;
+ esac
+ if [ ${HP_ARCH} = "hppa2.0w" ]
+ then
+ eval $set_cc_for_build
+
+ # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
+ # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
+ # generating 64-bit code. GNU and HP use different nomenclature:
+ #
+ # $ CC_FOR_BUILD=cc ./config.guess
+ # => hppa2.0w-hp-hpux11.23
+ # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
+ # => hppa64-hp-hpux11.23
+
+ if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
+ grep __LP64__ >/dev/null
+ then
+ HP_ARCH="hppa2.0w"
+ else
+ HP_ARCH="hppa64"
+ fi
+ fi
+ echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+ exit ;;
+ ia64:HP-UX:*:*)
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ echo ia64-hp-hpux${HPUX_REV}
+ exit ;;
+ 3050*:HI-UX:*:*)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #include <unistd.h>
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
+ { echo "$SYSTEM_NAME"; exit; }
+ echo unknown-hitachi-hiuxwe2
+ exit ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+ echo hppa1.1-hp-bsd
+ exit ;;
+ 9000/8??:4.3bsd:*:*)
+ echo hppa1.0-hp-bsd
+ exit ;;
+ *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
+ echo hppa1.0-hp-mpeix
+ exit ;;
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+ echo hppa1.1-hp-osf
+ exit ;;
+ hp8??:OSF1:*:*)
+ echo hppa1.0-hp-osf
+ exit ;;
+ i*86:OSF1:*:*)
+ if [ -x /usr/sbin/sysversion ] ; then
+ echo ${UNAME_MACHINE}-unknown-osf1mk
+ else
+ echo ${UNAME_MACHINE}-unknown-osf1
+ fi
+ exit ;;
+ parisc*:Lites*:*:*)
+ echo hppa1.1-hp-lites
+ exit ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ echo c1-convex-bsd
+ exit ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ echo c34-convex-bsd
+ exit ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ echo c38-convex-bsd
+ exit ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ echo c4-convex-bsd
+ exit ;;
+ CRAY*Y-MP:*:*:*)
+ echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit ;;
+ CRAY*[A-Z]90:*:*:*)
+ echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
+ | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
+ -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
+ -e 's/\.[^.]*$/.X/'
+ exit ;;
+ CRAY*TS:*:*:*)
+ echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit ;;
+ CRAY*T3E:*:*:*)
+ echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit ;;
+ CRAY*SV1:*:*:*)
+ echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit ;;
+ *:UNICOS/mp:*:*)
+ echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
+ exit ;;
+ F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
+ FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
+ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
+ echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ exit ;;
+ 5000:UNIX_System_V:4.*:*)
+ FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
+ FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
+ echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
+ exit ;;
+ i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
+ echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
+ exit ;;
+ sparc*:BSD/OS:*:*)
+ echo sparc-unknown-bsdi${UNAME_RELEASE}
+ exit ;;
+ *:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit ;;
+ *:FreeBSD:*:*)
+ case ${UNAME_MACHINE} in
+ pc98)
+ echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+ amd64)
+ echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+ *)
+ echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
+ esac
+ exit ;;
+ i*:CYGWIN*:*)
+ echo ${UNAME_MACHINE}-pc-cygwin
+ exit ;;
+ i*:MINGW*:*)
+ echo ${UNAME_MACHINE}-pc-mingw32
+ exit ;;
+ i*:windows32*:*)
+ # uname -m includes "-pc" on this system.
+ echo ${UNAME_MACHINE}-mingw32
+ exit ;;
+ i*:PW*:*)
+ echo ${UNAME_MACHINE}-pc-pw32
+ exit ;;
+ x86:Interix*:[345]*)
+ echo i586-pc-interix${UNAME_RELEASE}
+ exit ;;
+ EM64T:Interix*:[345]*)
+ echo x86_64-unknown-interix${UNAME_RELEASE}
+ exit ;;
+ [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
+ echo i${UNAME_MACHINE}-pc-mks
+ exit ;;
+ i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
+ # How do we know it's Interix rather than the generic POSIX subsystem?
+ # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
+ # UNAME_MACHINE based on the output of uname instead of i386?
+ echo i586-pc-interix
+ exit ;;
+ i*:UWIN*:*)
+ echo ${UNAME_MACHINE}-pc-uwin
+ exit ;;
+ amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
+ echo x86_64-unknown-cygwin
+ exit ;;
+ p*:CYGWIN*:*)
+ echo powerpcle-unknown-cygwin
+ exit ;;
+ prep*:SunOS:5.*:*)
+ echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit ;;
+ *:GNU:*:*)
+ # the GNU system
+ echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit ;;
+ *:GNU/*:*:*)
+ # other systems with GNU libc and userland
+ echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu
+ exit ;;
+ i*86:Minix:*:*)
+ echo ${UNAME_MACHINE}-pc-minix
+ exit ;;
+ arm*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ cris:Linux:*:*)
+ echo cris-axis-linux-gnu
+ exit ;;
+ crisv32:Linux:*:*)
+ echo crisv32-axis-linux-gnu
+ exit ;;
+ frv:Linux:*:*)
+ echo frv-unknown-linux-gnu
+ exit ;;
+ ia64:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ m32r*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ m68*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ mips:Linux:*:*)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #undef CPU
+ #undef mips
+ #undef mipsel
+ #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+ CPU=mipsel
+ #else
+ #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+ CPU=mips
+ #else
+ CPU=
+ #endif
+ #endif
+EOF
+ eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
+ /^CPU/{
+ s: ::g
+ p
+ }'`"
+ test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
+ ;;
+ mips64:Linux:*:*)
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #undef CPU
+ #undef mips64
+ #undef mips64el
+ #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
+ CPU=mips64el
+ #else
+ #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
+ CPU=mips64
+ #else
+ CPU=
+ #endif
+ #endif
+EOF
+ eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
+ /^CPU/{
+ s: ::g
+ p
+ }'`"
+ test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
+ ;;
+ or32:Linux:*:*)
+ echo or32-unknown-linux-gnu
+ exit ;;
+ ppc:Linux:*:*)
+ echo powerpc-unknown-linux-gnu
+ exit ;;
+ ppc64:Linux:*:*)
+ echo powerpc64-unknown-linux-gnu
+ exit ;;
+ alpha:Linux:*:*)
+ case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
+ EV5) UNAME_MACHINE=alphaev5 ;;
+ EV56) UNAME_MACHINE=alphaev56 ;;
+ PCA56) UNAME_MACHINE=alphapca56 ;;
+ PCA57) UNAME_MACHINE=alphapca56 ;;
+ EV6) UNAME_MACHINE=alphaev6 ;;
+ EV67) UNAME_MACHINE=alphaev67 ;;
+ EV68*) UNAME_MACHINE=alphaev68 ;;
+ esac
+ objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null
+ if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
+ echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
+ exit ;;
+ parisc:Linux:*:* | hppa:Linux:*:*)
+ # Look for CPU level
+ case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
+ PA7*) echo hppa1.1-unknown-linux-gnu ;;
+ PA8*) echo hppa2.0-unknown-linux-gnu ;;
+ *) echo hppa-unknown-linux-gnu ;;
+ esac
+ exit ;;
+ parisc64:Linux:*:* | hppa64:Linux:*:*)
+ echo hppa64-unknown-linux-gnu
+ exit ;;
+ s390:Linux:*:* | s390x:Linux:*:*)
+ echo ${UNAME_MACHINE}-ibm-linux
+ exit ;;
+ sh64*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ sh*:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ sparc:Linux:*:* | sparc64:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux-gnu
+ exit ;;
+ vax:Linux:*:*)
+ echo ${UNAME_MACHINE}-dec-linux-gnu
+ exit ;;
+ x86_64:Linux:*:*)
+ echo x86_64-unknown-linux-gnu
+ exit ;;
+ i*86:Linux:*:*)
+ # The BFD linker knows what the default object file format is, so
+ # first see if it will tell us. cd to the root directory to prevent
+ # problems with other programs or directories called `ld' in the path.
+ # Set LC_ALL=C to ensure ld outputs messages in English.
+ ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \
+ | sed -ne '/supported targets:/!d
+ s/[ ][ ]*/ /g
+ s/.*supported targets: *//
+ s/ .*//
+ p'`
+ case "$ld_supported_targets" in
+ elf32-i386)
+ TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
+ ;;
+ a.out-i386-linux)
+ echo "${UNAME_MACHINE}-pc-linux-gnuaout"
+ exit ;;
+ coff-i386)
+ echo "${UNAME_MACHINE}-pc-linux-gnucoff"
+ exit ;;
+ "")
+ # Either a pre-BFD a.out linker (linux-gnuoldld) or
+ # one that does not give us useful --help.
+ echo "${UNAME_MACHINE}-pc-linux-gnuoldld"
+ exit ;;
+ esac
+ # Determine whether the default compiler is a.out or elf
+ eval $set_cc_for_build
+ sed 's/^ //' << EOF >$dummy.c
+ #include <features.h>
+ #ifdef __ELF__
+ # ifdef __GLIBC__
+ # if __GLIBC__ >= 2
+ LIBC=gnu
+ # else
+ LIBC=gnulibc1
+ # endif
+ # else
+ LIBC=gnulibc1
+ # endif
+ #else
+ #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC)
+ LIBC=gnu
+ #else
+ LIBC=gnuaout
+ #endif
+ #endif
+ #ifdef __dietlibc__
+ LIBC=dietlibc
+ #endif
+EOF
+ eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
+ /^LIBC/{
+ s: ::g
+ p
+ }'`"
+ test x"${LIBC}" != x && {
+ echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
+ exit
+ }
+ test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }
+ ;;
+ i*86:DYNIX/ptx:4*:*)
+ # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
+ # earlier versions are messed up and put the nodename in both
+ # sysname and nodename.
+ echo i386-sequent-sysv4
+ exit ;;
+ i*86:UNIX_SV:4.2MP:2.*)
+ # Unixware is an offshoot of SVR4, but it has its own version
+ # number series starting with 2...
+ # I am not positive that other SVR4 systems won't match this,
+ # I just have to hope. -- rms.
+ # Use sysv4.2uw... so that sysv4* matches it.
+ echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
+ exit ;;
+ i*86:OS/2:*:*)
+ # If we were able to find `uname', then EMX Unix compatibility
+ # is probably installed.
+ echo ${UNAME_MACHINE}-pc-os2-emx
+ exit ;;
+ i*86:XTS-300:*:STOP)
+ echo ${UNAME_MACHINE}-unknown-stop
+ exit ;;
+ i*86:atheos:*:*)
+ echo ${UNAME_MACHINE}-unknown-atheos
+ exit ;;
+ i*86:syllable:*:*)
+ echo ${UNAME_MACHINE}-pc-syllable
+ exit ;;
+ i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)
+ echo i386-unknown-lynxos${UNAME_RELEASE}
+ exit ;;
+ i*86:*DOS:*:*)
+ echo ${UNAME_MACHINE}-pc-msdosdjgpp
+ exit ;;
+ i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
+ UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
+ else
+ echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
+ fi
+ exit ;;
+ i*86:*:5:[678]*)
+ # UnixWare 7.x, OpenUNIX and OpenServer 6.
+ case `/bin/uname -X | grep "^Machine"` in
+ *486*) UNAME_MACHINE=i486 ;;
+ *Pentium) UNAME_MACHINE=i586 ;;
+ *Pent*|*Celeron) UNAME_MACHINE=i686 ;;
+ esac
+ echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
+ exit ;;
+ i*86:*:3.2:*)
+ if test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+ echo ${UNAME_MACHINE}-pc-isc$UNAME_REL
+ elif /bin/uname -X 2>/dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
+ (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
+ && UNAME_MACHINE=i586
+ (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
+ && UNAME_MACHINE=i686
+ (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
+ && UNAME_MACHINE=i686
+ echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
+ else
+ echo ${UNAME_MACHINE}-pc-sysv32
+ fi
+ exit ;;
+ pc:*:*:*)
+ # Left here for compatibility:
+ # uname -m prints for DJGPP always 'pc', but it prints nothing about
+ # the processor, so we play safe by assuming i386.
+ echo i386-pc-msdosdjgpp
+ exit ;;
+ Intel:Mach:3*:*)
+ echo i386-pc-mach3
+ exit ;;
+ paragon:*:*:*)
+ echo i860-intel-osf1
+ exit ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
+ fi
+ exit ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ echo m68010-convergent-sysv
+ exit ;;
+ mc68k:UNIX:SYSTEM5:3.51m)
+ echo m68k-convergent-sysv
+ exit ;;
+ M680?0:D-NIX:5.3:*)
+ echo m68k-diab-dnix
+ exit ;;
+ M68*:*:R3V[5678]*:*)
+ test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
+ 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
+ OS_REL=''
+ test -r /etc/.relid \
+ && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4.3${OS_REL}; exit; }
+ /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
+ && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
+ && { echo i486-ncr-sysv4; exit; } ;;
+ m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
+ echo m68k-unknown-lynxos${UNAME_RELEASE}
+ exit ;;
+ mc68030:UNIX_System_V:4.*:*)
+ echo m68k-atari-sysv4
+ exit ;;
+ TSUNAMI:LynxOS:2.*:*)
+ echo sparc-unknown-lynxos${UNAME_RELEASE}
+ exit ;;
+ rs6000:LynxOS:2.*:*)
+ echo rs6000-unknown-lynxos${UNAME_RELEASE}
+ exit ;;
+ PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)
+ echo powerpc-unknown-lynxos${UNAME_RELEASE}
+ exit ;;
+ SM[BE]S:UNIX_SV:*:*)
+ echo mips-dde-sysv${UNAME_RELEASE}
+ exit ;;
+ RM*:ReliantUNIX-*:*:*)
+ echo mips-sni-sysv4
+ exit ;;
+ RM*:SINIX-*:*:*)
+ echo mips-sni-sysv4
+ exit ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ echo ${UNAME_MACHINE}-sni-sysv4
+ else
+ echo ns32k-sni-sysv
+ fi
+ exit ;;
+ PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ # says <Richard.M.Bartel@ccMail.Census.GOV>
+ echo i586-unisys-sysv4
+ exit ;;
+ *:UNIX_System_V:4*:FTX*)
+ # From Gerald Hewes <hewes@openmarket.com>.
+ # How about differentiating between stratus architectures? -djm
+ echo hppa1.1-stratus-sysv4
+ exit ;;
+ *:*:*:FTX*)
+ # From seanf@swdc.stratus.com.
+ echo i860-stratus-sysv4
+ exit ;;
+ i*86:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ echo ${UNAME_MACHINE}-stratus-vos
+ exit ;;
+ *:VOS:*:*)
+ # From Paul.Green@stratus.com.
+ echo hppa1.1-stratus-vos
+ exit ;;
+ mc68*:A/UX:*:*)
+ echo m68k-apple-aux${UNAME_RELEASE}
+ exit ;;
+ news*:NEWS-OS:6*:*)
+ echo mips-sony-newsos6
+ exit ;;
+ R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
+ if [ -d /usr/nec ]; then
+ echo mips-nec-sysv${UNAME_RELEASE}
+ else
+ echo mips-unknown-sysv${UNAME_RELEASE}
+ fi
+ exit ;;
+ BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
+ echo powerpc-be-beos
+ exit ;;
+ BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
+ echo powerpc-apple-beos
+ exit ;;
+ BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
+ echo i586-pc-beos
+ exit ;;
+ SX-4:SUPER-UX:*:*)
+ echo sx4-nec-superux${UNAME_RELEASE}
+ exit ;;
+ SX-5:SUPER-UX:*:*)
+ echo sx5-nec-superux${UNAME_RELEASE}
+ exit ;;
+ SX-6:SUPER-UX:*:*)
+ echo sx6-nec-superux${UNAME_RELEASE}
+ exit ;;
+ Power*:Rhapsody:*:*)
+ echo powerpc-apple-rhapsody${UNAME_RELEASE}
+ exit ;;
+ *:Rhapsody:*:*)
+ echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
+ exit ;;
+ *:Darwin:*:*)
+ UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
+ case $UNAME_PROCESSOR in
+ unknown) UNAME_PROCESSOR=powerpc ;;
+ esac
+ echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
+ exit ;;
+ *:procnto*:*:* | *:QNX:[0123456789]*:*)
+ UNAME_PROCESSOR=`uname -p`
+ if test "$UNAME_PROCESSOR" = "x86"; then
+ UNAME_PROCESSOR=i386
+ UNAME_MACHINE=pc
+ fi
+ echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
+ exit ;;
+ *:QNX:*:4*)
+ echo i386-pc-qnx
+ exit ;;
+ NSE-?:NONSTOP_KERNEL:*:*)
+ echo nse-tandem-nsk${UNAME_RELEASE}
+ exit ;;
+ NSR-?:NONSTOP_KERNEL:*:*)
+ echo nsr-tandem-nsk${UNAME_RELEASE}
+ exit ;;
+ *:NonStop-UX:*:*)
+ echo mips-compaq-nonstopux
+ exit ;;
+ BS2000:POSIX*:*:*)
+ echo bs2000-siemens-sysv
+ exit ;;
+ DS/*:UNIX_System_V:*:*)
+ echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
+ exit ;;
+ *:Plan9:*:*)
+ # "uname -m" is not consistent, so use $cputype instead. 386
+ # is converted to i386 for consistency with other x86
+ # operating systems.
+ if test "$cputype" = "386"; then
+ UNAME_MACHINE=i386
+ else
+ UNAME_MACHINE="$cputype"
+ fi
+ echo ${UNAME_MACHINE}-unknown-plan9
+ exit ;;
+ *:TOPS-10:*:*)
+ echo pdp10-unknown-tops10
+ exit ;;
+ *:TENEX:*:*)
+ echo pdp10-unknown-tenex
+ exit ;;
+ KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
+ echo pdp10-dec-tops20
+ exit ;;
+ XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
+ echo pdp10-xkl-tops20
+ exit ;;
+ *:TOPS-20:*:*)
+ echo pdp10-unknown-tops20
+ exit ;;
+ *:ITS:*:*)
+ echo pdp10-unknown-its
+ exit ;;
+ SEI:*:*:SEIUX)
+ echo mips-sei-seiux${UNAME_RELEASE}
+ exit ;;
+ *:DragonFly:*:*)
+ echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+ exit ;;
+ *:*VMS:*:*)
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ case "${UNAME_MACHINE}" in
+ A*) echo alpha-dec-vms ; exit ;;
+ I*) echo ia64-dec-vms ; exit ;;
+ V*) echo vax-dec-vms ; exit ;;
+ esac ;;
+ *:XENIX:*:SysV)
+ echo i386-pc-xenix
+ exit ;;
+ i*86:skyos:*:*)
+ echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
+ exit ;;
+ i*86:rdos:*:*)
+ echo ${UNAME_MACHINE}-pc-rdos
+ exit ;;
+esac
+
+#echo '(No uname command or uname output not recognized.)' 1>&2
+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+
+eval $set_cc_for_build
+cat >$dummy.c <<EOF
+#ifdef _SEQUENT_
+# include <sys/types.h>
+# include <sys/utsname.h>
+#endif
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+#include <sys/param.h>
+ printf ("m68k-sony-newsos%s\n",
+#ifdef NEWSOS4
+ "4"
+#else
+ ""
+#endif
+ ); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+ printf ("arm-acorn-riscix\n"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+ printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ if (version < 4)
+ printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
+ else
+ printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-pc-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ struct utsname un;
+
+ uname(&un);
+
+ if (strncmp(un.version, "V2", 2) == 0) {
+ printf ("i386-sequent-ptx2\n"); exit (0);
+ }
+ if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
+ printf ("i386-sequent-ptx1\n"); exit (0);
+ }
+ printf ("i386-sequent-ptx\n"); exit (0);
+
+#endif
+
+#if defined (vax)
+# if !defined (ultrix)
+# include <sys/param.h>
+# if defined (BSD)
+# if BSD == 43
+ printf ("vax-dec-bsd4.3\n"); exit (0);
+# else
+# if BSD == 199006
+ printf ("vax-dec-bsd4.3reno\n"); exit (0);
+# else
+ printf ("vax-dec-bsd\n"); exit (0);
+# endif
+# endif
+# else
+ printf ("vax-dec-bsd\n"); exit (0);
+# endif
+# else
+ printf ("vax-dec-ultrix\n"); exit (0);
+# endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
+ { echo "$SYSTEM_NAME"; exit; }
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+ case `getsysinfo -f cpu_type` in
+ c1*)
+ echo c1-convex-bsd
+ exit ;;
+ c2*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit ;;
+ c34*)
+ echo c34-convex-bsd
+ exit ;;
+ c38*)
+ echo c38-convex-bsd
+ exit ;;
+ c4*)
+ echo c4-convex-bsd
+ exit ;;
+ esac
+fi
+
+cat >&2 <<EOF
+$0: unable to guess system type
+
+This script, last modified $timestamp, has failed to recognize
+the operating system you are using. It is advised that you
+download the most up to date version of the config scripts from
+
+ http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess
+and
+ http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub
+
+If the version you run ($0) is already up to date, please
+send the following data and any information you think might be
+pertinent to <config-patches@gnu.org> in order to provide the needed
+information to handle your system.
+
+config.guess timestamp = $timestamp
+
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
+
+hostinfo = `(hostinfo) 2>/dev/null`
+/bin/universe = `(/bin/universe) 2>/dev/null`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
+/bin/arch = `(/bin/arch) 2>/dev/null`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
+
+UNAME_MACHINE = ${UNAME_MACHINE}
+UNAME_RELEASE = ${UNAME_RELEASE}
+UNAME_SYSTEM = ${UNAME_SYSTEM}
+UNAME_VERSION = ${UNAME_VERSION}
+EOF
+
+exit 1
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/cil/config.h.in b/cil/config.h.in
new file mode 100644
index 0000000..57dc9f0
--- /dev/null
+++ b/cil/config.h.in
@@ -0,0 +1,23 @@
+#undef HAVE_WCHAR_T
+
+#undef HAVE_STDLIB_H
+
+#undef HAVE_STRINGS_H
+
+#undef HAVE_SYS_TIME_H
+
+#undef HAVE_UNISTD_H
+
+#undef HAVE_CONST
+
+#undef HAVE_INLINE
+
+#undef HAVE_TIME_H
+
+#undef HAVE_MEMCP
+
+#undef HAVE_MKDIR
+
+#undef HAVE_SELECT
+
+#undef HAVE_SOCKET
diff --git a/cil/config.sub b/cil/config.sub
new file mode 100755
index 0000000..f0675aa
--- /dev/null
+++ b/cil/config.sub
@@ -0,0 +1,1469 @@
+#! /bin/sh
+# Configuration validation subroutine script.
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+# 2000, 2001, 2002 Free Software Foundation, Inc.
+
+timestamp='2002-11-30'
+
+# This file is (in principle) common to ALL GNU software.
+# The presence of a machine in this file suggests that SOME GNU software
+# can handle that machine. It does not imply ALL GNU software can.
+#
+# This file is free software; you can redistribute it and/or modify
+# it 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 program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Please send patches to <config-patches@gnu.org>. Submit a context
+# diff and a properly formatted ChangeLog entry.
+#
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# or in some cases, the newer four-part form:
+# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+me=`echo "$0" | sed -e 's,.*/,,'`
+
+usage="\
+Usage: $0 [OPTION] CPU-MFR-OPSYS
+ $0 [OPTION] ALIAS
+
+Canonicalize a configuration name.
+
+Operation modes:
+ -h, --help print this help, then exit
+ -t, --time-stamp print date of last modification, then exit
+ -v, --version print version number, then exit
+
+Report bugs and patches to <config-patches@gnu.org>."
+
+version="\
+GNU config.sub ($timestamp)
+
+Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+Free Software Foundation, Inc.
+
+This is free software; see the source for copying conditions. There is NO
+warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
+
+help="
+Try \`$me --help' for more information."
+
+# Parse command line
+while test $# -gt 0 ; do
+ case $1 in
+ --time-stamp | --time* | -t )
+ echo "$timestamp" ; exit 0 ;;
+ --version | -v )
+ echo "$version" ; exit 0 ;;
+ --help | --h* | -h )
+ echo "$usage"; exit 0 ;;
+ -- ) # Stop option processing
+ shift; break ;;
+ - ) # Use stdin as input.
+ break ;;
+ -* )
+ echo "$me: invalid option $1$help"
+ exit 1 ;;
+
+ *local*)
+ # First pass through any local machine types.
+ echo $1
+ exit 0;;
+
+ * )
+ break ;;
+ esac
+done
+
+case $# in
+ 0) echo "$me: missing argument$help" >&2
+ exit 1;;
+ 1) ;;
+ *) echo "$me: too many arguments$help" >&2
+ exit 1;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
+# Here we must recognize all the valid KERNEL-OS combinations.
+maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
+case $maybe_os in
+ nto-qnx* | linux-gnu* | freebsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*)
+ os=-$maybe_os
+ basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
+ ;;
+ *)
+ basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+ if [ $basic_machine != $1 ]
+ then os=`echo $1 | sed 's/.*-/-/'`
+ else os=; fi
+ ;;
+esac
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work. We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+ -sun*os*)
+ # Prevent following clause from handling this invalid input.
+ ;;
+ -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
+ -apple | -axis)
+ os=
+ basic_machine=$1
+ ;;
+ -sim | -cisco | -oki | -wec | -winbond)
+ os=
+ basic_machine=$1
+ ;;
+ -scout)
+ ;;
+ -wrs)
+ os=-vxworks
+ basic_machine=$1
+ ;;
+ -chorusos*)
+ os=-chorusos
+ basic_machine=$1
+ ;;
+ -chorusrdb)
+ os=-chorusrdb
+ basic_machine=$1
+ ;;
+ -hiux*)
+ os=-hiuxwe2
+ ;;
+ -sco5)
+ os=-sco3.2v5
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco4)
+ os=-sco3.2v4
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2.[4-9]*)
+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco3.2v[4-9]*)
+ # Don't forget version if it is 3.2v4 or newer.
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -sco*)
+ os=-sco3.2v2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -udk*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -isc)
+ os=-isc2.2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -clix*)
+ basic_machine=clipper-intergraph
+ ;;
+ -isc*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
+ ;;
+ -lynx*)
+ os=-lynxos
+ ;;
+ -ptx*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+ ;;
+ -windowsnt*)
+ os=`echo $os | sed -e 's/windowsnt/winnt/'`
+ ;;
+ -psos*)
+ os=-psos
+ ;;
+ -mint | -mint[0-9]*)
+ basic_machine=m68k-atari
+ os=-mint
+ ;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+ 1750a | 580 \
+ | a29k \
+ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
+ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
+ | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \
+ | clipper \
+ | d10v | d30v | dlx | dsp16xx \
+ | fr30 | frv \
+ | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
+ | i370 | i860 | i960 | ia64 \
+ | ip2k \
+ | m32r | m68000 | m68k | m88k | mcore \
+ | mips | mipsbe | mipseb | mipsel | mipsle \
+ | mips16 \
+ | mips64 | mips64el \
+ | mips64vr | mips64vrel \
+ | mips64orion | mips64orionel \
+ | mips64vr4100 | mips64vr4100el \
+ | mips64vr4300 | mips64vr4300el \
+ | mips64vr5000 | mips64vr5000el \
+ | mipsisa32 | mipsisa32el \
+ | mipsisa64 | mipsisa64el \
+ | mipsisa64sb1 | mipsisa64sb1el \
+ | mipsisa64sr71k | mipsisa64sr71kel \
+ | mipstx39 | mipstx39el \
+ | mn10200 | mn10300 \
+ | ns16k | ns32k \
+ | openrisc | or32 \
+ | pdp10 | pdp11 | pj | pjl \
+ | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
+ | pyramid \
+ | sh | sh[1234] | sh3e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \
+ | sh64 | sh64le \
+ | sparc | sparc64 | sparc86x | sparclet | sparclite | sparcv9 | sparcv9b \
+ | strongarm \
+ | tahoe | thumb | tic80 | tron \
+ | v850 | v850e \
+ | we32k \
+ | x86 | xscale | xstormy16 | xtensa \
+ | z8k)
+ basic_machine=$basic_machine-unknown
+ ;;
+ m6811 | m68hc11 | m6812 | m68hc12)
+ # Motorola 68HC11/12.
+ basic_machine=$basic_machine-unknown
+ os=-none
+ ;;
+ m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
+ ;;
+
+ # We use `pc' rather than `unknown'
+ # because (1) that's what they normally are, and
+ # (2) the word "unknown" tends to confuse beginning users.
+ i*86 | x86_64)
+ basic_machine=$basic_machine-pc
+ ;;
+ # Object if more than one company name word.
+ *-*-*)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+ # Recognize the basic CPU types with company name.
+ 580-* \
+ | a29k-* \
+ | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
+ | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
+ | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
+ | arm-* | armbe-* | armle-* | armeb-* | armv*-* \
+ | avr-* \
+ | bs2000-* \
+ | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* \
+ | clipper-* | cydra-* \
+ | d10v-* | d30v-* | dlx-* \
+ | elxsi-* \
+ | f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \
+ | h8300-* | h8500-* \
+ | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
+ | i*86-* | i860-* | i960-* | ia64-* \
+ | ip2k-* \
+ | m32r-* \
+ | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
+ | m88110-* | m88k-* | mcore-* \
+ | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
+ | mips16-* \
+ | mips64-* | mips64el-* \
+ | mips64vr-* | mips64vrel-* \
+ | mips64orion-* | mips64orionel-* \
+ | mips64vr4100-* | mips64vr4100el-* \
+ | mips64vr4300-* | mips64vr4300el-* \
+ | mips64vr5000-* | mips64vr5000el-* \
+ | mipsisa32-* | mipsisa32el-* \
+ | mipsisa64-* | mipsisa64el-* \
+ | mipsisa64sb1-* | mipsisa64sb1el-* \
+ | mipsisa64sr71k-* | mipsisa64sr71kel-* \
+ | mipstx39 | mipstx39el \
+ | none-* | np1-* | ns16k-* | ns32k-* \
+ | orion-* \
+ | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
+ | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
+ | pyramid-* \
+ | romp-* | rs6000-* \
+ | sh-* | sh[1234]-* | sh3e-* | sh[34]eb-* | shbe-* \
+ | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
+ | sparc-* | sparc64-* | sparc86x-* | sparclet-* | sparclite-* \
+ | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \
+ | tahoe-* | thumb-* | tic30-* | tic4x-* | tic54x-* | tic80-* | tron-* \
+ | v850-* | v850e-* | vax-* \
+ | we32k-* \
+ | x86-* | x86_64-* | xps100-* | xscale-* | xstormy16-* \
+ | xtensa-* \
+ | ymp-* \
+ | z8k-*)
+ ;;
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 386bsd)
+ basic_machine=i386-unknown
+ os=-bsd
+ ;;
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ basic_machine=m68000-att
+ ;;
+ 3b*)
+ basic_machine=we32k-att
+ ;;
+ a29khif)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ adobe68k)
+ basic_machine=m68010-adobe
+ os=-scout
+ ;;
+ alliant | fx80)
+ basic_machine=fx80-alliant
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ os=-bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ os=-sysv
+ ;;
+ amiga | amiga-*)
+ basic_machine=m68k-unknown
+ ;;
+ amigaos | amigados)
+ basic_machine=m68k-unknown
+ os=-amigaos
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-unknown
+ os=-sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ os=-sysv
+ ;;
+ apollo68bsd)
+ basic_machine=m68k-apollo
+ os=-bsd
+ ;;
+ aux)
+ basic_machine=m68k-apple
+ os=-aux
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ os=-dynix
+ ;;
+ c90)
+ basic_machine=c90-cray
+ os=-unicos
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ os=-bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ os=-bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ os=-bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ os=-bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ os=-bsd
+ ;;
+ cray | j90)
+ basic_machine=j90-cray
+ os=-unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ ;;
+ cris | cris-* | etrax*)
+ basic_machine=cris-axis
+ ;;
+ da30 | da30-*)
+ basic_machine=m68k-da30
+ ;;
+ decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ ;;
+ decsystem10* | dec10*)
+ basic_machine=pdp10-dec
+ os=-tops10
+ ;;
+ decsystem20* | dec20*)
+ basic_machine=pdp10-dec
+ os=-tops20
+ ;;
+ delta | 3300 | motorola-3300 | motorola-delta \
+ | 3300-motorola | delta-motorola)
+ basic_machine=m68k-motorola
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ os=-sysv3
+ ;;
+ dpx20 | dpx20-*)
+ basic_machine=rs6000-bull
+ os=-bosx
+ ;;
+ dpx2* | dpx2*-bull)
+ basic_machine=m68k-bull
+ os=-sysv3
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ os=-ebmon
+ ;;
+ elxsi)
+ basic_machine=elxsi-elxsi
+ os=-bsd
+ ;;
+ encore | umax | mmax)
+ basic_machine=ns32k-encore
+ ;;
+ es1800 | OSE68k | ose68k | ose | OSE)
+ basic_machine=m68k-ericsson
+ os=-ose
+ ;;
+ fx2800)
+ basic_machine=i860-alliant
+ ;;
+ genix)
+ basic_machine=ns32k-ns
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ os=-sysv
+ ;;
+ go32)
+ basic_machine=i386-pc
+ os=-go32
+ ;;
+ h3050r* | hiux*)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ os=-hms
+ ;;
+ h8300xray)
+ basic_machine=h8300-hitachi
+ os=-xray
+ ;;
+ h8500hms)
+ basic_machine=h8500-hitachi
+ os=-hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ os=-sysv3
+ ;;
+ hp300-*)
+ basic_machine=m68k-hp
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ os=-bsd
+ ;;
+ hp300hpux)
+ basic_machine=m68k-hp
+ os=-hpux
+ ;;
+ hp3k9[0-9][0-9] | hp9[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ basic_machine=m68000-hp
+ ;;
+ hp9k3[2-9][0-9])
+ basic_machine=m68k-hp
+ ;;
+ hp9k6[0-9][0-9] | hp6[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hp9k7[0-79][0-9] | hp7[0-79][0-9])
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k78[0-9] | hp78[0-9])
+ # FIXME: really hppa2.0-hp
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
+ # FIXME: really hppa2.0-hp
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][13679] | hp8[0-9][13679])
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ hppa-next)
+ os=-nextstep3
+ ;;
+ hppaosf)
+ basic_machine=hppa1.1-hp
+ os=-osf
+ ;;
+ hppro)
+ basic_machine=hppa1.1-hp
+ os=-proelf
+ ;;
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
+ ;;
+# I'm not sure what "Sysv32" means. Should this be sysv3.2?
+ i*86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv32
+ ;;
+ i*86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv4
+ ;;
+ i*86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-sysv
+ ;;
+ i*86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
+ os=-solaris2
+ ;;
+ i386mach)
+ basic_machine=i386-mach
+ os=-mach
+ ;;
+ i386-vsta | vsta)
+ basic_machine=i386-unknown
+ os=-vsta
+ ;;
+ iris | iris4d)
+ basic_machine=mips-sgi
+ case $os in
+ -irix*)
+ ;;
+ *)
+ os=-irix4
+ ;;
+ esac
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ os=-sysv
+ ;;
+ m88k-omron*)
+ basic_machine=m88k-omron
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ os=-sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ os=-sysv
+ ;;
+ mingw32)
+ basic_machine=i386-pc
+ os=-mingw32
+ ;;
+ miniframe)
+ basic_machine=m68000-convergent
+ ;;
+ *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
+ basic_machine=m68k-atari
+ os=-mint
+ ;;
+ mips3*-*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+ ;;
+ mips3*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+ ;;
+ mmix*)
+ basic_machine=mmix-knuth
+ os=-mmixware
+ ;;
+ monitor)
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ morphos)
+ basic_machine=powerpc-unknown
+ os=-morphos
+ ;;
+ msdos)
+ basic_machine=i386-pc
+ os=-msdos
+ ;;
+ mvs)
+ basic_machine=i370-ibm
+ os=-mvs
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ os=-sysv4
+ ;;
+ netbsd386)
+ basic_machine=i386-unknown
+ os=-netbsd
+ ;;
+ netwinder)
+ basic_machine=armv4l-rebel
+ os=-linux
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ os=-newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ os=-newsos
+ ;;
+ news-3600 | risc-news)
+ basic_machine=mips-sony
+ os=-newsos
+ ;;
+ necv70)
+ basic_machine=v70-nec
+ os=-sysv
+ ;;
+ next | m*-next )
+ basic_machine=m68k-next
+ case $os in
+ -nextstep* )
+ ;;
+ -ns2*)
+ os=-nextstep2
+ ;;
+ *)
+ os=-nextstep3
+ ;;
+ esac
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ os=-cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ os=-cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ os=-nindy
+ ;;
+ mon960)
+ basic_machine=i960-intel
+ os=-mon960
+ ;;
+ nonstopux)
+ basic_machine=mips-compaq
+ os=-nonstopux
+ ;;
+ np1)
+ basic_machine=np1-gould
+ ;;
+ nsr-tandem)
+ basic_machine=nsr-tandem
+ ;;
+ op50n-* | op60c-*)
+ basic_machine=hppa1.1-oki
+ os=-proelf
+ ;;
+ or32 | or32-*)
+ basic_machine=or32-unknown
+ os=-coff
+ ;;
+ OSE68000 | ose68000)
+ basic_machine=m68000-ericsson
+ os=-ose
+ ;;
+ os68k)
+ basic_machine=m68k-none
+ os=-os68k
+ ;;
+ pa-hitachi)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ os=-osf
+ ;;
+ pbd)
+ basic_machine=sparc-tti
+ ;;
+ pbb)
+ basic_machine=m68k-tti
+ ;;
+ pc532 | pc532-*)
+ basic_machine=ns32k-pc532
+ ;;
+ pentium | p5 | k5 | k6 | nexgen | viac3)
+ basic_machine=i586-pc
+ ;;
+ pentiumpro | p6 | 6x86 | athlon | athlon_*)
+ basic_machine=i686-pc
+ ;;
+ pentiumii | pentium2)
+ basic_machine=i686-pc
+ ;;
+ pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
+ basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumpro-* | p6-* | 6x86-* | athlon-*)
+ basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pentiumii-* | pentium2-*)
+ basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pn)
+ basic_machine=pn-gould
+ ;;
+ power) basic_machine=power-ibm
+ ;;
+ ppc) basic_machine=powerpc-unknown
+ ;;
+ ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppcle | powerpclittle | ppc-le | powerpc-little)
+ basic_machine=powerpcle-unknown
+ ;;
+ ppcle-* | powerpclittle-*)
+ basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppc64) basic_machine=powerpc64-unknown
+ ;;
+ ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ppc64le | powerpc64little | ppc64-le | powerpc64-little)
+ basic_machine=powerpc64le-unknown
+ ;;
+ ppc64le-* | powerpc64little-*)
+ basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ ps2)
+ basic_machine=i386-ibm
+ ;;
+ pw32)
+ basic_machine=i586-unknown
+ os=-pw32
+ ;;
+ rom68k)
+ basic_machine=m68k-rom68k
+ os=-coff
+ ;;
+ rm[46]00)
+ basic_machine=mips-siemens
+ ;;
+ rtpc | rtpc-*)
+ basic_machine=romp-ibm
+ ;;
+ s390 | s390-*)
+ basic_machine=s390-ibm
+ ;;
+ s390x | s390x-*)
+ basic_machine=s390x-ibm
+ ;;
+ sa29200)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ sb1)
+ basic_machine=mipsisa64sb1-unknown
+ ;;
+ sb1el)
+ basic_machine=mipsisa64sb1el-unknown
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ ;;
+ sh)
+ basic_machine=sh-hitachi
+ os=-hms
+ ;;
+ sparclite-wrs | simso-wrs)
+ basic_machine=sparclite-wrs
+ os=-vxworks
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ os=-sysv2
+ ;;
+ spur)
+ basic_machine=spur-unknown
+ ;;
+ st2000)
+ basic_machine=m68k-tandem
+ ;;
+ stratus)
+ basic_machine=i860-stratus
+ os=-sysv4
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ os=-sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ os=-sunos4
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ os=-sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ os=-sunos4
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ os=-sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ os=-sunos4
+ ;;
+ sun4sol2)
+ basic_machine=sparc-sun
+ os=-solaris2
+ ;;
+ sun3 | sun3-*)
+ basic_machine=m68k-sun
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ ;;
+ sv1)
+ basic_machine=sv1-cray
+ os=-unicos
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ os=-dynix
+ ;;
+ t3d)
+ basic_machine=alpha-cray
+ os=-unicos
+ ;;
+ t3e)
+ basic_machine=alphaev5-cray
+ os=-unicos
+ ;;
+ t90)
+ basic_machine=t90-cray
+ os=-unicos
+ ;;
+ tic4x | c4x*)
+ basic_machine=tic4x-unknown
+ os=-coff
+ ;;
+ tic54x | c54x*)
+ basic_machine=tic54x-unknown
+ os=-coff
+ ;;
+ tx39)
+ basic_machine=mipstx39-unknown
+ ;;
+ tx39el)
+ basic_machine=mipstx39el-unknown
+ ;;
+ toad1)
+ basic_machine=pdp10-xkl
+ os=-tops20
+ ;;
+ tower | tower-32)
+ basic_machine=m68k-ncr
+ ;;
+ udi29k)
+ basic_machine=a29k-amd
+ os=-udi
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ os=-sym1
+ ;;
+ v810 | necv810)
+ basic_machine=v810-nec
+ os=-none
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ os=-sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ os=-vms
+ ;;
+ vpp*|vx|vx-*)
+ basic_machine=f301-fujitsu
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ os=-vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ os=-vxworks
+ ;;
+ vxworks29k)
+ basic_machine=a29k-wrs
+ os=-vxworks
+ ;;
+ w65*)
+ basic_machine=w65-wdc
+ os=-none
+ ;;
+ w89k-*)
+ basic_machine=hppa1.1-winbond
+ os=-proelf
+ ;;
+ xps | xps100)
+ basic_machine=xps100-honeywell
+ ;;
+ ymp)
+ basic_machine=ymp-cray
+ os=-unicos
+ ;;
+ z8k-*-coff)
+ basic_machine=z8k-unknown
+ os=-sim
+ ;;
+ none)
+ basic_machine=none-none
+ os=-none
+ ;;
+
+# Here we handle the default manufacturer of certain CPU types. It is in
+# some cases the only manufacturer, in others, it is the most popular.
+ w89k)
+ basic_machine=hppa1.1-winbond
+ ;;
+ op50n)
+ basic_machine=hppa1.1-oki
+ ;;
+ op60c)
+ basic_machine=hppa1.1-oki
+ ;;
+ romp)
+ basic_machine=romp-ibm
+ ;;
+ rs6000)
+ basic_machine=rs6000-ibm
+ ;;
+ vax)
+ basic_machine=vax-dec
+ ;;
+ pdp10)
+ # there are many clones, so DEC is not a safe bet
+ basic_machine=pdp10-unknown
+ ;;
+ pdp11)
+ basic_machine=pdp11-dec
+ ;;
+ we32k)
+ basic_machine=we32k-att
+ ;;
+ sh3 | sh4 | sh3eb | sh4eb | sh[1234]le | sh3ele)
+ basic_machine=sh-unknown
+ ;;
+ sh64)
+ basic_machine=sh64-unknown
+ ;;
+ sparc | sparcv9 | sparcv9b)
+ basic_machine=sparc-sun
+ ;;
+ cydra)
+ basic_machine=cydra-cydrome
+ ;;
+ orion)
+ basic_machine=orion-highlevel
+ ;;
+ orion105)
+ basic_machine=clipper-highlevel
+ ;;
+ mac | mpw | mac-mpw)
+ basic_machine=m68k-apple
+ ;;
+ pmac | pmac-mpw)
+ basic_machine=powerpc-apple
+ ;;
+ *-unknown)
+ # Make sure to match an already-canonicalized machine name.
+ ;;
+ *)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+ *-digital*)
+ basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+ ;;
+ *-commodore*)
+ basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+ # First match some system type aliases
+ # that might get confused with valid system types.
+ # -solaris* is a basic system type, with this one exception.
+ -solaris1 | -solaris1.*)
+ os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ ;;
+ -solaris)
+ os=-solaris2
+ ;;
+ -svr4*)
+ os=-sysv4
+ ;;
+ -unixware*)
+ os=-sysv4.2uw
+ ;;
+ -gnu/linux*)
+ os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
+ ;;
+ # First accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative MUST END IN A *, to match a version number.
+ # -sysv* is not here because it comes later, after sysvr4.
+ -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+ | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
+ | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
+ | -aos* \
+ | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
+ | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
+ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
+ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
+ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
+ | -chorusos* | -chorusrdb* \
+ | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
+ | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
+ | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
+ | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
+ | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
+ | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
+ | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
+ | -powermax* | -dnix*)
+ # Remember, each alternative MUST END IN *, to match a version number.
+ ;;
+ -qnx*)
+ case $basic_machine in
+ x86-* | i*86-*)
+ ;;
+ *)
+ os=-nto$os
+ ;;
+ esac
+ ;;
+ -nto-qnx*)
+ ;;
+ -nto*)
+ os=`echo $os | sed -e 's|nto|nto-qnx|'`
+ ;;
+ -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
+ | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
+ | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
+ ;;
+ -mac*)
+ os=`echo $os | sed -e 's|mac|macos|'`
+ ;;
+ -linux*)
+ os=`echo $os | sed -e 's|linux|linux-gnu|'`
+ ;;
+ -sunos5*)
+ os=`echo $os | sed -e 's|sunos5|solaris2|'`
+ ;;
+ -sunos6*)
+ os=`echo $os | sed -e 's|sunos6|solaris3|'`
+ ;;
+ -opened*)
+ os=-openedition
+ ;;
+ -wince*)
+ os=-wince
+ ;;
+ -osfrose*)
+ os=-osfrose
+ ;;
+ -osf*)
+ os=-osf
+ ;;
+ -utek*)
+ os=-bsd
+ ;;
+ -dynix*)
+ os=-bsd
+ ;;
+ -acis*)
+ os=-aos
+ ;;
+ -atheos*)
+ os=-atheos
+ ;;
+ -386bsd)
+ os=-bsd
+ ;;
+ -ctix* | -uts*)
+ os=-sysv
+ ;;
+ -nova*)
+ os=-rtmk-nova
+ ;;
+ -ns2 )
+ os=-nextstep2
+ ;;
+ -nsk*)
+ os=-nsk
+ ;;
+ # Preserve the version number of sinix5.
+ -sinix5.*)
+ os=`echo $os | sed -e 's|sinix|sysv|'`
+ ;;
+ -sinix*)
+ os=-sysv4
+ ;;
+ -triton*)
+ os=-sysv3
+ ;;
+ -oss*)
+ os=-sysv3
+ ;;
+ -svr4)
+ os=-sysv4
+ ;;
+ -svr3)
+ os=-sysv3
+ ;;
+ -sysvr4)
+ os=-sysv4
+ ;;
+ # This must come after -sysvr4.
+ -sysv*)
+ ;;
+ -ose*)
+ os=-ose
+ ;;
+ -es1800*)
+ os=-ose
+ ;;
+ -xenix)
+ os=-xenix
+ ;;
+ -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+ os=-mint
+ ;;
+ -none)
+ ;;
+ *)
+ # Get rid of the `-' at the beginning of $os.
+ os=`echo $os | sed 's/[^-]*-//'`
+ echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system. Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+ *-acorn)
+ os=-riscix1.2
+ ;;
+ arm*-rebel)
+ os=-linux
+ ;;
+ arm*-semi)
+ os=-aout
+ ;;
+ # This must come before the *-dec entry.
+ pdp10-*)
+ os=-tops20
+ ;;
+ pdp11-*)
+ os=-none
+ ;;
+ *-dec | vax-*)
+ os=-ultrix4.2
+ ;;
+ m68*-apollo)
+ os=-domain
+ ;;
+ i386-sun)
+ os=-sunos4.0.2
+ ;;
+ m68000-sun)
+ os=-sunos3
+ # This also exists in the configure program, but was not the
+ # default.
+ # os=-sunos4
+ ;;
+ m68*-cisco)
+ os=-aout
+ ;;
+ mips*-cisco)
+ os=-elf
+ ;;
+ mips*-*)
+ os=-elf
+ ;;
+ or32-*)
+ os=-coff
+ ;;
+ *-tti) # must be before sparc entry or we get the wrong os.
+ os=-sysv3
+ ;;
+ sparc-* | *-sun)
+ os=-sunos4.1.1
+ ;;
+ *-be)
+ os=-beos
+ ;;
+ *-ibm)
+ os=-aix
+ ;;
+ *-wec)
+ os=-proelf
+ ;;
+ *-winbond)
+ os=-proelf
+ ;;
+ *-oki)
+ os=-proelf
+ ;;
+ *-hp)
+ os=-hpux
+ ;;
+ *-hitachi)
+ os=-hiux
+ ;;
+ i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+ os=-sysv
+ ;;
+ *-cbm)
+ os=-amigaos
+ ;;
+ *-dg)
+ os=-dgux
+ ;;
+ *-dolphin)
+ os=-sysv3
+ ;;
+ m68k-ccur)
+ os=-rtu
+ ;;
+ m88k-omron*)
+ os=-luna
+ ;;
+ *-next )
+ os=-nextstep
+ ;;
+ *-sequent)
+ os=-ptx
+ ;;
+ *-crds)
+ os=-unos
+ ;;
+ *-ns)
+ os=-genix
+ ;;
+ i370-*)
+ os=-mvs
+ ;;
+ *-next)
+ os=-nextstep3
+ ;;
+ *-gould)
+ os=-sysv
+ ;;
+ *-highlevel)
+ os=-bsd
+ ;;
+ *-encore)
+ os=-bsd
+ ;;
+ *-sgi)
+ os=-irix
+ ;;
+ *-siemens)
+ os=-sysv4
+ ;;
+ *-masscomp)
+ os=-rtu
+ ;;
+ f30[01]-fujitsu | f700-fujitsu)
+ os=-uxpv
+ ;;
+ *-rom68k)
+ os=-coff
+ ;;
+ *-*bug)
+ os=-coff
+ ;;
+ *-apple)
+ os=-macos
+ ;;
+ *-atari*)
+ os=-mint
+ ;;
+ *)
+ os=-none
+ ;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+ *-unknown)
+ case $os in
+ -riscix*)
+ vendor=acorn
+ ;;
+ -sunos*)
+ vendor=sun
+ ;;
+ -aix*)
+ vendor=ibm
+ ;;
+ -beos*)
+ vendor=be
+ ;;
+ -hpux*)
+ vendor=hp
+ ;;
+ -mpeix*)
+ vendor=hp
+ ;;
+ -hiux*)
+ vendor=hitachi
+ ;;
+ -unos*)
+ vendor=crds
+ ;;
+ -dgux*)
+ vendor=dg
+ ;;
+ -luna*)
+ vendor=omron
+ ;;
+ -genix*)
+ vendor=ns
+ ;;
+ -mvs* | -opened*)
+ vendor=ibm
+ ;;
+ -ptx*)
+ vendor=sequent
+ ;;
+ -vxsim* | -vxworks* | -windiss*)
+ vendor=wrs
+ ;;
+ -aux*)
+ vendor=apple
+ ;;
+ -hms*)
+ vendor=hitachi
+ ;;
+ -mpw* | -macos*)
+ vendor=apple
+ ;;
+ -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
+ vendor=atari
+ ;;
+ -vos*)
+ vendor=stratus
+ ;;
+ esac
+ basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+ ;;
+esac
+
+echo $basic_machine$os
+exit 0
+
+# Local variables:
+# eval: (add-hook 'write-file-hooks 'time-stamp)
+# time-stamp-start: "timestamp='"
+# time-stamp-format: "%:y-%02m-%02d"
+# time-stamp-end: "'"
+# End:
diff --git a/cil/configure b/cil/configure
new file mode 100755
index 0000000..fe8634b
--- /dev/null
+++ b/cil/configure
@@ -0,0 +1,5697 @@
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.59.
+#
+# Copyright (C) 2003 Free Software Foundation, Inc.
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+
+# Name of the host.
+# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# so uname gets run too.
+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
+
+exec 6>&1
+
+#
+# Initializations.
+#
+ac_default_prefix=/usr/local
+ac_config_libobj_dir=.
+cross_compiling=no
+subdirs=
+MFLAGS=
+MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+
+# Maximum number of lines to put in a shell here document.
+# This variable seems obsolete. It should probably be removed, and
+# only ac_max_sed_lines should be used.
+: ${ac_max_here_lines=38}
+
+# Identity of this package.
+PACKAGE_NAME=
+PACKAGE_TARNAME=
+PACKAGE_VERSION=
+PACKAGE_STRING=
+PACKAGE_BUGREPORT=
+
+ac_unique_file="src/cil.mli"
+# Factoring default headers for most tests.
+ac_includes_default="\
+#include <stdio.h>
+#if HAVE_SYS_TYPES_H
+# include <sys/types.h>
+#endif
+#if HAVE_SYS_STAT_H
+# include <sys/stat.h>
+#endif
+#if STDC_HEADERS
+# include <stdlib.h>
+# include <stddef.h>
+#else
+# if HAVE_STDLIB_H
+# include <stdlib.h>
+# endif
+#endif
+#if HAVE_STRING_H
+# if !STDC_HEADERS && HAVE_MEMORY_H
+# include <memory.h>
+# endif
+# include <string.h>
+#endif
+#if HAVE_STRINGS_H
+# include <strings.h>
+#endif
+#if HAVE_INTTYPES_H
+# include <inttypes.h>
+#else
+# if HAVE_STDINT_H
+# include <stdint.h>
+# endif
+#endif
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif"
+
+ac_subst_vars='CIL_FEATURES_DEFINES NEWLINE SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA build build_cpu build_vendor build_os host host_cpu host_vendor host_os target target_cpu target_vendor target_os CPP EGREP LIBOBJS ARCHOS CILHOME HAS_MSVC DEFAULT_COMPILER DEFAULT_CIL_MODE CIL_VERSION_MAJOR CIL_VERSION_MINOR CIL_VERSION_REV CIL_VERSION CYCLES_PER_USEC HAS_PERFCOUNT HAVE_BUILTIN_VA_LIST THREAD_IS_KEYWORD UNDERSCORE_NAME EXTRAFEATURES EXTRASRCDIRS LTLIBOBJS'
+ac_subst_files=''
+
+# Initialize some variables set by options.
+ac_init_help=
+ac_init_version=false
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+cache_file=/dev/null
+exec_prefix=NONE
+no_create=
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+verbose=
+x_includes=NONE
+x_libraries=NONE
+
+# Installation directory options.
+# These are left unexpanded so users can "make install exec_prefix=/foo"
+# and all the variables that are supposed to be based on exec_prefix
+# by default will actually change.
+# Use braces instead of parens because sh, perl, etc. also accept them.
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+ac_prev=
+for ac_option
+do
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case $ac_option in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir=$ac_optarg ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build_alias ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build_alias=$ac_optarg ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file=$ac_optarg ;;
+
+ --config-cache | -C)
+ cache_file=config.cache ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir=$ac_optarg ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ eval "enable_$ac_feature=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid feature name: $ac_feature" >&2
+ { (exit 1); exit 1; }; }
+ ac_feature=`echo $ac_feature | sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_$ac_feature='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix=$ac_optarg ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he | -h)
+ ac_init_help=long ;;
+ -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
+ ac_init_help=recursive ;;
+ -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
+ ac_init_help=short ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host_alias ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host_alias=$ac_optarg ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir=$ac_optarg ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir=$ac_optarg ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir=$ac_optarg ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir=$ac_optarg ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir=$ac_optarg ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir=$ac_optarg ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c | -n)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir=$ac_optarg ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix=$ac_optarg ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix=$ac_optarg ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix=$ac_optarg ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name=$ac_optarg ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir=$ac_optarg ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir=$ac_optarg ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site=$ac_optarg ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir=$ac_optarg ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir=$ac_optarg ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target_alias ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target_alias=$ac_optarg ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers | -V)
+ ac_init_version=: ;;
+
+ -with-* | --with-*)
+ ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case $ac_option in
+ *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_$ac_package='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid package name: $ac_package" >&2
+ { (exit 1); exit 1; }; }
+ ac_package=`echo $ac_package | sed 's/-/_/g'`
+ eval "with_$ac_package=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes=$ac_optarg ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries=$ac_optarg ;;
+
+ -*) { echo "$as_me: error: unrecognized option: $ac_option
+Try \`$0 --help' for more information." >&2
+ { (exit 1); exit 1; }; }
+ ;;
+
+ *=*)
+ ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
+ # Reject names that are not valid shell variable names.
+ expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
+ { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
+ { (exit 1); exit 1; }; }
+ ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
+ eval "$ac_envvar='$ac_optarg'"
+ export $ac_envvar ;;
+
+ *)
+ # FIXME: should be removed in autoconf 3.0.
+ echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
+ echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ ac_option=--`echo $ac_prev | sed 's/_/-/g'`
+ { echo "$as_me: error: missing argument to $ac_option" >&2
+ { (exit 1); exit 1; }; }
+fi
+
+# Be sure to have absolute paths.
+for ac_var in exec_prefix prefix
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# Be sure to have absolute paths.
+for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
+ localstatedir libdir includedir oldincludedir infodir mandir
+do
+ eval ac_val=$`echo $ac_var`
+ case $ac_val in
+ [\\/$]* | ?:[\\/]* ) ;;
+ *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# There might be people who depend on the old broken behavior: `$host'
+# used to hold the argument of --host etc.
+# FIXME: To remove some day.
+build=$build_alias
+host=$host_alias
+target=$target_alias
+
+# FIXME: To remove some day.
+if test "x$host_alias" != x; then
+ if test "x$build_alias" = x; then
+ cross_compiling=maybe
+ echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
+ If a cross compiler is detected then cross compile mode will be used." >&2
+ elif test "x$build_alias" != "x$host_alias"; then
+ cross_compiling=yes
+ fi
+fi
+
+ac_tool_prefix=
+test -n "$host_alias" && ac_tool_prefix=$host_alias-
+
+test "$silent" = yes && exec 6>/dev/null
+
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_confdir=`(dirname "$0") 2>/dev/null ||
+$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$0" : 'X\(//\)[^/]' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$0" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
+ { (exit 1); exit 1; }; }
+ else
+ { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
+ { (exit 1); exit 1; }; }
+ fi
+fi
+(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
+ { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
+ { (exit 1); exit 1; }; }
+srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
+ac_env_build_alias_set=${build_alias+set}
+ac_env_build_alias_value=$build_alias
+ac_cv_env_build_alias_set=${build_alias+set}
+ac_cv_env_build_alias_value=$build_alias
+ac_env_host_alias_set=${host_alias+set}
+ac_env_host_alias_value=$host_alias
+ac_cv_env_host_alias_set=${host_alias+set}
+ac_cv_env_host_alias_value=$host_alias
+ac_env_target_alias_set=${target_alias+set}
+ac_env_target_alias_value=$target_alias
+ac_cv_env_target_alias_set=${target_alias+set}
+ac_cv_env_target_alias_value=$target_alias
+ac_env_CC_set=${CC+set}
+ac_env_CC_value=$CC
+ac_cv_env_CC_set=${CC+set}
+ac_cv_env_CC_value=$CC
+ac_env_CFLAGS_set=${CFLAGS+set}
+ac_env_CFLAGS_value=$CFLAGS
+ac_cv_env_CFLAGS_set=${CFLAGS+set}
+ac_cv_env_CFLAGS_value=$CFLAGS
+ac_env_LDFLAGS_set=${LDFLAGS+set}
+ac_env_LDFLAGS_value=$LDFLAGS
+ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
+ac_cv_env_LDFLAGS_value=$LDFLAGS
+ac_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_env_CPPFLAGS_value=$CPPFLAGS
+ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
+ac_cv_env_CPPFLAGS_value=$CPPFLAGS
+ac_env_CPP_set=${CPP+set}
+ac_env_CPP_value=$CPP
+ac_cv_env_CPP_set=${CPP+set}
+ac_cv_env_CPP_value=$CPP
+
+#
+# Report the --help message.
+#
+if test "$ac_init_help" = "long"; then
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat <<_ACEOF
+\`configure' configures this package to adapt to many kinds of systems.
+
+Usage: $0 [OPTION]... [VAR=VALUE]...
+
+To assign environment variables (e.g., CC, CFLAGS...), specify them as
+VAR=VALUE. See below for descriptions of some of the useful variables.
+
+Defaults for the options are specified in brackets.
+
+Configuration:
+ -h, --help display this help and exit
+ --help=short display options specific to this package
+ --help=recursive display the short help of all the included packages
+ -V, --version display version information and exit
+ -q, --quiet, --silent do not print \`checking...' messages
+ --cache-file=FILE cache test results in FILE [disabled]
+ -C, --config-cache alias for \`--cache-file=config.cache'
+ -n, --no-create do not create output files
+ --srcdir=DIR find the sources in DIR [configure dir or \`..']
+
+_ACEOF
+
+ cat <<_ACEOF
+Installation directories:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [PREFIX]
+
+By default, \`make install' will install all the files in
+\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
+an installation prefix other than \`$ac_default_prefix' using \`--prefix',
+for instance \`--prefix=\$HOME'.
+
+For better control, use the options below.
+
+Fine tuning of the installation directories:
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --infodir=DIR info documentation [PREFIX/info]
+ --mandir=DIR man documentation [PREFIX/man]
+_ACEOF
+
+ cat <<\_ACEOF
+
+System types:
+ --build=BUILD configure for building on BUILD [guessed]
+ --host=HOST cross-compile to build programs to run on HOST [BUILD]
+ --target=TARGET configure for building compilers for TARGET [HOST]
+_ACEOF
+fi
+
+if test -n "$ac_init_help"; then
+
+ cat <<\_ACEOF
+
+Optional Packages:
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --with-blockinggraph enable the blocking graph feature
+ --with-rand enable the randomized value numbering
+ --with-arithabs enable the arithmetic abstraction
+ --with-zrapp enable the zrapp pretty-printer
+
+Some influential environment variables:
+ CC C compiler command
+ CFLAGS C compiler flags
+ LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
+ nonstandard directory <lib dir>
+ CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
+ headers in a nonstandard directory <include dir>
+ CPP C preprocessor
+
+Use these variables to override the choices made by `configure' or to help
+it to find libraries and programs with nonstandard names/locations.
+
+_ACEOF
+fi
+
+if test "$ac_init_help" = "recursive"; then
+ # If there are subdirs, report their specific --help.
+ ac_popdir=`pwd`
+ for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
+ test -d $ac_dir || continue
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+ cd $ac_dir
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_srcdir/configure.gnu; then
+ echo
+ $SHELL $ac_srcdir/configure.gnu --help=recursive
+ elif test -f $ac_srcdir/configure; then
+ echo
+ $SHELL $ac_srcdir/configure --help=recursive
+ elif test -f $ac_srcdir/configure.ac ||
+ test -f $ac_srcdir/configure.in; then
+ echo
+ $ac_configure --help
+ else
+ echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi
+ cd $ac_popdir
+ done
+fi
+
+test -n "$ac_init_help" && exit 0
+if $ac_init_version; then
+ cat <<\_ACEOF
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This configure script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it.
+_ACEOF
+ exit 0
+fi
+exec 5>config.log
+cat >&5 <<_ACEOF
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+
+It was created by $as_me, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ $ $0 $@
+
+_ACEOF
+{
+cat <<_ASUNAME
+## --------- ##
+## Platform. ##
+## --------- ##
+
+hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
+uname -m = `(uname -m) 2>/dev/null || echo unknown`
+uname -r = `(uname -r) 2>/dev/null || echo unknown`
+uname -s = `(uname -s) 2>/dev/null || echo unknown`
+uname -v = `(uname -v) 2>/dev/null || echo unknown`
+
+/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
+/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
+
+/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
+/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
+hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
+/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
+/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
+
+_ASUNAME
+
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ echo "PATH: $as_dir"
+done
+
+} >&5
+
+cat >&5 <<_ACEOF
+
+
+## ----------- ##
+## Core tests. ##
+## ----------- ##
+
+_ACEOF
+
+
+# Keep a trace of the command line.
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Strip out --silent because we don't want to record it for future runs.
+# Also quote any args containing shell meta-characters.
+# Make two passes to allow for proper duplicate-argument suppression.
+ac_configure_args=
+ac_configure_args0=
+ac_configure_args1=
+ac_sep=
+ac_must_keep_next=false
+for ac_pass in 1 2
+do
+ for ac_arg
+ do
+ case $ac_arg in
+ -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ continue ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ esac
+ case $ac_pass in
+ 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 2)
+ ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ if test $ac_must_keep_next = true; then
+ ac_must_keep_next=false # Got value, back to normal.
+ else
+ case $ac_arg in
+ *=* | --config-cache | -C | -disable-* | --disable-* \
+ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
+ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
+ | -with-* | --with-* | -without-* | --without-* | --x)
+ case "$ac_configure_args0 " in
+ "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
+ esac
+ ;;
+ -* ) ac_must_keep_next=true ;;
+ esac
+ fi
+ ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
+ # Get rid of the leading space.
+ ac_sep=" "
+ ;;
+ esac
+ done
+done
+$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
+$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+
+# When interrupted or exit'd, cleanup temporary files, and complete
+# config.log. We remove comments because anyway the quotes in there
+# would cause problems or look ugly.
+# WARNING: Be sure not to use single quotes in there, as some shells,
+# such as our DU 5.0 friend, will then `close' the trap.
+trap 'exit_status=$?
+ # Save into config.log some information that might help in debugging.
+ {
+ echo
+
+ cat <<\_ASBOX
+## ---------------- ##
+## Cache variables. ##
+## ---------------- ##
+_ASBOX
+ echo
+ # The following way of writing the cache mishandles newlines in values,
+{
+ (set) 2>&1 |
+ case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ sed -n \
+ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
+ ;;
+ *)
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+}
+ echo
+
+ cat <<\_ASBOX
+## ----------------- ##
+## Output variables. ##
+## ----------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_vars
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+
+ if test -n "$ac_subst_files"; then
+ cat <<\_ASBOX
+## ------------- ##
+## Output files. ##
+## ------------- ##
+_ASBOX
+ echo
+ for ac_var in $ac_subst_files
+ do
+ eval ac_val=$`echo $ac_var`
+ echo "$ac_var='"'"'$ac_val'"'"'"
+ done | sort
+ echo
+ fi
+
+ if test -s confdefs.h; then
+ cat <<\_ASBOX
+## ----------- ##
+## confdefs.h. ##
+## ----------- ##
+_ASBOX
+ echo
+ sed "/^$/d" confdefs.h | sort
+ echo
+ fi
+ test "$ac_signal" != 0 &&
+ echo "$as_me: caught signal $ac_signal"
+ echo "$as_me: exit $exit_status"
+ } >&5
+ rm -f core *.core &&
+ rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ exit $exit_status
+ ' 0
+for ac_signal in 1 2 13 15; do
+ trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+done
+ac_signal=0
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo >confdefs.h
+
+# Predefined preprocessor variables.
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_NAME "$PACKAGE_NAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_VERSION "$PACKAGE_VERSION"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_STRING "$PACKAGE_STRING"
+_ACEOF
+
+
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
+_ACEOF
+
+
+# Let the site file select an alternate cache file if it wants to.
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
+echo "$as_me: loading site script $ac_site_file" >&6;}
+ sed 's/^/| /' "$ac_site_file" >&5
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ # Some versions of bash will fail to source /dev/null (special
+ # files actually), so we avoid doing that.
+ if test -f "$cache_file"; then
+ { echo "$as_me:$LINENO: loading cache $cache_file" >&5
+echo "$as_me: loading cache $cache_file" >&6;}
+ case $cache_file in
+ [\\/]* | ?:[\\/]* ) . $cache_file;;
+ *) . ./$cache_file;;
+ esac
+ fi
+else
+ { echo "$as_me:$LINENO: creating cache $cache_file" >&5
+echo "$as_me: creating cache $cache_file" >&6;}
+ >$cache_file
+fi
+
+# Check that the precious variables saved in the cache have kept the same
+# value.
+ac_cache_corrupted=false
+for ac_var in `(set) 2>&1 |
+ sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+ eval ac_old_set=\$ac_cv_env_${ac_var}_set
+ eval ac_new_set=\$ac_env_${ac_var}_set
+ eval ac_old_val="\$ac_cv_env_${ac_var}_value"
+ eval ac_new_val="\$ac_env_${ac_var}_value"
+ case $ac_old_set,$ac_new_set in
+ set,)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,set)
+ { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
+echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ ac_cache_corrupted=: ;;
+ ,);;
+ *)
+ if test "x$ac_old_val" != "x$ac_new_val"; then
+ { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
+echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
+echo "$as_me: former value: $ac_old_val" >&2;}
+ { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
+echo "$as_me: current value: $ac_new_val" >&2;}
+ ac_cache_corrupted=:
+ fi;;
+ esac
+ # Pass precious variables to config.status.
+ if test "$ac_new_set" = set; then
+ case $ac_new_val in
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
+ ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *) ac_arg=$ac_var=$ac_new_val ;;
+ esac
+ case " $ac_configure_args " in
+ *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
+ *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ esac
+ fi
+done
+if $ac_cache_corrupted; then
+ { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
+echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
+echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ ac_config_headers="$ac_config_headers config.h"
+
+
+# sm: require a late-enough autoconf; this is the version number
+# that's on manju, so I assume it's ok
+
+
+#
+# Assign here the CIL version numbers
+CIL_VERSION_MAJOR=1
+CIL_VERSION_MINOR=3
+CIL_VERSION_REV=5
+CIL_VERSION=$CIL_VERSION_MAJOR.$CIL_VERSION_MINOR.$CIL_VERSION_REV
+
+
+# make sure I haven't forgotten to run autoconf
+if test configure -ot configure.in; then
+ { { echo "$as_me:$LINENO: error: configure is older than configure.in; you forgot to run autoconf" >&5
+echo "$as_me: error: configure is older than configure.in; you forgot to run autoconf" >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+# check for C compiler; this typically finds gcc; it sets the
+# variable CC to whatever it finds, which then gets substituted
+# for @CC@ in output files; you have to do this even if you don't
+# care about @CC@, because system feature tests later on in
+# the ./configure script will expect $CC to be set right
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="gcc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+set dummy ${ac_tool_prefix}cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="${ac_tool_prefix}cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$ac_cv_prog_CC"; then
+ ac_ct_CC=$CC
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ CC=$ac_ct_CC
+else
+ CC="$ac_cv_prog_CC"
+fi
+
+fi
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ ac_prog_rejected=no
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# != 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
+ fi
+fi
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+fi
+if test -z "$CC"; then
+ if test -n "$ac_tool_prefix"; then
+ for ac_prog in cl
+ do
+ # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
+set dummy $ac_tool_prefix$ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+CC=$ac_cv_prog_CC
+if test -n "$CC"; then
+ echo "$as_me:$LINENO: result: $CC" >&5
+echo "${ECHO_T}$CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$CC" && break
+ done
+fi
+if test -z "$CC"; then
+ ac_ct_CC=$CC
+ for ac_prog in cl
+do
+ # Extract the first word of "$ac_prog", so it can be a program name with args.
+set dummy $ac_prog; ac_word=$2
+echo "$as_me:$LINENO: checking for $ac_word" >&5
+echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
+if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test -n "$ac_ct_CC"; then
+ ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_ac_ct_CC="$ac_prog"
+ echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+done
+
+fi
+fi
+ac_ct_CC=$ac_cv_prog_ac_ct_CC
+if test -n "$ac_ct_CC"; then
+ echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
+echo "${ECHO_T}$ac_ct_CC" >&6
+else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+fi
+
+ test -n "$ac_ct_CC" && break
+done
+
+ CC=$ac_ct_CC
+fi
+
+fi
+
+
+test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&5
+echo "$as_me: error: no acceptable C compiler found in \$PATH
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+
+# Provide some information about the compiler.
+echo "$as_me:$LINENO:" \
+ "checking for C compiler version" >&5
+ac_compiler=`set X $ac_compile; echo $2`
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
+ (eval $ac_compiler --version </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
+ (eval $ac_compiler -v </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
+ (eval $ac_compiler -V </dev/null >&5) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }
+
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files a.out a.exe b.out"
+# Try to create an executable without -o first, disregard a.out.
+# It will help us diagnose broken compilers, and finding out an intuition
+# of exeext.
+echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
+echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
+ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
+ (eval $ac_link_default) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # Find the output, starting from the most likely. This scheme is
+# not robust to junk in `.', hence go to wildcards (a.*) only as a last
+# resort.
+
+# Be careful to initialize this variable, since it used to be cached.
+# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
+ac_cv_exeext=
+# b.out is created by i960 compilers.
+for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
+ ;;
+ conftest.$ac_ext )
+ # This is the source file.
+ ;;
+ [ab].out )
+ # We found the default executable, but exeext='' is most
+ # certainly right.
+ break;;
+ *.* )
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ # FIXME: I believe we export ac_cv_exeext for Libtool,
+ # but it would be cool to find out if it's true. Does anybody
+ # maintain Libtool? --akim.
+ export ac_cv_exeext
+ break;;
+ * )
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
+See \`config.log' for more details." >&5
+echo "$as_me: error: C compiler cannot create executables
+See \`config.log' for more details." >&2;}
+ { (exit 77); exit 77; }; }
+fi
+
+ac_exeext=$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_file" >&5
+echo "${ECHO_T}$ac_file" >&6
+
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether the C compiler works" >&5
+echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
+# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
+# If not cross compiling, check that we can run a simple program.
+if test "$cross_compiling" != yes; then
+ if { ac_try='./$ac_file'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ fi
+fi
+echo "$as_me:$LINENO: result: yes" >&5
+echo "${ECHO_T}yes" >&6
+
+rm -f a.out a.exe conftest$ac_cv_exeext b.out
+ac_clean_files=$ac_clean_files_save
+# Check the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
+echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
+echo "$as_me:$LINENO: result: $cross_compiling" >&5
+echo "${ECHO_T}$cross_compiling" >&6
+
+echo "$as_me:$LINENO: checking for suffix of executables" >&5
+echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ # If both `conftest.exe' and `conftest' are `present' (well, observable)
+# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
+# work properly (i.e., refer to `conftest.exe'), while it won't with
+# `rm'.
+for ac_file in conftest.exe conftest conftest.*; do
+ test -f "$ac_file" || continue
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ export ac_cv_exeext
+ break;;
+ * ) break;;
+ esac
+done
+else
+ { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest$ac_cv_exeext
+echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
+echo "${ECHO_T}$ac_cv_exeext" >&6
+
+rm -f conftest.$ac_ext
+EXEEXT=$ac_cv_exeext
+ac_exeext=$EXEEXT
+echo "$as_me:$LINENO: checking for suffix of object files" >&5
+echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
+if test "${ac_cv_objext+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.o conftest.obj
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; then
+ for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
+ break;;
+ esac
+done
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&5
+echo "$as_me: error: cannot compute suffix of object files: cannot compile
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+rm -f conftest.$ac_cv_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
+echo "${ECHO_T}$ac_cv_objext" >&6
+OBJEXT=$ac_cv_objext
+ac_objext=$OBJEXT
+echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
+echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
+if test "${ac_cv_c_compiler_gnu+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+#ifndef __GNUC__
+ choke me
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_compiler_gnu=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_compiler_gnu=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_cv_c_compiler_gnu=$ac_compiler_gnu
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
+echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
+GCC=`test $ac_compiler_gnu = yes && echo yes`
+ac_test_CFLAGS=${CFLAGS+set}
+ac_save_CFLAGS=$CFLAGS
+CFLAGS="-g"
+echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
+echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_g+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_g=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_prog_cc_g=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS=$ac_save_CFLAGS
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
+echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
+if test "${ac_cv_prog_cc_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_prog_cc_stdc=no
+ac_save_CC=$CC
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+
+/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
+ function prototypes and stuff, but not '\xHH' hex character constants.
+ These don't provoke an error unfortunately, instead are silently treated
+ as 'x'. The following induces an error, until -std1 is added to get
+ proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
+ array size at least. It's necessary to write '\x00'==0 to get something
+ that's true only with -std1. */
+int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+int
+main ()
+{
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+ ;
+ return 0;
+}
+_ACEOF
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX 10.20 and later -Ae
+# HP-UX older versions -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_prog_cc_stdc=$ac_arg
+break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext
+done
+rm -f conftest.$ac_ext conftest.$ac_objext
+CC=$ac_save_CC
+
+fi
+
+case "x$ac_cv_prog_cc_stdc" in
+ x|xno)
+ echo "$as_me:$LINENO: result: none needed" >&5
+echo "${ECHO_T}none needed" >&6 ;;
+ *)
+ echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
+echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
+ CC="$CC $ac_cv_prog_cc_stdc" ;;
+esac
+
+# Some people use a C++ compiler to compile C. Since we use `exit',
+# in C++ we need to declare it. In case someone uses the same compiler
+# for both compiling C and C++ we need to have the C++ compiler decide
+# the declaration of exit, since it's the most demanding environment.
+cat >conftest.$ac_ext <<_ACEOF
+#ifndef __cplusplus
+ choke me
+#endif
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ for ac_declaration in \
+ '' \
+ 'extern "C" void std::exit (int) throw (); using std::exit;' \
+ 'extern "C" void std::exit (int); using std::exit;' \
+ 'extern "C" void exit (int) throw ();' \
+ 'extern "C" void exit (int);' \
+ 'void exit (int);'
+do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+#include <stdlib.h>
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+continue
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_declaration
+int
+main ()
+{
+exit (42);
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+rm -f conftest*
+if test -n "$ac_declaration"; then
+ echo '#ifdef __cplusplus' >>confdefs.h
+ echo $ac_declaration >>confdefs.h
+ echo '#endif' >>confdefs.h
+fi
+
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ elif test -f $ac_dir/shtool; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/shtool install -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5
+echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+ac_config_guess="$SHELL $ac_aux_dir/config.guess"
+ac_config_sub="$SHELL $ac_aux_dir/config.sub"
+ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# OS/2's system install, which has a completely different semantic
+# ./install, which can be erroneously created by make from ./install.sh.
+echo "$as_me:$LINENO: checking for a BSD-compatible install" >&5
+echo $ECHO_N "checking for a BSD-compatible install... $ECHO_C" >&6
+if test -z "$INSTALL"; then
+if test "${ac_cv_path_install+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in
+ ./ | .// | /cC/* | \
+ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+ ?:\\/os2\\/install\\/* | ?:\\/OS2\\/INSTALL\\/* | \
+ /usr/ucb/* ) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if $as_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+ if test $ac_prog = install &&
+ grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ elif test $ac_prog = install &&
+ grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # program-specific install script used by HP pwplus--don't use.
+ :
+ else
+ ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+ break 3
+ fi
+ fi
+ done
+ done
+ ;;
+esac
+done
+
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL=$ac_cv_path_install
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL=$ac_install_sh
+ fi
+fi
+echo "$as_me:$LINENO: result: $INSTALL" >&5
+echo "${ECHO_T}$INSTALL" >&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+
+# find system type (using this macro means we must include
+# the files install-sh, config.sub, and config.guess (all from
+# the autoconf distribution) in our source tree!)
+# Make sure we can run config.sub.
+$ac_config_sub sun4 >/dev/null 2>&1 ||
+ { { echo "$as_me:$LINENO: error: cannot run $ac_config_sub" >&5
+echo "$as_me: error: cannot run $ac_config_sub" >&2;}
+ { (exit 1); exit 1; }; }
+
+echo "$as_me:$LINENO: checking build system type" >&5
+echo $ECHO_N "checking build system type... $ECHO_C" >&6
+if test "${ac_cv_build+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_build_alias=$build_alias
+test -z "$ac_cv_build_alias" &&
+ ac_cv_build_alias=`$ac_config_guess`
+test -z "$ac_cv_build_alias" &&
+ { { echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5
+echo "$as_me: error: cannot guess build type; you must specify one" >&2;}
+ { (exit 1); exit 1; }; }
+ac_cv_build=`$ac_config_sub $ac_cv_build_alias` ||
+ { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_build_alias failed" >&5
+echo "$as_me: error: $ac_config_sub $ac_cv_build_alias failed" >&2;}
+ { (exit 1); exit 1; }; }
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_build" >&5
+echo "${ECHO_T}$ac_cv_build" >&6
+build=$ac_cv_build
+build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+
+echo "$as_me:$LINENO: checking host system type" >&5
+echo $ECHO_N "checking host system type... $ECHO_C" >&6
+if test "${ac_cv_host+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_host_alias=$host_alias
+test -z "$ac_cv_host_alias" &&
+ ac_cv_host_alias=$ac_cv_build_alias
+ac_cv_host=`$ac_config_sub $ac_cv_host_alias` ||
+ { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_host_alias failed" >&5
+echo "$as_me: error: $ac_config_sub $ac_cv_host_alias failed" >&2;}
+ { (exit 1); exit 1; }; }
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_host" >&5
+echo "${ECHO_T}$ac_cv_host" >&6
+host=$ac_cv_host
+host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+
+echo "$as_me:$LINENO: checking target system type" >&5
+echo $ECHO_N "checking target system type... $ECHO_C" >&6
+if test "${ac_cv_target+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_target_alias=$target_alias
+test "x$ac_cv_target_alias" = "x" &&
+ ac_cv_target_alias=$ac_cv_host_alias
+ac_cv_target=`$ac_config_sub $ac_cv_target_alias` ||
+ { { echo "$as_me:$LINENO: error: $ac_config_sub $ac_cv_target_alias failed" >&5
+echo "$as_me: error: $ac_config_sub $ac_cv_target_alias failed" >&2;}
+ { (exit 1); exit 1; }; }
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_target" >&5
+echo "${ECHO_T}$ac_cv_target" >&6
+target=$ac_cv_target
+target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+test -n "$target_alias" &&
+ test "$program_prefix$program_suffix$program_transform_name" = \
+ NONENONEs,x,x, &&
+ program_prefix=${target_alias}-
+
+
+# ---------------- generic functions -----------------
+# debugging diagnostic; set to 'echo' to debug or 'true' for production
+# (technically you're not supposed to use shell functions in
+# configure scripts, because some-obscure-sh somewhere doesn't
+# support them.. but they're too convenient to not use)
+diagnostic() {
+ #echo "$@"
+ true "$@"
+}
+
+# determine if a binary is in the path
+binaryExists() {
+ # on cygwin, 'which' always returns success, so use 'type' instead
+ if type "$1" >/dev/null 2>&1; then
+ return 0
+ else
+ return 1
+ fi
+}
+
+
+# -------------- portable configuration ----------------
+# this specifies the root of the source tree; it's just the
+# directory where ./configure runs, except on cygwin, which
+# overrides this below
+CILHOME=`pwd`
+
+DEFAULT_COMPILER=_GNUCC
+DEFAULT_CIL_MODE=GNUCC
+
+# is the microsoft compiler available?
+# hmm.. I think we should check the version or something, because
+# sometimes people have Common Lisp's interpreter called 'cl' ..
+echo "$as_me:$LINENO: checking for msvc cl.exe (optional)" >&5
+echo $ECHO_N "checking for msvc cl.exe (optional)... $ECHO_C" >&6
+# See if CC points to the MS compiler
+if "$CC" 2>&1 | grep "Microsoft" >/dev/null; then
+ echo "$as_me:$LINENO: result: found, set as default" >&5
+echo "${ECHO_T}found, set as default" >&6
+ HAS_MSVC=yes
+ DEFAULT_COMPILER=_MSVC
+ DEFAULT_CIL_MODE=MSVC
+else
+ if cl 2>&1 | grep "Microsoft" >/dev/null ;then
+ echo "$as_me:$LINENO: result: found" >&5
+echo "${ECHO_T}found" >&6
+ HAS_MSVC=yes
+ else
+ echo "$as_me:$LINENO: result: not found" >&5
+echo "${ECHO_T}not found" >&6
+ HAS_MSVC=no
+ fi
+fi
+
+# is ocaml available?
+# needed binaries: ocamllex ocamlyacc ocamldep ocamlopt ocamlc
+ocamlDownloadInstructions="
+ OCaml can be downloaded from http://caml.inria.fr/ocaml/.
+ After downloading and unpacking the source distribution, in the ocaml
+ directory, do
+ ./configure
+ make world
+ make opt
+ make install
+ Then come back here and re-run ./configure."
+
+# required major/minor.
+# required major/minor
+reqMaj=3
+reqMin=08
+knownMaj=3
+knownMin=09
+echo "$as_me:$LINENO: checking ocaml version is at least $reqMaj.$reqMin" >&5
+echo $ECHO_N "checking ocaml version is at least $reqMaj.$reqMin... $ECHO_C" >&6
+if binaryExists ocamlc; then
+ # what version?
+ ver=`ocamlc -v | grep version | sed 's/^.*version //'`
+ diagnostic "ver is $ver"
+ # major: anything before the .
+ major=`echo $ver | sed 's/\..*$//'`
+ diagnostic "major is $major"
+ # minor: numbers after the .
+ # (the outer level of bracket-quotation protects the inner brackets)
+ minor=`echo $ver | sed 's/^[^.]*\.\([0-9][0-9]*\).*$/\1/'`
+ diagnostic "minor is $minor"
+
+ # I would think autoconf would already have a facility for doing
+ # these kinds of major/minor version checks, but I can't find it
+ if test $major -gt $reqMaj -o $major -ge $reqMaj -a $minor -ge $reqMin; then
+ echo "$as_me:$LINENO: result: version is $ver, ok" >&5
+echo "${ECHO_T}version is $ver, ok" >&6
+
+ # sm: added this test when we found that CCured needed to be changed
+ # a little when 3.06 came out (it had previously worked with 3.04)
+ if test "$major" -gt $knownMaj -o "$major" -ge $knownMaj -a "$minor" -gt $knownMin; then
+ { echo "$as_me:$LINENO: WARNING: Your ocaml version is $ver, but the latest version this program
+ is known to work with is $knownMaj.$knownMin. If you have
+ trouble compiling, please try using an earlier version
+ or see if there is a later version of this program." >&5
+echo "$as_me: WARNING: Your ocaml version is $ver, but the latest version this program
+ is known to work with is $knownMaj.$knownMin. If you have
+ trouble compiling, please try using an earlier version
+ or see if there is a later version of this program." >&2;}
+ fi
+ else
+ { { echo "$as_me:$LINENO: error:
+ I found OCaml version $ver; this program requires at least $reqMaj.$reqMin.
+ Please download a newer OCaml distribution.
+ $ocamlDownloadInstructions
+ " >&5
+echo "$as_me: error:
+ I found OCaml version $ver; this program requires at least $reqMaj.$reqMin.
+ Please download a newer OCaml distribution.
+ $ocamlDownloadInstructions
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+
+ # check for existence of other binaries
+ echo "$as_me:$LINENO: checking existence of related ocaml tools" >&5
+echo $ECHO_N "checking existence of related ocaml tools... $ECHO_C" >&6
+ if binaryExists ocamllex && \
+ binaryExists ocamlyacc && \
+ binaryExists ocamldep && \
+ binaryExists ocamlopt; then
+ echo "$as_me:$LINENO: result: ok" >&5
+echo "${ECHO_T}ok" >&6
+ else
+ { { echo "$as_me:$LINENO: error:
+ At least one of ocamllex, ocamlyacc, ocamldep or ocamlopt is missing.
+ In particular, ocamlopt requires you to \"make opt\" when building
+ OCaml from source. Please make sure all these tools are built and
+ in the path.
+ " >&5
+echo "$as_me: error:
+ At least one of ocamllex, ocamlyacc, ocamldep or ocamlopt is missing.
+ In particular, ocamlopt requires you to \"make opt\" when building
+ OCaml from source. Please make sure all these tools are built and
+ in the path.
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+else
+ { { echo "$as_me:$LINENO: error:
+ The \"ocamlc\" OCaml compiler was not found in the path: $PATH.
+
+ Most of this program is written in the OCaml language, so its compiler
+ is required.
+ $ocamlDownloadInstructions
+ " >&5
+echo "$as_me: error:
+ The \"ocamlc\" OCaml compiler was not found in the path: $PATH.
+
+ Most of this program is written in the OCaml language, so its compiler
+ is required.
+ $ocamlDownloadInstructions
+ " >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+#
+# ------------------- Perl ----------------
+#
+echo "$as_me:$LINENO: checking for Perl" >&5
+echo $ECHO_N "checking for Perl... $ECHO_C" >&6
+ if ! binaryExists perl; then
+ { { echo "$as_me:$LINENO: error:
+ perl not found.
+ You need perl version 5.6.1 or later for CIL.
+ You can get perl at http://www.cpan.org/src/index.html .
+ " >&5
+echo "$as_me: error:
+ perl not found.
+ You need perl version 5.6.1 or later for CIL.
+ You can get perl at http://www.cpan.org/src/index.html .
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+
+ # sm: oh how nice it would be to just say "use English;
+ # print($PERL_VERSION)", but that appears broken on 5.6.1.. so I'm
+ # trying to say "caret right-bracket", but then that would run afoul
+ # of autoconf's quoting characters, so I use the "quadrigraph" ]
+ # to stand for right-bracket. what a mess.
+ perlver=`perl -e 'print($]);'`
+ if perl -e "exit( $perlver >= 5.006001 );"; then
+ { { echo "$as_me:$LINENO: error:
+ Found perl version $perlver, but at least 5.6.1 is required.
+ You can get a newer perl at http://www.cpan.org/src/index.html .
+ " >&5
+echo "$as_me: error:
+ Found perl version $perlver, but at least 5.6.1 is required.
+ You can get a newer perl at http://www.cpan.org/src/index.html .
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+
+ perlport=`perl -e "print $^O;"`
+ case "$perlport" in
+ cygwin)
+ ;;
+ MSWin32) # ActivePerl
+ ;;
+ linux)
+ ;;
+ freebsd)
+ ;;
+ openbsd)
+ ;;
+ darwin) # Mac OS X
+ ;;
+ solaris)
+ ;;
+ *)
+ { { echo "$as_me:$LINENO: error:
+ Unsupported Perl port $perlport -- sorry.
+ cygwin, MSWin32 (ActivePerl), linux, freebsd, openbsd, darwin,
+ and solaris are the supported ports.
+ " >&5
+echo "$as_me: error:
+ Unsupported Perl port $perlport -- sorry.
+ cygwin, MSWin32 (ActivePerl), linux, freebsd, openbsd, darwin,
+ and solaris are the supported ports.
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ esac
+echo "$as_me:$LINENO: result: found version $perlver, port $perlport" >&5
+echo "${ECHO_T}found version $perlver, port $perlport" >&6
+
+ # The cygwin port has some bugs in the File::Spec module
+if test "$perlport" = "cygwin" ;then
+ echo "$as_me:$LINENO: checking for known cygwin Perl bug in File::Spec" >&5
+echo $ECHO_N "checking for known cygwin Perl bug in File::Spec... $ECHO_C" >&6
+ perlfixres=`perl -e '
+ use File::Spec;
+ if(File::Spec->file_name_is_absolute("C:/test")) {
+ print "no bug found"; exit 0;
+ } else {
+ print "bug";
+ foreach $d (@INC) {
+ if(-f "$d/File/Spec/Unix.pm") {
+ open(IN, "<$d/File/Spec/Unix.pm");
+ open(OUT, ">$d/File/Spec/Unix.pm.fixed")
+ || die "Cannot open $d/File/Spec/Unix.pm.fixed";
+ while(<IN>) {
+ if($_ =~ m|sub file_name_is_absolute|) {
+ print OUT $_;
+ print OUT scalar(<IN>);
+ print OUT <<EOF;
+ if(\\$^O eq \"cygwin\") {
+ return scalar(\\$file =~ m{^(\\[a-z\\]:)?\\[\\\\\\\\/\\]}is);
+};
+EOF
+ next;
+ }
+ print OUT $_;
+ }
+ close(OUT);
+ close(IN);
+ system("mv -f $d/File/Spec/Unix.pm.fixed $d/File/Spec/Unix.pm");
+ }
+ }
+ }
+ '`
+ # See if it was indeed fixed
+ if test "$perlfixres" = "bug" ;then
+ perlfixres=`perl -e '
+ use File::Spec;
+ if(File::Spec->file_name_is_absolute("C:/test")) {
+ print "bug fixed"; exit 0;
+ } else {
+ print "cannot fix bug"; exit 1;
+ }'`
+ fi
+ if test "x$perlfixres" = "x" ;then
+ { { echo "$as_me:$LINENO: error:
+ Cannot run perl
+ " >&5
+echo "$as_me: error:
+ Cannot run perl
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ elif test "$perlfixres" = "cannot fix bug" ;then
+ { { echo "$as_me:$LINENO: error:
+ Found a bug but cannot fix it.
+ " >&5
+echo "$as_me: error:
+ Found a bug but cannot fix it.
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ else
+ echo "$as_me:$LINENO: result: $perlfixres" >&5
+echo "${ECHO_T}$perlfixres" >&6
+ fi
+fi
+
+#
+# Now setup the performance counters
+#
+echo "$as_me:$LINENO: checking if performance counters are usable" >&5
+echo $ECHO_N "checking if performance counters are usable... $ECHO_C" >&6
+# Create a C file from src/perfcount.c.in
+rm -f ./cycles.exe
+if gcc -DCONFIGURATION_ONLY \
+ -x c ocamlutil/perfcount.c.in -lm -o ./cycles.exe >/dev/null 2>&1; then
+
+ if CYCLES_PER_USEC=`./cycles.exe 2>&1` ;then
+ echo "$as_me:$LINENO: result: ok ($CYCLES_PER_USEC cycles per us)" >&5
+echo "${ECHO_T}ok ($CYCLES_PER_USEC cycles per us)" >&6
+ else
+ # Print what we got
+ echo "$as_me:$LINENO: result: no ($CYCLES_PER_USEC)" >&5
+echo "${ECHO_T}no ($CYCLES_PER_USEC)" >&6
+ CYCLES_PER_USEC=0
+ fi
+else
+ CYCLES_PER_USEC=0
+ echo "$as_me:$LINENO: result: no (cannot compile perfcount.c)" >&5
+echo "${ECHO_T}no (cannot compile perfcount.c)" >&6
+fi
+rm -f ./cycles.exe
+
+# If we are on Linux and we use performance counters try to get
+# the processor speed from /proc/cpuinfo
+if test "$CYCLES_PER_USEC" != "0" ;then
+ case "$target" in
+ # linux
+ *86*linux*)
+ echo "$as_me:$LINENO: checking if /proc/cpuinfo has processor speed" >&5
+echo $ECHO_N "checking if /proc/cpuinfo has processor speed... $ECHO_C" >&6
+ cpuinfo=`cat /proc/cpuinfo 2>/dev/null | grep "cpu MHz"`
+ procspeed=`echo $cpuinfo | sed 's/^.*[^0-9]\([0-9]\+\.[0-9]\+\).*$/\1/g'`
+ if test "$procspeed"!="" ;then
+ CYCLES_PER_USEC=$procspeed
+ echo "$as_me:$LINENO: result: got $CYCLES_PER_USEC cycles per us" >&5
+echo "${ECHO_T}got $CYCLES_PER_USEC cycles per us" >&6
+ else
+ echo "$as_me:$LINENO: result: no" >&5
+echo "${ECHO_T}no" >&6
+ fi
+ ;;
+ *)
+ ;;
+ esac
+ # Now set HAS_PERFCOUNT
+ HAS_PERFCOUNT=1
+else
+ HAS_PERFCOUNT=0
+fi
+
+# additional tools we might check for:
+# - gnu make
+
+#
+# -------------------- GCC --------------
+#
+
+echo "$as_me:$LINENO: checking for gcc version" >&5
+echo $ECHO_N "checking for gcc version... $ECHO_C" >&6
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
+echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+ if test "${ac_cv_prog_CPP+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ # Double quotes because CPP needs to be expanded
+ for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
+ do
+ ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether non-existent headers
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ break
+fi
+
+ done
+ ac_cv_prog_CPP=$CPP
+
+fi
+ CPP=$ac_cv_prog_CPP
+else
+ ac_cv_prog_CPP=$CPP
+fi
+echo "$as_me:$LINENO: result: $CPP" >&5
+echo "${ECHO_T}$CPP" >&6
+ac_preproc_ok=false
+for ac_c_preproc_warn_flag in '' yes
+do
+ # Use a header file that comes with gcc, so configuring glibc
+ # with a fresh cross-compiler works.
+ # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ # <limits.h> exists even on freestanding compilers.
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp. "Syntax error" is here to catch this case.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+ Syntax error
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ :
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Broken: fails on valid input.
+continue
+fi
+rm -f conftest.err conftest.$ac_ext
+
+ # OK, works on sane cases. Now check whether non-existent headers
+ # can be detected and how.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ac_nonexistent.h>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ # Broken: success on invalid input.
+continue
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ # Passes both tests.
+ac_preproc_ok=:
+break
+fi
+rm -f conftest.err conftest.$ac_ext
+
+done
+# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
+rm -f conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then
+ :
+else
+ { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&5
+echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+
+ac_ext=c
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
+ac_compiler_gnu=$ac_cv_c_compiler_gnu
+
+
+echo "$as_me:$LINENO: checking for egrep" >&5
+echo $ECHO_N "checking for egrep... $ECHO_C" >&6
+if test "${ac_cv_prog_egrep+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if echo a | (grep -E '(a|b)') >/dev/null 2>&1
+ then ac_cv_prog_egrep='grep -E'
+ else ac_cv_prog_egrep='egrep'
+ fi
+fi
+echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
+echo "${ECHO_T}$ac_cv_prog_egrep" >&6
+ EGREP=$ac_cv_prog_egrep
+
+
+echo "$as_me:$LINENO: checking for ANSI C header files" >&5
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
+if test "${ac_cv_header_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_header_stdc=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_stdc=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "memchr" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "free" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then
+ :
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+ (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ exit(2);
+ exit (0);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_header_stdc=no
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
+echo "${ECHO_T}$ac_cv_header_stdc" >&6
+if test $ac_cv_header_stdc = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define STDC_HEADERS 1
+_ACEOF
+
+fi
+
+# On IRIX 5.3, sys/types and inttypes.h are conflicting.
+
+
+
+
+
+
+
+
+
+for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
+ inttypes.h stdint.h unistd.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_Header=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_Header=no"
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+echo "$as_me:$LINENO: checking for __builtin_va_list" >&5
+echo $ECHO_N "checking for __builtin_va_list... $ECHO_C" >&6
+if test "${ac_cv_type___builtin_va_list+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+if ((__builtin_va_list *) 0)
+ return 0;
+if (sizeof (__builtin_va_list))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_type___builtin_va_list=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_type___builtin_va_list=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_type___builtin_va_list" >&5
+echo "${ECHO_T}$ac_cv_type___builtin_va_list" >&6
+if test $ac_cv_type___builtin_va_list = yes; then
+ HAVE_BUILTIN_VA_LIST=true
+else
+ HAVE_BUILTIN_VA_LIST=false
+fi
+
+echo "$as_me:$LINENO: checking if __thread is a keyword" >&5
+echo $ECHO_N "checking if __thread is a keyword... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+int main(int __thread) { return 0; }
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ THREAD_IS_KEYWORD=false
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+THREAD_IS_KEYWORD=true
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $THREAD_IS_KEYWORD" >&5
+echo "${ECHO_T}$THREAD_IS_KEYWORD" >&6
+
+# Does gcc add underscores to identifiers to make assembly labels?
+# (I think MSVC always does)
+echo "$as_me:$LINENO: checking if gcc adds underscores to assembly labels." >&5
+echo $ECHO_N "checking if gcc adds underscores to assembly labels.... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+int main() { __asm__("jmp _main"); }
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ UNDERSCORE_NAME=true
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+UNDERSCORE_NAME=false
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $UNDERSCORE_NAME" >&5
+echo "${ECHO_T}$UNDERSCORE_NAME" >&6
+
+
+# ----------- some stuff 'autoscan' put here --------------
+# (autoscan is part of the autoconf distribution)
+
+# checks for header files
+echo "$as_me:$LINENO: checking for ANSI C header files" >&5
+echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
+if test "${ac_cv_header_stdc+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_header_stdc=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_stdc=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <string.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "memchr" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <stdlib.h>
+
+_ACEOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ $EGREP "free" >/dev/null 2>&1; then
+ :
+else
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+ if test "$cross_compiling" = yes; then
+ :
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <ctype.h>
+#if ((' ' & 0x0FF) == 0x020)
+# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#else
+# define ISLOWER(c) \
+ (('a' <= (c) && (c) <= 'i') \
+ || ('j' <= (c) && (c) <= 'r') \
+ || ('s' <= (c) && (c) <= 'z'))
+# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
+#endif
+
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int
+main ()
+{
+ int i;
+ for (i = 0; i < 256; i++)
+ if (XOR (islower (i), ISLOWER (i))
+ || toupper (i) != TOUPPER (i))
+ exit(2);
+ exit (0);
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ :
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_header_stdc=no
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
+echo "${ECHO_T}$ac_cv_header_stdc" >&6
+if test $ac_cv_header_stdc = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define STDC_HEADERS 1
+_ACEOF
+
+fi
+
+
+
+
+
+
+for ac_header in stdlib.h strings.h sys/time.h unistd.h wchar.h
+do
+as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+else
+ # Is the header compilable?
+echo "$as_me:$LINENO: checking $ac_header usability" >&5
+echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+#include <$ac_header>
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_header_compiler=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_header_compiler=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
+echo "${ECHO_T}$ac_header_compiler" >&6
+
+# Is the header present?
+echo "$as_me:$LINENO: checking $ac_header presence" >&5
+echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <$ac_header>
+_ACEOF
+if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
+ (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } >/dev/null; then
+ if test -s conftest.err; then
+ ac_cpp_err=$ac_c_preproc_warn_flag
+ ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
+ else
+ ac_cpp_err=
+ fi
+else
+ ac_cpp_err=yes
+fi
+if test -z "$ac_cpp_err"; then
+ ac_header_preproc=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.$ac_ext
+echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
+echo "${ECHO_T}$ac_header_preproc" >&6
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
+ yes:no: )
+ { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
+echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
+ ac_header_preproc=yes
+ ;;
+ no:yes:* )
+ { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
+echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
+echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
+echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
+echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
+echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
+ { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
+echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
+ (
+ cat <<\_ASBOX
+## ------------------------------------------ ##
+## Report this to the AC_PACKAGE_NAME lists. ##
+## ------------------------------------------ ##
+_ASBOX
+ ) |
+ sed "s/^/$as_me: WARNING: /" >&2
+ ;;
+esac
+echo "$as_me:$LINENO: checking for $ac_header" >&5
+echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
+if eval "test \"\${$as_ac_Header+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ eval "$as_ac_Header=\$ac_header_preproc"
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
+
+fi
+if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+
+done
+
+
+# checks for typedefs, structures, and compiler characteristics
+echo "$as_me:$LINENO: checking for an ANSI C-conforming const" >&5
+echo $ECHO_N "checking for an ANSI C-conforming const... $ECHO_C" >&6
+if test "${ac_cv_c_const+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+int
+main ()
+{
+/* FIXME: Include the comments suggested by Paul. */
+#ifndef __cplusplus
+ /* Ultrix mips cc rejects this. */
+ typedef int charset[2];
+ const charset x;
+ /* SunOS 4.1.1 cc rejects this. */
+ char const *const *ccp;
+ char **p;
+ /* NEC SVR4.0.2 mips cc rejects this. */
+ struct point {int x, y;};
+ static struct point const zero = {0,0};
+ /* AIX XL C 1.02.0.0 rejects this.
+ It does not let you subtract one const X* pointer from another in
+ an arm of an if-expression whose if-part is not a constant
+ expression */
+ const char *g = "string";
+ ccp = &g + (g ? g-g : 0);
+ /* HPUX 7.0 cc rejects these. */
+ ++ccp;
+ p = (char**) ccp;
+ ccp = (char const *const *) p;
+ { /* SCO 3.2v4 cc rejects this. */
+ char *t;
+ char const *s = 0 ? (char *) 0 : (char const *) 0;
+
+ *t++ = 0;
+ }
+ { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */
+ int x[] = {25, 17};
+ const int *foo = &x[0];
+ ++foo;
+ }
+ { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */
+ typedef const int *iptr;
+ iptr p = 0;
+ ++p;
+ }
+ { /* AIX XL C 1.02.0.0 rejects this saying
+ "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */
+ struct s { int j; const int *ap[3]; };
+ struct s *b; b->j = 5;
+ }
+ { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */
+ const int foo = 10;
+ }
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_c_const=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_c_const=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_const" >&5
+echo "${ECHO_T}$ac_cv_c_const" >&6
+if test $ac_cv_c_const = no; then
+
+cat >>confdefs.h <<\_ACEOF
+#define const
+_ACEOF
+
+fi
+
+echo "$as_me:$LINENO: checking for inline" >&5
+echo $ECHO_N "checking for inline... $ECHO_C" >&6
+if test "${ac_cv_c_inline+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_cv_c_inline=no
+for ac_kw in inline __inline__ __inline; do
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#ifndef __cplusplus
+typedef int foo_t;
+static $ac_kw foo_t static_foo () {return 0; }
+$ac_kw foo_t foo () {return 0; }
+#endif
+
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_c_inline=$ac_kw; break
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+done
+
+fi
+echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5
+echo "${ECHO_T}$ac_cv_c_inline" >&6
+
+
+case $ac_cv_c_inline in
+ inline | yes) ;;
+ *)
+ case $ac_cv_c_inline in
+ no) ac_val=;;
+ *) ac_val=$ac_cv_c_inline;;
+ esac
+ cat >>confdefs.h <<_ACEOF
+#ifndef __cplusplus
+#define inline $ac_val
+#endif
+_ACEOF
+ ;;
+esac
+
+echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5
+echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6
+if test "${ac_cv_header_time+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+
+int
+main ()
+{
+if ((struct tm *) 0)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext
+if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
+ (eval $ac_compile) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest.$ac_objext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_header_time=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_header_time=no
+fi
+rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5
+echo "${ECHO_T}$ac_cv_header_time" >&6
+if test $ac_cv_header_time = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define TIME_WITH_SYS_TIME 1
+_ACEOF
+
+fi
+
+
+# checks for library functions; more autoscan stuff
+echo "$as_me:$LINENO: checking for working memcmp" >&5
+echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6
+if test "${ac_cv_func_memcmp_working+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test "$cross_compiling" = yes; then
+ ac_cv_func_memcmp_working=no
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+$ac_includes_default
+int
+main ()
+{
+
+ /* Some versions of memcmp are not 8-bit clean. */
+ char c0 = 0x40, c1 = 0x80, c2 = 0x81;
+ if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0)
+ exit (1);
+
+ /* The Next x86 OpenStep bug shows up only when comparing 16 bytes
+ or more and with at least one buffer not starting on a 4-byte boundary.
+ William Lewis provided this test program. */
+ {
+ char foo[21];
+ char bar[21];
+ int i;
+ for (i = 0; i < 4; i++)
+ {
+ char *a = foo + i;
+ char *b = bar + i;
+ strcpy (a, "--------01111111");
+ strcpy (b, "--------10000000");
+ if (memcmp (a, b, 16) >= 0)
+ exit (1);
+ }
+ exit (0);
+ }
+
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_func_memcmp_working=yes
+else
+ echo "$as_me: program exited with status $ac_status" >&5
+echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+( exit $ac_status )
+ac_cv_func_memcmp_working=no
+fi
+rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+fi
+fi
+echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5
+echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6
+test $ac_cv_func_memcmp_working = no && case $LIBOBJS in
+ "memcmp.$ac_objext" | \
+ *" memcmp.$ac_objext" | \
+ "memcmp.$ac_objext "* | \
+ *" memcmp.$ac_objext "* ) ;;
+ *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;;
+esac
+
+
+
+
+
+
+for ac_func in mkdir select socket __sysv_signal
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+
+
+# ----------- platform-specific code -------------
+# $target is typically processor-vendor-os
+case "$target" in
+ # linux
+ *86*linux*|*86*freebsd*|*86*openbsd*|*86*darwin*)
+ echo "$as_me:$LINENO: result: configuring for linux/x86" >&5
+echo "${ECHO_T}configuring for linux/x86" >&6
+
+ ARCHOS=x86_LINUX
+ ;;
+
+ # Mac OS X
+ *powerpc*darwin*)
+ echo "$as_me:$LINENO: result: configuring for powerpc/darwin" >&5
+echo "${ECHO_T}configuring for powerpc/darwin" >&6
+
+ ARCHOS=ppc_DARWIN
+ ;;
+
+ # cygwin
+ *86*cygwin*)
+ echo "$as_me:$LINENO: result: configuring for Cygwin on win32/x86" >&5
+echo "${ECHO_T}configuring for Cygwin on win32/x86" >&6
+
+ ARCHOS=x86_WIN32
+
+ # override CILHOME; even on cygwin we want forward slashes
+ # sm: I folded this into what I hope will be the only
+ # case-analysis of machine type
+ CILHOME=`cygpath -wa "$CILHOME" | sed -e "s/\\\\\/\\//g"`
+ CC=`which $CC`
+ CC=`cygpath -wa "$CC" | sed -e "s/\\\\\/\\//g"`
+ ;;
+
+ # Solaris
+ *sparc*solaris*)
+ echo "$as_me:$LINENO: result: configuring for SPARC/Solaris" >&5
+echo "${ECHO_T}configuring for SPARC/Solaris" >&6
+
+ ARCHOS=sparc_SOLARIS
+ ;;
+
+ *)
+ { { echo "$as_me:$LINENO: error:
+ Unsupported platform $target -- sorry.
+ ./configure supports these platforms:
+ on x86: Linux, Win32(with Cygwin), freeBSD, openBSD, and Mac OS X
+ on PowerPC: Mac OS X
+ on SPARC: Solaris
+ " >&5
+echo "$as_me: error:
+ Unsupported platform $target -- sorry.
+ ./configure supports these platforms:
+ on x86: Linux, Win32(with Cygwin), freeBSD, openBSD, and Mac OS X
+ on PowerPC: Mac OS X
+ on SPARC: Solaris
+ " >&2;}
+ { (exit 1); exit 1; }; }
+ ;;
+esac
+
+# Make the object directory if not already present
+as_ac_File=`echo "ac_cv_file_obj/$ARCHOS" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for obj/$ARCHOS" >&5
+echo $ECHO_N "checking for obj/$ARCHOS... $ECHO_C" >&6
+if eval "test \"\${$as_ac_File+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ test "$cross_compiling" = yes &&
+ { { echo "$as_me:$LINENO: error: cannot check for file existence when cross compiling" >&5
+echo "$as_me: error: cannot check for file existence when cross compiling" >&2;}
+ { (exit 1); exit 1; }; }
+if test -r "obj/$ARCHOS"; then
+ eval "$as_ac_File=yes"
+else
+ eval "$as_ac_File=no"
+fi
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_File'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_File'}'`" >&6
+if test `eval echo '${'$as_ac_File'}'` = yes; then
+ :
+else
+ echo "$as_me:$LINENO: result: creating obj/$ARCHOS" >&5
+echo "${ECHO_T}creating obj/$ARCHOS" >&6;
+ mkdir -p obj/$ARCHOS
+fi
+
+
+echo "$as_me:$LINENO: checking delete the obj/$ARCHOS/feature_config.ml and obj/$ARCHOS/machdep.ml file" >&5
+echo $ECHO_N "checking delete the obj/$ARCHOS/feature_config.ml and obj/$ARCHOS/machdep.ml file... $ECHO_C" >&6
+rm -f obj/$ARCHOS/machdep.ml
+rm -f obj/.depend/machdep.d
+rm -f obj/$ARCHOS/feature_config.ml
+rm -f obj/.depend/feature_config.d
+echo "$as_me:$LINENO: result: done" >&5
+echo "${ECHO_T}done" >&6
+
+# We will use substitution variables whose definition contains newlines. The
+# problem is that when config.status runs, it wants to break the series of
+# substitution commands for sed into fragments based on line count. We could
+# be unlucky and have config.status break the series of substitution in the
+# middle of a variable that contains newlines. So, we first create a single
+# variable called NEWLINE whose definition is a carriage return. This means
+# that there will be exactly one opportunity for this error to happen (in the
+# definition of NEWLINE). The occurrence of AC_SUBST for NEWLINE must occur
+# after those of the variables that use it! And we want to put all of these
+# very early on, to make sure that they are not around the place when the file
+# bets broken.
+
+NEWLINE="\\
+"
+
+
+#
+# CIL/CCured features
+#
+#
+
+# Set the defaults
+
+
+# Give a space-separated list of features with the defaults
+features="blockinggraph=no rand=no arithabs=no zrapp=no"
+
+
+# Check whether --with-blockinggraph or --without-blockinggraph was given.
+if test "${with_blockinggraph+set}" = set; then
+ withval="$with_blockinggraph"
+
+fi;
+
+# Check whether --with-rand or --without-rand was given.
+if test "${with_rand+set}" = set; then
+ withval="$with_rand"
+
+fi;
+
+# Check whether --with-arithabs or --without-arithabs was given.
+if test "${with_arithabs+set}" = set; then
+ withval="$with_arithabs"
+
+fi;
+
+# Check whether --with-zrapp or --without-zrapp was given.
+if test "${with_zrapp+set}" = set; then
+ withval="$with_zrapp"
+
+fi;
+
+# Smalloc.ml is distributed by {matth,nks}@cs.berkeley.edu as part of Scrash.
+features="$features smalloc=no"
+
+# cqualann.ml is used by Matt Harren. Please ignore.
+features="$features cqualann=no"
+
+# Now add any features specified in the command-line
+
+features="$features $EXTRAFEATURES"
+
+for f_val in $features
+do
+ # If there is no =, then we default to yes
+ if ! (echo $f_val | grep "=" >/dev/null) ;then f_val="$f_val=yes"; fi
+ # echo "Testing feature $f_val"
+ f=`echo $f_val | sed -e s%=.*$%%`
+ echo "$as_me:$LINENO: checking whether to use CIL feature $f" >&5
+echo $ECHO_N "checking whether to use CIL feature $f... $ECHO_C" >&6
+ # default value from "features"
+ defval=`echo $f_val | sed -e s%^.*=%%`
+ # current value
+ getcurval="echo \${with_$f:=$defval}"
+ curval=`eval $getcurval`
+ echo "$as_me:$LINENO: result: $curval" >&5
+echo "${ECHO_T}$curval" >&6
+ if test $curval = yes ;then
+ CIL_FEATURES="$CIL_FEATURES $f"
+ fi
+done
+
+## Now produce the CIL_FEATURES_DEFINES
+CIL_FEATURES_DEFINES=""
+# Convert to upper case
+for f in `echo $CIL_FEATURES | tr a-z A-Z`
+do
+ CIL_FEATURES_DEFINES="${CIL_FEATURES_DEFINES}@NEWLINE@export USE_$f=yes"
+done
+
+
+# ----------------- finish up -------------------
+# names of the variables that get substituted in files; for example,
+# write @ARCHOS@ somewhere in a written file to get it substituted
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# finish the configure script and generate various files; ./configure
+# will apply variable substitutions to <filename>.in to generate <filename>;
+# I find it useful to mark generated files as read-only so I don't
+# accidentally edit them (and them lose my changes when ./configure
+# runs again); I had originally done the chmod after AC_OUTPUT, but
+# the problem is then the chmod doesn't run inside ./config.status
+
+# MY_AC_CONFIG_FILES(filename)
+# do AC_CONFIG_FILES(filename, chmod a-w filename)
+
+
+
+{
+ if test -f Makefile.in; then
+ ac_config_files="$ac_config_files Makefile"
+
+ else
+ true
+ #echo "skipping [Makefile] because it's not in this distribution"
+ fi
+}
+{
+ if test -f cil.spec.in; then
+ ac_config_files="$ac_config_files cil.spec"
+
+ else
+ true
+ #echo "skipping [cil.spec] because it's not in this distribution"
+ fi
+}
+{
+ if test -f config.mk.in; then
+ ac_config_files="$ac_config_files config.mk"
+
+ else
+ true
+ #echo "skipping [config.mk] because it's not in this distribution"
+ fi
+}
+{
+ if test -f test/Makefile.in; then
+ ac_config_files="$ac_config_files test/Makefile"
+
+ else
+ true
+ #echo "skipping [test/Makefile] because it's not in this distribution"
+ fi
+}
+{
+ if test -f bin/cilly.bat.in; then
+ ac_config_files="$ac_config_files bin/cilly.bat"
+
+ else
+ true
+ #echo "skipping [bin/cilly.bat] because it's not in this distribution"
+ fi
+}
+{
+ if test -f bin/patcher.bat.in; then
+ ac_config_files="$ac_config_files bin/patcher.bat"
+
+ else
+ true
+ #echo "skipping [bin/patcher.bat] because it's not in this distribution"
+ fi
+}
+{
+ if test -f bin/CilConfig.pm.in; then
+ ac_config_files="$ac_config_files bin/CilConfig.pm"
+
+ else
+ true
+ #echo "skipping [bin/CilConfig.pm] because it's not in this distribution"
+ fi
+}
+{
+ if test -f doc/index.html.in; then
+ ac_config_files="$ac_config_files doc/index.html"
+
+ else
+ true
+ #echo "skipping [doc/index.html] because it's not in this distribution"
+ fi
+}
+{
+ if test -f doc/header.html.in; then
+ ac_config_files="$ac_config_files doc/header.html"
+
+ else
+ true
+ #echo "skipping [doc/header.html] because it's not in this distribution"
+ fi
+}
+{
+ if test -f ocamlutil/perfcount.c.in; then
+ ac_config_files="$ac_config_files ocamlutil/perfcount.c"
+
+ else
+ true
+ #echo "skipping [ocamlutil/perfcount.c] because it's not in this distribution"
+ fi
+}
+
+cat >confcache <<\_ACEOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs, see configure's option --config-cache.
+# It is not useful on other systems. If it contains results you don't
+# want to keep, you may remove or edit it.
+#
+# config.status only pays attention to the cache file if you give it
+# the --recheck option to rerun configure.
+#
+# `ac_cv_env_foo' variables (set or unset) will be overridden when
+# loading this file, other *unset* `ac_cv_foo' will be assigned the
+# following values.
+
+_ACEOF
+
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+{
+ (set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ "s/'/'\\\\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n \
+ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ ;;
+ esac;
+} |
+ sed '
+ t clear
+ : clear
+ s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
+ t end
+ /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ : end' >>confcache
+if diff $cache_file confcache >/dev/null 2>&1; then :; else
+ if test -w $cache_file; then
+ test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
+ cat confcache >$cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# VPATH may cause trouble with some makes, so we remove $(srcdir),
+# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=/{
+s/:*\$(srcdir):*/:/;
+s/:*\${srcdir}:*/:/;
+s/:*@srcdir@:*/:/;
+s/^\([^=]*=[ ]*\):*/\1/;
+s/:*$//;
+s/^[^=]*=[ ]*$//;
+}'
+fi
+
+DEFS=-DHAVE_CONFIG_H
+
+ac_libobjs=
+ac_ltlibobjs=
+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
+ # 1. Remove the extension, and $U if already installed.
+ ac_i=`echo "$ac_i" |
+ sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
+ # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
+ # will be set to the directory where LIBOBJS objects are built.
+ ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+ ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
+done
+LIBOBJS=$ac_libobjs
+
+LTLIBOBJS=$ac_ltlibobjs
+
+
+
+: ${CONFIG_STATUS=./config.status}
+ac_clean_files_save=$ac_clean_files
+ac_clean_files="$ac_clean_files $CONFIG_STATUS"
+{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
+echo "$as_me: creating $CONFIG_STATUS" >&6;}
+cat >$CONFIG_STATUS <<_ACEOF
+#! $SHELL
+# Generated by $as_me.
+# Run this file to recreate the current configuration.
+# Compiler output produced by configure, useful for debugging
+# configure, is in config.log if it exists.
+
+debug=false
+ac_cs_recheck=false
+ac_cs_silent=false
+SHELL=\${CONFIG_SHELL-$SHELL}
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+## --------------------- ##
+## M4sh Initialization. ##
+## --------------------- ##
+
+# Be Bourne compatible
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+ emulate sh
+ NULLCMD=:
+ # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
+ set -o posix
+fi
+DUALCASE=1; export DUALCASE # for MKS sh
+
+# Support unset when possible.
+if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
+ as_unset=unset
+else
+ as_unset=false
+fi
+
+
+# Work around bugs in pre-3.0 UWIN ksh.
+$as_unset ENV MAIL MAILPATH
+PS1='$ '
+PS2='> '
+PS4='+ '
+
+# NLS nuisances.
+for as_var in \
+ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
+ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
+ LC_TELEPHONE LC_TIME
+do
+ if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
+ eval $as_var=C; export $as_var
+ else
+ $as_unset $as_var
+ fi
+done
+
+# Required to use basename.
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+ as_basename=basename
+else
+ as_basename=false
+fi
+
+
+# Name of the executable.
+as_me=`$as_basename "$0" ||
+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
+ X"$0" : 'X\(//\)$' \| \
+ X"$0" : 'X\(/\)$' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
+ /^X\/\(\/\/\)$/{ s//\1/; q; }
+ /^X\/\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+
+
+# PATH needs CR, and LINENO needs CR and PATH.
+# Avoid depending upon Character Ranges.
+as_cr_letters='abcdefghijklmnopqrstuvwxyz'
+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+as_cr_Letters=$as_cr_letters$as_cr_LETTERS
+as_cr_digits='0123456789'
+as_cr_alnum=$as_cr_Letters$as_cr_digits
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ echo "#! /bin/sh" >conf$$.sh
+ echo "exit 0" >>conf$$.sh
+ chmod +x conf$$.sh
+ if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
+ PATH_SEPARATOR=';'
+ else
+ PATH_SEPARATOR=:
+ fi
+ rm -f conf$$.sh
+fi
+
+
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" || {
+ # Find who we are. Look in the path if we contain no path at all
+ # relative or not.
+ case $0 in
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+done
+
+ ;;
+ esac
+ # We did not find ourselves, most probably we were run as `sh COMMAND'
+ # in which case we are not to be found in the path.
+ if test "x$as_myself" = x; then
+ as_myself=$0
+ fi
+ if test ! -f "$as_myself"; then
+ { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
+echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
+ { (exit 1); exit 1; }; }
+ fi
+ case $CONFIG_SHELL in
+ '')
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for as_base in sh bash ksh sh5; do
+ case $as_dir in
+ /*)
+ if ("$as_dir/$as_base" -c '
+ as_lineno_1=$LINENO
+ as_lineno_2=$LINENO
+ as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
+ test "x$as_lineno_1" != "x$as_lineno_2" &&
+ test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
+ $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
+ $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
+ CONFIG_SHELL=$as_dir/$as_base
+ export CONFIG_SHELL
+ exec "$CONFIG_SHELL" "$0" ${1+"$@"}
+ fi;;
+ esac
+ done
+done
+;;
+ esac
+
+ # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
+ # uniformly replaced by the line number. The first 'sed' inserts a
+ # line-number line before each line; the second 'sed' does the real
+ # work. The second script uses 'N' to pair each line-number line
+ # with the numbered line, and appends trailing '-' during
+ # substitution so that $LINENO is not a special case at line end.
+ # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
+ # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
+ sed '=' <$as_myself |
+ sed '
+ N
+ s,$,-,
+ : loop
+ s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ t loop
+ s,-$,,
+ s,^['$as_cr_digits']*\n,,
+ ' >$as_me.lineno &&
+ chmod +x $as_me.lineno ||
+ { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
+echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
+ { (exit 1); exit 1; }; }
+
+ # Don't try to exec as it changes $[0], causing all sort of problems
+ # (the dirname of $[0] is not the place where we might find the
+ # original and so on. Autoconf is especially sensible to this).
+ . ./$as_me.lineno
+ # Exit status is that of the last command.
+ exit
+}
+
+
+case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
+ *c*,-n*) ECHO_N= ECHO_C='
+' ECHO_T=' ' ;;
+ *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
+ *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+esac
+
+if expr a : '\(a\)' >/dev/null 2>&1; then
+ as_expr=expr
+else
+ as_expr=false
+fi
+
+rm -f conf$$ conf$$.exe conf$$.file
+echo >conf$$.file
+if ln -s conf$$.file conf$$ 2>/dev/null; then
+ # We could just check for DJGPP; but this test a) works b) is more generic
+ # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
+ if test -f conf$$.exe; then
+ # Don't use ln at all; we don't have any links
+ as_ln_s='cp -p'
+ else
+ as_ln_s='ln -s'
+ fi
+elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+else
+ as_ln_s='cp -p'
+fi
+rm -f conf$$ conf$$.exe conf$$.file
+
+if mkdir -p . 2>/dev/null; then
+ as_mkdir_p=:
+else
+ test -d ./-p && rmdir ./-p
+ as_mkdir_p=false
+fi
+
+as_executable_p="test -f"
+
+# Sed expression to map a string onto a valid CPP name.
+as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
+
+# Sed expression to map a string onto a valid variable name.
+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
+
+
+# IFS
+# We need space, tab and new line, in precisely that order.
+as_nl='
+'
+IFS=" $as_nl"
+
+# CDPATH.
+$as_unset CDPATH
+
+exec 6>&1
+
+# Open the log real soon, to keep \$[0] and so on meaningful, and to
+# report actual input values of CONFIG_FILES etc. instead of their
+# values after options handling. Logging --version etc. is OK.
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+} >&5
+cat >&5 <<_CSEOF
+
+This file was extended by $as_me, which was
+generated by GNU Autoconf 2.59. Invocation command line was
+
+ CONFIG_FILES = $CONFIG_FILES
+ CONFIG_HEADERS = $CONFIG_HEADERS
+ CONFIG_LINKS = $CONFIG_LINKS
+ CONFIG_COMMANDS = $CONFIG_COMMANDS
+ $ $0 $@
+
+_CSEOF
+echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
+echo >&5
+_ACEOF
+
+# Files that config.status was made for.
+if test -n "$ac_config_files"; then
+ echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_headers"; then
+ echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_links"; then
+ echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
+fi
+
+if test -n "$ac_config_commands"; then
+ echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
+fi
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+ac_cs_usage="\
+\`$as_me' instantiates files from templates according to the
+current configuration.
+
+Usage: $0 [OPTIONS] [FILE]...
+
+ -h, --help print this help, then exit
+ -V, --version print version number, then exit
+ -q, --quiet do not print progress messages
+ -d, --debug don't remove temporary files
+ --recheck update $as_me by reconfiguring in the same conditions
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
+ --header=FILE[:TEMPLATE]
+ instantiate the configuration header FILE
+
+Configuration files:
+$config_files
+
+Configuration headers:
+$config_headers
+
+Report bugs to <bug-autoconf@gnu.org>."
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+ac_cs_version="\\
+config.status
+configured by $0, generated by GNU Autoconf 2.59,
+ with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+
+Copyright (C) 2003 Free Software Foundation, Inc.
+This config.status script is free software; the Free Software Foundation
+gives unlimited permission to copy, distribute and modify it."
+srcdir=$srcdir
+INSTALL="$INSTALL"
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+# If no file are specified by the user, then we need to provide default
+# value. By we need to know if files were specified by the user.
+ac_need_defaults=:
+while test $# != 0
+do
+ case $1 in
+ --*=*)
+ ac_option=`expr "x$1" : 'x\([^=]*\)='`
+ ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ ac_shift=:
+ ;;
+ -*)
+ ac_option=$1
+ ac_optarg=$2
+ ac_shift=shift
+ ;;
+ *) # This is not an option, so the user has probably given explicit
+ # arguments.
+ ac_option=$1
+ ac_need_defaults=false;;
+ esac
+
+ case $ac_option in
+ # Handling of the options.
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ ac_cs_recheck=: ;;
+ --version | --vers* | -V )
+ echo "$ac_cs_version"; exit 0 ;;
+ --he | --h)
+ # Conflict between --help and --header
+ { { echo "$as_me:$LINENO: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: ambiguous option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; };;
+ --help | --hel | -h )
+ echo "$ac_cs_usage"; exit 0 ;;
+ --debug | --d* | -d )
+ debug=: ;;
+ --file | --fil | --fi | --f )
+ $ac_shift
+ CONFIG_FILES="$CONFIG_FILES $ac_optarg"
+ ac_need_defaults=false;;
+ --header | --heade | --head | --hea )
+ $ac_shift
+ CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ ac_need_defaults=false;;
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil | --si | --s)
+ ac_cs_silent=: ;;
+
+ # This is an error.
+ -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&5
+echo "$as_me: error: unrecognized option: $1
+Try \`$0 --help' for more information." >&2;}
+ { (exit 1); exit 1; }; } ;;
+
+ *) ac_config_targets="$ac_config_targets $1" ;;
+
+ esac
+ shift
+done
+
+ac_configure_extra_args=
+
+if $ac_cs_silent; then
+ exec 6>/dev/null
+ ac_configure_extra_args="$ac_configure_extra_args --silent"
+fi
+
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+if \$ac_cs_recheck; then
+ echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
+ exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+fi
+
+_ACEOF
+
+
+
+
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_config_target in $ac_config_targets
+do
+ case "$ac_config_target" in
+ # Handling of arguments.
+ "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "cil.spec" ) CONFIG_FILES="$CONFIG_FILES cil.spec" ;;
+ "config.mk" ) CONFIG_FILES="$CONFIG_FILES config.mk" ;;
+ "test/Makefile" ) CONFIG_FILES="$CONFIG_FILES test/Makefile" ;;
+ "bin/cilly.bat" ) CONFIG_FILES="$CONFIG_FILES bin/cilly.bat" ;;
+ "bin/patcher.bat" ) CONFIG_FILES="$CONFIG_FILES bin/patcher.bat" ;;
+ "bin/CilConfig.pm" ) CONFIG_FILES="$CONFIG_FILES bin/CilConfig.pm" ;;
+ "doc/index.html" ) CONFIG_FILES="$CONFIG_FILES doc/index.html" ;;
+ "doc/header.html" ) CONFIG_FILES="$CONFIG_FILES doc/header.html" ;;
+ "ocamlutil/perfcount.c" ) CONFIG_FILES="$CONFIG_FILES ocamlutil/perfcount.c" ;;
+ "config.h" ) CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;;
+ *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
+echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
+ { (exit 1); exit 1; }; };;
+ esac
+done
+
+# If the user did not use the arguments to specify the items to instantiate,
+# then the envvar interface is used. Set only those that are not.
+# We use the long form for the default assignment because of an extremely
+# bizarre bug on SunOS 4.1.3.
+if $ac_need_defaults; then
+ test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
+ test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers
+fi
+
+# Have a temporary directory for convenience. Make it in the build tree
+# simply because there is no reason to put it here, and in addition,
+# creating and moving files from /tmp can sometimes cause problems.
+# Create a temporary directory, and hook for its removal unless debugging.
+$debug ||
+{
+ trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
+ trap '{ (exit 1); exit 1; }' 1 2 13 15
+}
+
+# Create a (secure) tmp directory for tmp files.
+
+{
+ tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
+ test -n "$tmp" && test -d "$tmp"
+} ||
+{
+ tmp=./confstat$$-$RANDOM
+ (umask 077 && mkdir $tmp)
+} ||
+{
+ echo "$me: cannot create a temporary directory in ." >&2
+ { (exit 1); exit 1; }
+}
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<_ACEOF
+
+#
+# CONFIG_FILES section.
+#
+
+# No need to generate the scripts if there are no CONFIG_FILES.
+# This happens for instance when ./config.status config.h
+if test -n "\$CONFIG_FILES"; then
+ # Protect against being on the right side of a sed subst in config.status.
+ sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
+ s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
+s,@CIL_FEATURES_DEFINES@,$CIL_FEATURES_DEFINES,;t t
+s,@NEWLINE@,$NEWLINE,;t t
+s,@SHELL@,$SHELL,;t t
+s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
+s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
+s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
+s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
+s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
+s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
+s,@exec_prefix@,$exec_prefix,;t t
+s,@prefix@,$prefix,;t t
+s,@program_transform_name@,$program_transform_name,;t t
+s,@bindir@,$bindir,;t t
+s,@sbindir@,$sbindir,;t t
+s,@libexecdir@,$libexecdir,;t t
+s,@datadir@,$datadir,;t t
+s,@sysconfdir@,$sysconfdir,;t t
+s,@sharedstatedir@,$sharedstatedir,;t t
+s,@localstatedir@,$localstatedir,;t t
+s,@libdir@,$libdir,;t t
+s,@includedir@,$includedir,;t t
+s,@oldincludedir@,$oldincludedir,;t t
+s,@infodir@,$infodir,;t t
+s,@mandir@,$mandir,;t t
+s,@build_alias@,$build_alias,;t t
+s,@host_alias@,$host_alias,;t t
+s,@target_alias@,$target_alias,;t t
+s,@DEFS@,$DEFS,;t t
+s,@ECHO_C@,$ECHO_C,;t t
+s,@ECHO_N@,$ECHO_N,;t t
+s,@ECHO_T@,$ECHO_T,;t t
+s,@LIBS@,$LIBS,;t t
+s,@CC@,$CC,;t t
+s,@CFLAGS@,$CFLAGS,;t t
+s,@LDFLAGS@,$LDFLAGS,;t t
+s,@CPPFLAGS@,$CPPFLAGS,;t t
+s,@ac_ct_CC@,$ac_ct_CC,;t t
+s,@EXEEXT@,$EXEEXT,;t t
+s,@OBJEXT@,$OBJEXT,;t t
+s,@INSTALL_PROGRAM@,$INSTALL_PROGRAM,;t t
+s,@INSTALL_SCRIPT@,$INSTALL_SCRIPT,;t t
+s,@INSTALL_DATA@,$INSTALL_DATA,;t t
+s,@build@,$build,;t t
+s,@build_cpu@,$build_cpu,;t t
+s,@build_vendor@,$build_vendor,;t t
+s,@build_os@,$build_os,;t t
+s,@host@,$host,;t t
+s,@host_cpu@,$host_cpu,;t t
+s,@host_vendor@,$host_vendor,;t t
+s,@host_os@,$host_os,;t t
+s,@target@,$target,;t t
+s,@target_cpu@,$target_cpu,;t t
+s,@target_vendor@,$target_vendor,;t t
+s,@target_os@,$target_os,;t t
+s,@CPP@,$CPP,;t t
+s,@EGREP@,$EGREP,;t t
+s,@LIBOBJS@,$LIBOBJS,;t t
+s,@ARCHOS@,$ARCHOS,;t t
+s,@CILHOME@,$CILHOME,;t t
+s,@HAS_MSVC@,$HAS_MSVC,;t t
+s,@DEFAULT_COMPILER@,$DEFAULT_COMPILER,;t t
+s,@DEFAULT_CIL_MODE@,$DEFAULT_CIL_MODE,;t t
+s,@CIL_VERSION_MAJOR@,$CIL_VERSION_MAJOR,;t t
+s,@CIL_VERSION_MINOR@,$CIL_VERSION_MINOR,;t t
+s,@CIL_VERSION_REV@,$CIL_VERSION_REV,;t t
+s,@CIL_VERSION@,$CIL_VERSION,;t t
+s,@CYCLES_PER_USEC@,$CYCLES_PER_USEC,;t t
+s,@HAS_PERFCOUNT@,$HAS_PERFCOUNT,;t t
+s,@HAVE_BUILTIN_VA_LIST@,$HAVE_BUILTIN_VA_LIST,;t t
+s,@THREAD_IS_KEYWORD@,$THREAD_IS_KEYWORD,;t t
+s,@UNDERSCORE_NAME@,$UNDERSCORE_NAME,;t t
+s,@EXTRAFEATURES@,$EXTRAFEATURES,;t t
+s,@EXTRASRCDIRS@,$EXTRASRCDIRS,;t t
+s,@LTLIBOBJS@,$LTLIBOBJS,;t t
+CEOF
+
+_ACEOF
+
+ cat >>$CONFIG_STATUS <<\_ACEOF
+ # Split the substitutions into bite-sized pieces for seds with
+ # small command number limits, like on Digital OSF/1 and HP-UX.
+ ac_max_sed_lines=48
+ ac_sed_frag=1 # Number of current file.
+ ac_beg=1 # First line for current file.
+ ac_end=$ac_max_sed_lines # Line after last line for current file.
+ ac_more_lines=:
+ ac_sed_cmds=
+ while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ else
+ sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
+ fi
+ if test ! -s $tmp/subs.frag; then
+ ac_more_lines=false
+ else
+ # The purpose of the label and of the branching condition is to
+ # speed up the sed processing (if there are no `@' at all, there
+ # is no need to browse any of the substitutions).
+ # These are the two extra sed commands mentioned above.
+ (echo ':t
+ /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
+ fi
+ ac_sed_frag=`expr $ac_sed_frag + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_lines`
+ fi
+ done
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+ fi
+fi # test -n "$CONFIG_FILES"
+
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
+ esac
+
+ # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
+ ac_builddir=.
+
+if test "$ac_dir" != .; then
+ ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
+else
+ ac_dir_suffix= ac_top_builddir=
+fi
+
+case $srcdir in
+ .) # No --srcdir option. We are building in place.
+ ac_srcdir=.
+ if test -z "$ac_top_builddir"; then
+ ac_top_srcdir=.
+ else
+ ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
+ fi ;;
+ [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_srcdir=$srcdir$ac_dir_suffix;
+ ac_top_srcdir=$srcdir ;;
+ *) # Relative path.
+ ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_builddir$srcdir ;;
+esac
+
+# Do not use `cd foo && pwd` to compute absolute paths, because
+# the directories may not exist.
+case `pwd` in
+.) ac_abs_builddir="$ac_dir";;
+*)
+ case "$ac_dir" in
+ .) ac_abs_builddir=`pwd`;;
+ [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
+ *) ac_abs_builddir=`pwd`/"$ac_dir";;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_builddir=${ac_top_builddir}.;;
+*)
+ case ${ac_top_builddir}. in
+ .) ac_abs_top_builddir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
+ *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_srcdir=$ac_srcdir;;
+*)
+ case $ac_srcdir in
+ .) ac_abs_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
+ *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
+ esac;;
+esac
+case $ac_abs_builddir in
+.) ac_abs_top_srcdir=$ac_top_srcdir;;
+*)
+ case $ac_top_srcdir in
+ .) ac_abs_top_srcdir=$ac_abs_builddir;;
+ [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
+ *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
+ esac;;
+esac
+
+
+ case $INSTALL in
+ [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
+ *) ac_INSTALL=$ac_top_builddir$INSTALL ;;
+ esac
+
+ if test x"$ac_file" != x-; then
+ { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+ rm -f "$ac_file"
+ fi
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ configure_input=
+ else
+ configure_input="$ac_file. "
+ fi
+ configure_input=$configure_input"Generated from `echo $ac_file_in |
+ sed 's,.*/,,'` by configure."
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF
+ sed "$ac_vpsub
+$extrasub
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+:t
+/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
+s,@configure_input@,$configure_input,;t t
+s,@srcdir@,$ac_srcdir,;t t
+s,@abs_srcdir@,$ac_abs_srcdir,;t t
+s,@top_srcdir@,$ac_top_srcdir,;t t
+s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
+s,@builddir@,$ac_builddir,;t t
+s,@abs_builddir@,$ac_abs_builddir,;t t
+s,@top_builddir@,$ac_top_builddir,;t t
+s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
+s,@INSTALL@,$ac_INSTALL,;t t
+" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
+ rm -f $tmp/stdin
+ if test x"$ac_file" != x-; then
+ mv $tmp/out $ac_file
+ else
+ cat $tmp/out
+ rm -f $tmp/out
+ fi
+
+ # Run the commands associated with the file.
+ case $ac_file in
+ Makefile ) chmod a-w Makefile ;;
+ cil.spec ) chmod a-w cil.spec ;;
+ config.mk ) chmod a-w config.mk ;;
+ test/Makefile ) chmod a-w test/Makefile ;;
+ bin/cilly.bat ) chmod a-w,a+x bin/cilly.bat ;;
+ bin/patcher.bat ) chmod a-w,a+x bin/patcher.bat ;;
+ bin/CilConfig.pm ) chmod a-w bin/CilConfig.pm ;;
+ doc/index.html ) chmod a-w doc/index.html ;;
+ doc/header.html ) chmod a-w doc/header.html ;;
+ ocamlutil/perfcount.c ) chmod a-w ocamlutil/perfcount.c ;;
+ esac
+done
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+#
+# CONFIG_HEADER section.
+#
+
+# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
+# NAME is the cpp macro being defined and VALUE is the value it is being given.
+#
+# ac_d sets the value in "#define NAME VALUE" lines.
+ac_dA='s,^\([ ]*\)#\([ ]*define[ ][ ]*\)'
+ac_dB='[ ].*$,\1#\2'
+ac_dC=' '
+ac_dD=',;t'
+# ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_uA='s,^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_uB='$,\1#\2define\3'
+ac_uC=' '
+ac_uD=',;t'
+
+for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case $ac_file in
+ - | *:- | *:-:* ) # input from stdin
+ cat >$tmp/stdin
+ ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
+ ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
+ * ) ac_file_in=$ac_file.in ;;
+ esac
+
+ test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5
+echo "$as_me: creating $ac_file" >&6;}
+
+ # First look for the input files in the build tree, otherwise in the
+ # src tree.
+ ac_file_inputs=`IFS=:
+ for f in $ac_file_in; do
+ case $f in
+ -) echo $tmp/stdin ;;
+ [\\/$]*)
+ # Absolute (can't be DOS-style, as IFS=:)
+ test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ # Do quote $f, to prevent DOS paths from being IFS'd.
+ echo "$f";;
+ *) # Relative
+ if test -f "$f"; then
+ # Build tree
+ echo "$f"
+ elif test -f "$srcdir/$f"; then
+ # Source tree
+ echo "$srcdir/$f"
+ else
+ # /dev/null tree
+ { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
+echo "$as_me: error: cannot find input file: $f" >&2;}
+ { (exit 1); exit 1; }; }
+ fi;;
+ esac
+ done` || { (exit 1); exit 1; }
+ # Remove the trailing spaces.
+ sed 's/[ ]*$//' $ac_file_inputs >$tmp/in
+
+_ACEOF
+
+# Transform confdefs.h into two sed scripts, `conftest.defines' and
+# `conftest.undefs', that substitutes the proper values into
+# config.h.in to produce config.h. The first handles `#define'
+# templates, and the second `#undef' templates.
+# And first: Protect against being on the right side of a sed subst in
+# config.status. Protect against being in an unquoted here document
+# in config.status.
+rm -f conftest.defines conftest.undefs
+# Using a here document instead of a string reduces the quoting nightmare.
+# Putting comments in sed scripts is not portable.
+#
+# `end' is used to avoid that the second main sed command (meant for
+# 0-ary CPP macros) applies to n-ary macro definitions.
+# See the Autoconf documentation for `clear'.
+cat >confdef2sed.sed <<\_ACEOF
+s/[\\&,]/\\&/g
+s,[\\$`],\\&,g
+t clear
+: clear
+s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*\)\(([^)]*)\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp
+t end
+s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp
+: end
+_ACEOF
+# If some macros were called several times there might be several times
+# the same #defines, which is useless. Nevertheless, we may not want to
+# sort them, since we want the *last* AC-DEFINE to be honored.
+uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines
+sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs
+rm -f confdef2sed.sed
+
+# This sed command replaces #undef with comments. This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+cat >>conftest.undefs <<\_ACEOF
+s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */,
+_ACEOF
+
+# Break up conftest.defines because some shells have a limit on the size
+# of here documents, and old seds have small limits too (100 cmds).
+echo ' # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS
+echo ' if grep "^[ ]*#[ ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS
+echo ' # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS
+echo ' :' >>$CONFIG_STATUS
+rm -f conftest.tail
+while grep . conftest.defines >/dev/null
+do
+ # Write a limited-size here document to $tmp/defines.sed.
+ echo ' cat >$tmp/defines.sed <<CEOF' >>$CONFIG_STATUS
+ # Speed up: don't consider the non `#define' lines.
+ echo '/^[ ]*#[ ]*define/!b' >>$CONFIG_STATUS
+ # Work around the forget-to-reset-the-flag bug.
+ echo 't clr' >>$CONFIG_STATUS
+ echo ': clr' >>$CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS
+ echo 'CEOF
+ sed -f $tmp/defines.sed $tmp/in >$tmp/out
+ rm -f $tmp/in
+ mv $tmp/out $tmp/in
+' >>$CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail
+ rm -f conftest.defines
+ mv conftest.tail conftest.defines
+done
+rm -f conftest.defines
+echo ' fi # grep' >>$CONFIG_STATUS
+echo >>$CONFIG_STATUS
+
+# Break up conftest.undefs because some shells have a limit on the size
+# of here documents, and old seds have small limits too (100 cmds).
+echo ' # Handle all the #undef templates' >>$CONFIG_STATUS
+rm -f conftest.tail
+while grep . conftest.undefs >/dev/null
+do
+ # Write a limited-size here document to $tmp/undefs.sed.
+ echo ' cat >$tmp/undefs.sed <<CEOF' >>$CONFIG_STATUS
+ # Speed up: don't consider the non `#undef'
+ echo '/^[ ]*#[ ]*undef/!b' >>$CONFIG_STATUS
+ # Work around the forget-to-reset-the-flag bug.
+ echo 't clr' >>$CONFIG_STATUS
+ echo ': clr' >>$CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS
+ echo 'CEOF
+ sed -f $tmp/undefs.sed $tmp/in >$tmp/out
+ rm -f $tmp/in
+ mv $tmp/out $tmp/in
+' >>$CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail
+ rm -f conftest.undefs
+ mv conftest.tail conftest.undefs
+done
+rm -f conftest.undefs
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ if test x"$ac_file" = x-; then
+ echo "/* Generated by configure. */" >$tmp/config.h
+ else
+ echo "/* $ac_file. Generated by configure. */" >$tmp/config.h
+ fi
+ cat $tmp/in >>$tmp/config.h
+ rm -f $tmp/in
+ if test x"$ac_file" != x-; then
+ if diff $ac_file $tmp/config.h >/dev/null 2>&1; then
+ { echo "$as_me:$LINENO: $ac_file is unchanged" >&5
+echo "$as_me: $ac_file is unchanged" >&6;}
+ else
+ ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$ac_file" : 'X\(//\)[^/]' \| \
+ X"$ac_file" : 'X\(//\)$' \| \
+ X"$ac_file" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ { if $as_mkdir_p; then
+ mkdir -p "$ac_dir"
+ else
+ as_dir="$ac_dir"
+ as_dirs=
+ while test ! -d "$as_dir"; do
+ as_dirs="$as_dir $as_dirs"
+ as_dir=`(dirname "$as_dir") 2>/dev/null ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| \
+ . : '\(.\)' 2>/dev/null ||
+echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
+ /^X\(\/\/\)[^/].*/{ s//\1/; q; }
+ /^X\(\/\/\)$/{ s//\1/; q; }
+ /^X\(\/\).*/{ s//\1/; q; }
+ s/.*/./; q'`
+ done
+ test ! -n "$as_dirs" || mkdir $as_dirs
+ fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
+echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
+ { (exit 1); exit 1; }; }; }
+
+ rm -f $ac_file
+ mv $tmp/config.h $ac_file
+ fi
+ else
+ cat $tmp/config.h
+ rm -f $tmp/config.h
+ fi
+done
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF
+
+{ (exit 0); exit 0; }
+_ACEOF
+chmod +x $CONFIG_STATUS
+ac_clean_files=$ac_clean_files_save
+
+
+# configure is writing to config.log, and then calls config.status.
+# config.status does its own redirection, appending to config.log.
+# Unfortunately, on DOS this fails, as config.log is still kept open
+# by configure, so config.status won't be able to write to it; its
+# output is simply discarded. So we exec the FD to /dev/null,
+# effectively closing config.log, so it can be properly (re)opened and
+# appended to by config.status. When coming back to configure, we
+# need to make the FD available again.
+if test "$no_create" != yes; then
+ ac_cs_success=:
+ ac_config_status_args=
+ test "$silent" = yes &&
+ ac_config_status_args="$ac_config_status_args --quiet"
+ exec 5>/dev/null
+ $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
+ exec 5>>config.log
+ # Use ||, not &&, to avoid exiting from the if with $? = 1, which
+ # would make configure fail if this is the last instruction.
+ $ac_cs_success || { (exit 1); exit 1; }
+fi
+
+
+# show the user what the variables have been set to
+cat <<EOF
+
+CIL configuration:
+ architecture/OS: ARCHOS $ARCHOS
+ source tree root: CILHOME $CILHOME
+ (optional) cl.exe found: HAS_MSVC $HAS_MSVC
+ gcc to use CC $CC
+ default compiler DEFAULT_COMPILER $DEFAULT_COMPILER
+ CIL version CIL_VERSION $CIL_VERSION
+ CIL features CIL_FEATURES $CIL_FEATURES
+ Extra source directories EXTRASRCDIRS $EXTRASRCDIRS
+ Cycles per microsecond CYCLES_PER_USEC $CYCLES_PER_USEC
+EOF
+
diff --git a/cil/configure.in b/cil/configure.in
new file mode 100644
index 0000000..aee7ac7
--- /dev/null
+++ b/cil/configure.in
@@ -0,0 +1,600 @@
+# configure.in for CIL -*- sh -*-
+# Process this file with autoconf to produce a configure script.
+
+# Autoconf runs this through the M4 macroprocessor first; lines
+# starting with "dnl" are comments to M4. The result is a bash
+# script; any text which isn't an M4/autoconf directive gets
+# copied verbatim to that script.
+
+# also, in general, watch out: the M4 quoting charactes are
+# the square brackets: [ and ]. if you want to pass brackets
+# to something, you can quote the brackets with more brackets.
+# I don't know how to pass a single (unbalanced) bracket ..
+
+# sm: changed this file to use '#' for comments, since that's
+# just as good (since this becomes an 'sh' script)
+
+
+# We must put these AC_SUBST very early, and in this order. See below where we
+# define NEWLINE
+AC_SUBST(CIL_FEATURES_DEFINES)
+AC_SUBST(NEWLINE)
+
+
+# -------------- usual initial stuff -------------
+# this simply names a file somewhere in the source tree to verify
+# we're in the right directory
+AC_INIT(src/cil.mli)
+AC_CONFIG_HEADERS(config.h)
+
+# sm: require a late-enough autoconf; this is the version number
+# that's on manju, so I assume it's ok
+AC_PREREQ(2.50)
+
+#
+# Assign here the CIL version numbers
+CIL_VERSION_MAJOR=1
+CIL_VERSION_MINOR=3
+CIL_VERSION_REV=5
+CIL_VERSION=$CIL_VERSION_MAJOR.$CIL_VERSION_MINOR.$CIL_VERSION_REV
+
+
+# make sure I haven't forgotten to run autoconf
+if test configure -ot configure.in; then
+ AC_MSG_ERROR(configure is older than configure.in; you forgot to run autoconf)
+fi
+
+# check for C compiler; this typically finds gcc; it sets the
+# variable CC to whatever it finds, which then gets substituted
+# for @CC@ in output files; you have to do this even if you don't
+# care about @CC@, because system feature tests later on in
+# the ./configure script will expect $CC to be set right
+AC_PROG_CC
+
+AC_PROG_INSTALL
+
+
+# find system type (using this macro means we must include
+# the files install-sh, config.sub, and config.guess (all from
+# the autoconf distribution) in our source tree!)
+AC_CANONICAL_SYSTEM
+
+
+# ---------------- generic functions -----------------
+# debugging diagnostic; set to 'echo' to debug or 'true' for production
+# (technically you're not supposed to use shell functions in
+# configure scripts, because some-obscure-sh somewhere doesn't
+# support them.. but they're too convenient to not use)
+diagnostic() {
+ #echo "$@"
+ true "$@"
+}
+
+# determine if a binary is in the path
+binaryExists() {
+ # on cygwin, 'which' always returns success, so use 'type' instead
+ if type "$1" >/dev/null 2>&1; then
+ return 0
+ else
+ return 1
+ fi
+}
+
+
+# -------------- portable configuration ----------------
+# this specifies the root of the source tree; it's just the
+# directory where ./configure runs, except on cygwin, which
+# overrides this below
+CILHOME=`pwd`
+
+DEFAULT_COMPILER=_GNUCC
+DEFAULT_CIL_MODE=GNUCC
+
+# is the microsoft compiler available?
+# hmm.. I think we should check the version or something, because
+# sometimes people have Common Lisp's interpreter called 'cl' ..
+AC_MSG_CHECKING(for msvc cl.exe (optional))
+# See if CC points to the MS compiler
+if "$CC" 2>&1 | grep "Microsoft" >/dev/null; then
+ AC_MSG_RESULT([found, set as default])
+ HAS_MSVC=yes
+ DEFAULT_COMPILER=_MSVC
+ DEFAULT_CIL_MODE=MSVC
+else
+ if cl 2>&1 | grep "Microsoft" >/dev/null ;then
+ AC_MSG_RESULT(found)
+ HAS_MSVC=yes
+ else
+ AC_MSG_RESULT(not found)
+ HAS_MSVC=no
+ fi
+fi
+
+# is ocaml available?
+# needed binaries: ocamllex ocamlyacc ocamldep ocamlopt ocamlc
+ocamlDownloadInstructions="
+ OCaml can be downloaded from http://caml.inria.fr/ocaml/.
+ After downloading and unpacking the source distribution, in the ocaml
+ directory, do
+ ./configure
+ make world
+ make opt
+ make install
+ Then come back here and re-run ./configure."
+
+# required major/minor.
+# required major/minor
+reqMaj=3
+reqMin=08
+knownMaj=3
+knownMin=09
+AC_MSG_CHECKING(ocaml version is at least $reqMaj.$reqMin)
+if binaryExists ocamlc; then
+ # what version?
+ ver=`ocamlc -v | grep version | sed 's/^.*version //'`
+ diagnostic "ver is $ver"
+ # major: anything before the .
+ major=`echo $ver | sed 's/\..*$//'`
+ diagnostic "major is $major"
+ # minor: numbers after the .
+ # (the outer level of bracket-quotation protects the inner brackets)
+ [minor=`echo $ver | sed 's/^[^.]*\.\([0-9][0-9]*\).*$/\1/'`]
+ diagnostic "minor is $minor"
+
+ # I would think autoconf would already have a facility for doing
+ # these kinds of major/minor version checks, but I can't find it
+ if test $major -gt $reqMaj -o $major -ge $reqMaj -a $minor -ge $reqMin; then
+ AC_MSG_RESULT([version is $ver, ok])
+
+ # sm: added this test when we found that CCured needed to be changed
+ # a little when 3.06 came out (it had previously worked with 3.04)
+ if test "$major" -gt $knownMaj -o "$major" -ge $knownMaj -a "$minor" -gt $knownMin; then
+ AC_MSG_WARN([Your ocaml version is $ver, but the latest version this program
+ is known to work with is $knownMaj.$knownMin. If you have
+ trouble compiling, please try using an earlier version
+ or see if there is a later version of this program.])
+ fi
+ else
+ AC_MSG_ERROR([
+ I found OCaml version $ver; this program requires at least $reqMaj.$reqMin.
+ Please download a newer OCaml distribution.
+ $ocamlDownloadInstructions
+ ])
+ fi
+
+ # check for existence of other binaries
+ AC_MSG_CHECKING(existence of related ocaml tools)
+ if binaryExists ocamllex && \
+ binaryExists ocamlyacc && \
+ binaryExists ocamldep && \
+ binaryExists ocamlopt; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_ERROR([
+ At least one of ocamllex, ocamlyacc, ocamldep or ocamlopt is missing.
+ In particular, ocamlopt requires you to "make opt" when building
+ OCaml from source. Please make sure all these tools are built and
+ in the path.
+ ])
+ fi
+else
+ AC_MSG_ERROR([
+ The "ocamlc" OCaml compiler was not found in the path: $PATH.
+
+ Most of this program is written in the OCaml language, so its compiler
+ is required.
+ $ocamlDownloadInstructions
+ ])
+fi
+
+#
+# ------------------- Perl ----------------
+#
+AC_MSG_CHECKING([for Perl])
+ if ! binaryExists perl; then
+ AC_MSG_ERROR([
+ perl not found.
+ You need perl version 5.6.1 or later for CIL.
+ You can get perl at http://www.cpan.org/src/index.html .
+ ])
+ fi
+
+ # sm: oh how nice it would be to just say "use English;
+ # print($PERL_VERSION)", but that appears broken on 5.6.1.. so I'm
+ # trying to say "caret right-bracket", but then that would run afoul
+ # of autoconf's quoting characters, so I use the "quadrigraph" @:>@
+ # to stand for right-bracket. what a mess.
+ perlver=`perl -e 'print($@:>@);'`
+ if perl -e "exit( $perlver >= 5.006001 );"; then
+ AC_MSG_ERROR([
+ Found perl version $perlver, but at least 5.6.1 is required.
+ You can get a newer perl at http://www.cpan.org/src/index.html .
+ ])
+ fi
+
+ perlport=`perl -e "print $^O;"`
+ case "$perlport" in
+ cygwin)
+ ;;
+ MSWin32) # ActivePerl
+ ;;
+ linux)
+ ;;
+ freebsd)
+ ;;
+ openbsd)
+ ;;
+ darwin) # Mac OS X
+ ;;
+ solaris)
+ ;;
+ *)
+ AC_MSG_ERROR([
+ Unsupported Perl port $perlport -- sorry.
+ cygwin, MSWin32 (ActivePerl), linux, freebsd, openbsd, darwin,
+ and solaris are the supported ports.
+ ])
+ esac
+AC_MSG_RESULT([found version $perlver, port $perlport])
+
+ # The cygwin port has some bugs in the File::Spec module
+if test "$perlport" = "cygwin" ;then
+ AC_MSG_CHECKING([for known cygwin Perl bug in File::Spec])
+ perlfixres=[`perl -e '
+ use File::Spec;
+ if(File::Spec->file_name_is_absolute("C:/test")) {
+ print "no bug found"; exit 0;
+ } else {
+ print "bug";
+ foreach $d (@INC) {
+ if(-f "$d/File/Spec/Unix.pm") {
+ open(IN, "<$d/File/Spec/Unix.pm");
+ open(OUT, ">$d/File/Spec/Unix.pm.fixed")
+ || die "Cannot open $d/File/Spec/Unix.pm.fixed";
+ while(<IN>) {
+ if($_ =~ m|sub file_name_is_absolute|) {
+ print OUT $_;
+ print OUT scalar(<IN>);
+ print OUT <<EOF;
+ if(\\$^O eq \"cygwin\") {
+ return scalar(\\$file =~ m{^(\\[a-z\\]:)?\\[\\\\\\\\/\\]}is);
+};
+EOF
+ next;
+ }
+ print OUT $_;
+ }
+ close(OUT);
+ close(IN);
+ system("mv -f $d/File/Spec/Unix.pm.fixed $d/File/Spec/Unix.pm");
+ }
+ }
+ }
+ '`]
+ # See if it was indeed fixed
+ if test "$perlfixres" = "bug" ;then
+ perlfixres=`perl -e '
+ use File::Spec;
+ if(File::Spec->file_name_is_absolute("C:/test")) {
+ print "bug fixed"; exit 0;
+ } else {
+ print "cannot fix bug"; exit 1;
+ }'`
+ fi
+ if test "x$perlfixres" = "x" ;then
+ AC_MSG_ERROR([
+ Cannot run perl
+ ])
+ elif test "$perlfixres" = "cannot fix bug" ;then
+ AC_MSG_ERROR([
+ Found a bug but cannot fix it.
+ ])
+ else
+ AC_MSG_RESULT([$perlfixres])
+ fi
+fi
+
+#
+# Now setup the performance counters
+#
+AC_MSG_CHECKING(if performance counters are usable)
+# Create a C file from src/perfcount.c.in
+rm -f ./cycles.exe
+if gcc -DCONFIGURATION_ONLY \
+ -x c ocamlutil/perfcount.c.in -lm -o ./cycles.exe >/dev/null 2>&1; then
+
+ if CYCLES_PER_USEC=`./cycles.exe 2>&1` ;then
+ AC_MSG_RESULT([ok ($CYCLES_PER_USEC cycles per us)])
+ else
+ # Print what we got
+ AC_MSG_RESULT([no ($CYCLES_PER_USEC)])
+ CYCLES_PER_USEC=0
+ fi
+else
+ CYCLES_PER_USEC=0
+ AC_MSG_RESULT([no (cannot compile perfcount.c)])
+fi
+rm -f ./cycles.exe
+
+# If we are on Linux and we use performance counters try to get
+# the processor speed from /proc/cpuinfo
+if test "$CYCLES_PER_USEC" != "0" ;then
+ case "$target" in
+ # linux
+ *86*linux*)
+ AC_MSG_CHECKING(if /proc/cpuinfo has processor speed)
+ cpuinfo=`cat /proc/cpuinfo 2>/dev/null | grep "cpu MHz"`
+ [procspeed=`echo $cpuinfo | sed 's/^.*[^0-9]\([0-9]\+\.[0-9]\+\).*$/\1/g'`]
+ if test "$procspeed"!="" ;then
+ CYCLES_PER_USEC=$procspeed
+ AC_MSG_RESULT([got $CYCLES_PER_USEC cycles per us])
+ else
+ AC_MSG_RESULT(no)
+ fi
+ ;;
+ *)
+ ;;
+ esac
+ # Now set HAS_PERFCOUNT
+ HAS_PERFCOUNT=1
+else
+ HAS_PERFCOUNT=0
+fi
+
+# additional tools we might check for:
+# - gnu make
+
+#
+# -------------------- GCC --------------
+#
+
+AC_MSG_CHECKING([for gcc version])
+AC_CHECK_TYPE(__builtin_va_list,
+ HAVE_BUILTIN_VA_LIST=true,
+ HAVE_BUILTIN_VA_LIST=false)
+AC_MSG_CHECKING([if __thread is a keyword])
+AC_COMPILE_IFELSE([int main(int __thread) { return 0; }],
+ THREAD_IS_KEYWORD=false,
+ THREAD_IS_KEYWORD=true)
+AC_MSG_RESULT($THREAD_IS_KEYWORD)
+
+# Does gcc add underscores to identifiers to make assembly labels?
+# (I think MSVC always does)
+AC_MSG_CHECKING([if gcc adds underscores to assembly labels.])
+AC_LINK_IFELSE([int main() { __asm__("jmp _main"); }],
+ UNDERSCORE_NAME=true,
+ UNDERSCORE_NAME=false)
+AC_MSG_RESULT($UNDERSCORE_NAME)
+
+
+# ----------- some stuff 'autoscan' put here --------------
+# (autoscan is part of the autoconf distribution)
+
+# checks for header files
+AC_HEADER_STDC
+AC_CHECK_HEADERS(stdlib.h strings.h sys/time.h unistd.h wchar.h)
+
+# checks for typedefs, structures, and compiler characteristics
+AC_C_CONST
+AC_C_INLINE
+AC_HEADER_TIME
+
+# checks for library functions; more autoscan stuff
+AC_FUNC_MEMCMP
+AC_CHECK_FUNCS(mkdir select socket __sysv_signal)
+
+
+
+# ----------- platform-specific code -------------
+# $target is typically processor-vendor-os
+case "$target" in
+ # linux
+ *86*linux*|*86*freebsd*|*86*openbsd*|*86*darwin*)
+ AC_MSG_RESULT(configuring for linux/x86)
+
+ ARCHOS=x86_LINUX
+ ;;
+
+ # Mac OS X
+ *powerpc*darwin*)
+ AC_MSG_RESULT(configuring for powerpc/darwin, which we treat like linux/x86)
+
+ ARCHOS=ppc_DARWIN
+ ;;
+
+ # cygwin
+ *86*cygwin*)
+ AC_MSG_RESULT(configuring for Cygwin on win32/x86)
+
+ ARCHOS=x86_WIN32
+
+ # override CILHOME; even on cygwin we want forward slashes
+ # sm: I folded this into what I hope will be the only
+ # case-analysis of machine type
+ CILHOME=`cygpath -wa "$CILHOME" | sed -e "s/\\\\\/\\//g"`
+ CC=`which $CC`
+ CC=`cygpath -wa "$CC" | sed -e "s/\\\\\/\\//g"`
+ ;;
+
+ # Solaris
+ *sparc*solaris*)
+ AC_MSG_RESULT(configuring for SPARC/Solaris)
+
+ ARCHOS=sparc_SOLARIS
+ ;;
+
+ *)
+ AC_MSG_ERROR([
+ Unsupported platform $target -- sorry.
+ ./configure supports these platforms:
+ on x86: Linux, Win32(with Cygwin), freeBSD, openBSD, and Mac OS X
+ on PowerPC: Mac OS X
+ on SPARC: Solaris
+ ])
+ ;;
+esac
+
+# Make the object directory if not already present
+AC_CHECK_FILE(obj/$ARCHOS,, AC_MSG_RESULT(creating obj/$ARCHOS);
+ mkdir -p obj/$ARCHOS)
+
+AC_MSG_CHECKING([delete the obj/$ARCHOS/feature_config.ml and obj/$ARCHOS/machdep.ml file])
+rm -f obj/$ARCHOS/machdep.ml
+rm -f obj/.depend/machdep.d
+rm -f obj/$ARCHOS/feature_config.ml
+rm -f obj/.depend/feature_config.d
+AC_MSG_RESULT([done])
+
+# We will use substitution variables whose definition contains newlines. The
+# problem is that when config.status runs, it wants to break the series of
+# substitution commands for sed into fragments based on line count. We could
+# be unlucky and have config.status break the series of substitution in the
+# middle of a variable that contains newlines. So, we first create a single
+# variable called NEWLINE whose definition is a carriage return. This means
+# that there will be exactly one opportunity for this error to happen (in the
+# definition of NEWLINE). The occurrence of AC_SUBST for NEWLINE must occur
+# after those of the variables that use it! And we want to put all of these
+# very early on, to make sure that they are not around the place when the file
+# bets broken.
+
+NEWLINE="\\
+"
+
+
+#
+# CIL/CCured features
+#
+#
+
+# Set the defaults
+
+
+# Give a space-separated list of features with the defaults
+features="blockinggraph=no rand=no arithabs=no zrapp=no"
+
+AC_ARG_WITH(blockinggraph,
+ AC_HELP_STRING([--with-blockinggraph],
+ [enable the blocking graph feature]))
+AC_ARG_WITH(rand,
+ AC_HELP_STRING([--with-rand],
+ [enable the randomized value numbering]))
+AC_ARG_WITH(arithabs,
+ AC_HELP_STRING([--with-arithabs],
+ [enable the arithmetic abstraction]))
+AC_ARG_WITH(zrapp,
+ AC_HELP_STRING([--with-zrapp],
+ [enable the zrapp pretty-printer]))
+
+# Smalloc.ml is distributed by {matth,nks}@cs.berkeley.edu as part of Scrash.
+features="$features smalloc=no"
+
+# cqualann.ml is used by Matt Harren. Please ignore.
+features="$features cqualann=no"
+
+# Now add any features specified in the command-line
+
+features="$features $EXTRAFEATURES"
+
+for f_val in $features
+do
+ # If there is no =, then we default to yes
+ if ! (echo $f_val | grep "=" >/dev/null) ;then f_val="$f_val=yes"; fi
+ # echo "Testing feature $f_val"
+ f=`echo $f_val | sed -e s%=.*$%%`
+ AC_MSG_CHECKING(whether to use CIL feature $f)
+ # default value from "features"
+ defval=`echo $f_val | sed -e s%^.*=%%`
+ # current value
+ getcurval="echo \${with_$f:=$defval}"
+ curval=`eval $getcurval`
+ AC_MSG_RESULT($curval)
+ if test $curval = yes ;then
+ CIL_FEATURES="$CIL_FEATURES $f"
+ fi
+done
+
+## Now produce the CIL_FEATURES_DEFINES
+CIL_FEATURES_DEFINES=""
+# Convert to upper case
+for f in `echo $CIL_FEATURES | tr a-z A-Z`
+do
+ CIL_FEATURES_DEFINES="${CIL_FEATURES_DEFINES}@NEWLINE@export USE_$f=yes"
+done
+
+
+# ----------------- finish up -------------------
+# names of the variables that get substituted in files; for example,
+# write @ARCHOS@ somewhere in a written file to get it substituted
+AC_SUBST(ARCHOS)
+AC_SUBST(CILHOME)
+AC_SUBST(HAS_MSVC)
+AC_SUBST(DEFAULT_COMPILER)
+AC_SUBST(DEFAULT_CIL_MODE)
+AC_SUBST(CIL_VERSION_MAJOR)
+AC_SUBST(CIL_VERSION_MINOR)
+AC_SUBST(CIL_VERSION_REV)
+AC_SUBST(CIL_VERSION)
+AC_SUBST(CYCLES_PER_USEC)
+AC_SUBST(HAS_PERFCOUNT)
+AC_SUBST(HAVE_BUILTIN_VA_LIST)
+AC_SUBST(THREAD_IS_KEYWORD)
+AC_SUBST(UNDERSCORE_NAME)
+AC_SUBST(EXTRAFEATURES)
+AC_SUBST(EXTRASRCDIRS)
+
+# finish the configure script and generate various files; ./configure
+# will apply variable substitutions to <filename>.in to generate <filename>;
+# I find it useful to mark generated files as read-only so I don't
+# accidentally edit them (and them lose my changes when ./configure
+# runs again); I had originally done the chmod after AC_OUTPUT, but
+# the problem is then the chmod doesn't run inside ./config.status
+
+# MY_AC_CONFIG_FILES(filename)
+# do AC_CONFIG_FILES(filename, chmod a-w filename)
+define([MY_AC_CONFIG_FILES],
+[{
+ if test -f [$1].in; then
+ AC_CONFIG_FILES([$1], chmod a-w [$1])
+ else
+ true
+ #echo "skipping [$1] because it's not in this distribution"
+ fi
+}])
+define([MY_AC_CONFIG_EXE_FILES],
+[{
+ if test -f [$1].in; then
+ AC_CONFIG_FILES([$1], [chmod a-w,a+x $1])
+ else
+ true
+ #echo "skipping [$1] because it's not in this distribution"
+ fi
+}])
+
+MY_AC_CONFIG_FILES(Makefile)
+MY_AC_CONFIG_FILES(cil.spec)
+MY_AC_CONFIG_FILES(config.mk)
+MY_AC_CONFIG_FILES(test/Makefile)
+MY_AC_CONFIG_EXE_FILES(bin/cilly.bat)
+MY_AC_CONFIG_EXE_FILES(bin/patcher.bat)
+MY_AC_CONFIG_FILES(bin/CilConfig.pm)
+MY_AC_CONFIG_FILES(doc/index.html)
+MY_AC_CONFIG_FILES(doc/header.html)
+MY_AC_CONFIG_FILES(ocamlutil/perfcount.c)
+
+AC_OUTPUT()
+
+# show the user what the variables have been set to
+cat <<EOF
+
+CIL configuration:
+ architecture/OS: ARCHOS $ARCHOS
+ source tree root: CILHOME $CILHOME
+ (optional) cl.exe found: HAS_MSVC $HAS_MSVC
+ gcc to use CC $CC
+ default compiler DEFAULT_COMPILER $DEFAULT_COMPILER
+ CIL version CIL_VERSION $CIL_VERSION
+ CIL features CIL_FEATURES $CIL_FEATURES
+ Extra source directories EXTRASRCDIRS $EXTRASRCDIRS
+ Cycles per microsecond CYCLES_PER_USEC $CYCLES_PER_USEC
+EOF
+
diff --git a/cil/doc/CIL-API.pdf b/cil/doc/CIL-API.pdf
new file mode 100644
index 0000000..240ff49
--- /dev/null
+++ b/cil/doc/CIL-API.pdf
Binary files differ
diff --git a/cil/doc/CIL.pdf b/cil/doc/CIL.pdf
new file mode 100644
index 0000000..34554fa
--- /dev/null
+++ b/cil/doc/CIL.pdf
Binary files differ
diff --git a/cil/doc/api/Alpha.html b/cil/doc/api/Alpha.html
new file mode 100644
index 0000000..699fac0
--- /dev/null
+++ b/cil/doc/api/Alpha.html
@@ -0,0 +1,79 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Formatcil.html">
+<link rel="next" href="Cillower.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Alpha</title>
+</head>
+<body>
+<div class="navbar"><a href="Formatcil.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Cillower.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Alpha.html">Alpha</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Alpha: <code class="code">sig</code> <a href="Alpha.html">..</a> <code class="code">end</code></pre><b>ALPHA conversion</b><br>
+<hr width="100%">
+<pre><span class="keyword">type</span> <a name="TYPEundoAlphaElement"></a><code class="type">'a</code> undoAlphaElement </pre>
+<div class="info">
+This is the type of the elements that are recorded by the alpha
+ conversion functions in order to be able to undo changes to the tables
+ they modify. Useful for implementing
+ scoping<br>
+</div>
+
+<pre><span class="keyword">type</span> <a name="TYPEalphaTableData"></a><code class="type">'a</code> alphaTableData </pre>
+<div class="info">
+This is the type of the elements of the alpha renaming table. These
+ elements can carry some data associated with each occurrence of the name.<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALnewAlphaName"></a>newAlphaName : <code class="type">alphaTable:(string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -><br> undolist:'a <a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> list Pervasives.ref option -><br> lookupname:string -> data:'a -> string * 'a</code></pre><div class="info">
+Create a new name based on a given name. The new name is formed from a
+ prefix (obtained from the given name by stripping a suffix consisting of _
+ followed by only digits), followed by a special separator and then by a
+ positive integer suffix. The first argument is a table mapping name
+ prefixes to some data that specifies what suffixes have been used and how
+ to create the new one. This function updates the table with the new
+ largest suffix generated. The "undolist" argument, when present, will be
+ used by the function to record information that can be used by
+ <a href="Alpha.html#VALundoAlphaChanges"><code class="code">Alpha.undoAlphaChanges</code></a> to undo those changes. Note that the undo
+ information will be in reverse order in which the action occurred. Returns
+ the new name and, if different from the lookupname, the location of the
+ previous occurrence. This function knows about the location implicitly
+ from the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALregisterAlphaName"></a>registerAlphaName : <code class="type">alphaTable:(string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -><br> undolist:'a <a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> list Pervasives.ref option -><br> lookupname:string -> data:'a -> unit</code></pre><div class="info">
+Register a name with an alpha conversion table to ensure that when later
+ we call newAlphaName we do not end up generating this one<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdocAlphaTable"></a>docAlphaTable : <code class="type">unit -><br> (string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Split the name in preparation for newAlphaName. The prefix returned is
+ used to index into the hashtable. The next result value is a separator
+ (either empty or the separator chosen to separate the original name from
+ the index)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALgetAlphaPrefix"></a>getAlphaPrefix : <code class="type">lookupname:string -> string</code></pre><pre><span class="keyword">val</span> <a name="VALundoAlphaChanges"></a>undoAlphaChanges : <code class="type">alphaTable:(string, 'a <a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> Pervasives.ref) Hashtbl.t -><br> undolist:'a <a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> list -> unit</code></pre><div class="info">
+Undo the changes to a table<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cfg.html b/cil/doc/api/Cfg.html
new file mode 100644
index 0000000..142de8a
--- /dev/null
+++ b/cil/doc/api/Cfg.html
@@ -0,0 +1,69 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Cillower.html">
+<link rel="next" href="Dataflow.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cfg</title>
+</head>
+<body>
+<div class="navbar"><a href="Cillower.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Dataflow.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Cfg.html">Cfg</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Cfg: <code class="code">sig</code> <a href="Cfg.html">..</a> <code class="code">end</code></pre>Code to compute the control-flow graph of a function or file.
+ This will fill in the <code class="code">preds</code> and <code class="code">succs</code> fields of <a href="Cil.html#TYPEstmt"><code class="code">Cil.stmt</code></a>
+<p>
+
+ This is required for several other extensions, such as <a href="Dataflow.html"><code class="code">Dataflow</code></a>.<br>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALcomputeFileCFG"></a>computeFileCFG : <code class="type"><a href="Cil.html#TYPEfile">Cil.file</a> -> unit</code></pre><div class="info">
+Compute the CFG for an entire file, by calling cfgFun on each function.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALclearFileCFG"></a>clearFileCFG : <code class="type"><a href="Cil.html#TYPEfile">Cil.file</a> -> unit</code></pre><div class="info">
+clear the sid, succs, and preds fields of each statement.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcfgFun"></a>cfgFun : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> int</code></pre><div class="info">
+Compute a control flow graph for fd. Stmts in fd have preds and succs
+ filled in<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALclearCFGinfo"></a>clearCFGinfo : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> unit</code></pre><div class="info">
+clear the sid, succs, and preds fields of each statment in a function<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintCfgChannel"></a>printCfgChannel : <code class="type">Pervasives.out_channel -> <a href="Cil.html#TYPEfundec">Cil.fundec</a> -> unit</code></pre><div class="info">
+print control flow graph (in dot form) for fundec to channel<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintCfgFilename"></a>printCfgFilename : <code class="type">string -> <a href="Cil.html#TYPEfundec">Cil.fundec</a> -> unit</code></pre><div class="info">
+Print control flow graph (in dot form) for fundec to file<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALstart_id"></a>start_id : <code class="type">int Pervasives.ref</code></pre><div class="info">
+Next statement id that will be assigned.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnodeList"></a>nodeList : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> list Pervasives.ref</code></pre><div class="info">
+All of the nodes in a file.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnumNodes"></a>numNodes : <code class="type">int Pervasives.ref</code></pre><div class="info">
+number of nodes in the CFG<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cil.cilPrinter.html b/cil/doc/api/Cil.cilPrinter.html
new file mode 100644
index 0000000..1b9511f
--- /dev/null
+++ b/cil/doc/api/Cil.cilPrinter.html
@@ -0,0 +1,118 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Cil.cilVisitor.html">
+<link rel="Up" href="Cil.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilPrinter</title>
+</head>
+<body>
+<div class="navbar"><a href="Cil.cilVisitor.html">Previous</a>
+&nbsp;<a href="Cil.html">Up</a>
+&nbsp;</div>
+<center><h1>Class type <a href="type_Cil.cilPrinter.html">Cil.cilPrinter</a></h1></center>
+<br>
+<pre><span class="keyword">class type</span> <a name="TYPEcilPrinter"></a>cilPrinter = <code class="code">object</code> <a href="Cil.cilPrinter.html">..</a> <code class="code">end</code></pre>A printer interface for CIL trees. Create instantiations of
+ this type by specializing the class <a href="Cil.defaultCilPrinterClass.html"><code class="code">Cil.defaultCilPrinterClass</code></a>.<br>
+<hr width="100%">
+<pre><span class="keyword">method</span> <a name="METHODpVDecl"></a>pVDecl : <code class="type">unit -> <a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Invoked for each variable declaration. Note that variable
+ declarations are all the <code class="code">GVar</code>, <code class="code">GVarDecl</code>, <code class="code">GFun</code>, all the <code class="code">varinfo</code>
+ in formals of function types, and the formals and locals for function
+ definitions.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpVar"></a>pVar : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Invoked on each variable use.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpLval"></a>pLval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Invoked on each lvalue occurrence<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpOffset"></a>pOffset : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Invoked on each offset occurrence. The second argument is the base.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpInstr"></a>pInstr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Invoked on each instruction occurrence.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpLabel"></a>pLabel : <code class="type">unit -> <a href="Cil.html#TYPElabel">label</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a label.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpStmt"></a>pStmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Control-flow statement. This is used by
+ <a href="Cil.html#VALprintGlobal"><code class="code">Cil.printGlobal</code></a> and by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODdStmt"></a>dStmt : <code class="type">Pervasives.out_channel -> int -> <a href="Cil.html#TYPEstmt">stmt</a> -> unit</code></pre><div class="info">
+Dump a control-flow statement to a file with a given indentation.
+ This is used by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODdBlock"></a>dBlock : <code class="type">Pervasives.out_channel -> int -> <a href="Cil.html#TYPEblock">block</a> -> unit</code></pre><div class="info">
+Dump a control-flow block to a file with a given indentation.
+ This is used by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpBlock"></a>pBlock : <code class="type">unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">method</span> <a name="METHODpBlock"></a>pBlock : <code class="type">unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a block.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpGlobal"></a>pGlobal : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Global (vars, types, etc.). This can be slow and is used only by
+ <a href="Cil.html#VALprintGlobal"><code class="code">Cil.printGlobal</code></a> but not by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODdGlobal"></a>dGlobal : <code class="type">Pervasives.out_channel -> <a href="Cil.html#TYPEglobal">global</a> -> unit</code></pre><div class="info">
+Dump a global to a file with a given indentation. This is used by
+ <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a><br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpFieldDecl"></a>pFieldDecl : <code class="type">unit -> <a href="Cil.html#TYPEfieldinfo">fieldinfo</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+A field declaration<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpType"></a>pType : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> option -> unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">method</span> <a name="METHODpAttr"></a>pAttr : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a> * bool</code></pre><div class="info">
+Attribute. Also return an indication whether this attribute must be
+ printed inside the __attribute__ list or not.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpAttrParam"></a>pAttrParam : <code class="type">unit -> <a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Attribute parameter<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpAttrs"></a>pAttrs : <code class="type">unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Attribute lists<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpLineDirective"></a>pLineDirective : <code class="type">?forcefile:bool -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a line-number. This is assumed to come always on an empty line.
+ If the forcefile argument is present and is true then the file name
+ will be printed always. Otherwise the file name is printed only if it
+ is different from the last time time this function is called. The last
+ file name is stored in a private field inside the cilPrinter object.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpStmtKind"></a>pStmtKind : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> -> unit -> <a href="Cil.html#TYPEstmtkind">stmtkind</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a statement kind. The code to be printed is given in the
+ <a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a> argument. The initial <a href="Cil.html#TYPEstmt"><code class="code">Cil.stmt</code></a> argument
+ records the statement which follows the one being printed;
+ <a href="Cil.defaultCilPrinterClass.html"><code class="code">Cil.defaultCilPrinterClass</code></a> uses this information to prettify
+ statement printing in certain special cases.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpExp"></a>pExp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print expressions<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODpInit"></a>pInit : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print initializers. This can be slow and is used by
+ <a href="Cil.html#VALprintGlobal"><code class="code">Cil.printGlobal</code></a> but not by <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a>.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODdInit"></a>dInit : <code class="type">Pervasives.out_channel -> int -> <a href="Cil.html#TYPEinit">init</a> -> unit</code></pre><div class="info">
+Dump a global to a file with a given indentation. This is used by
+ <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a><br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cil.cilVisitor.html b/cil/doc/api/Cil.cilVisitor.html
new file mode 100644
index 0000000..f8c6496
--- /dev/null
+++ b/cil/doc/api/Cil.cilVisitor.html
@@ -0,0 +1,125 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="next" href="Cil.cilPrinter.html">
+<link rel="Up" href="Cil.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilVisitor</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a href="Cil.html">Up</a>
+&nbsp;<a href="Cil.cilPrinter.html">Next</a>
+</div>
+<center><h1>Class type <a href="type_Cil.cilVisitor.html">Cil.cilVisitor</a></h1></center>
+<br>
+<pre><span class="keyword">class type</span> <a name="TYPEcilVisitor"></a>cilVisitor = <code class="code">object</code> <a href="Cil.cilVisitor.html">..</a> <code class="code">end</code></pre>A visitor interface for traversing CIL trees. Create instantiations of
+ this type by specializing the class <a href="Cil.nopCilVisitor.html"><code class="code">Cil.nopCilVisitor</code></a>. Each of the
+ specialized visiting functions can also call the <code class="code">queueInstr</code> to specify
+ that some instructions should be inserted before the current instruction
+ or statement. Use syntax like <code class="code">self#queueInstr</code> to call a method
+ associated with the current object.<br>
+<hr width="100%">
+<pre><span class="keyword">method</span> <a name="METHODvvdec"></a>vvdec : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked for each variable declaration. The subtrees to be traversed
+ are those corresponding to the type and attributes of the variable.
+ Note that variable declarations are all the <code class="code">GVar</code>, <code class="code">GVarDecl</code>, <code class="code">GFun</code>,
+ all the <code class="code">varinfo</code> in formals of function types, and the formals and
+ locals for function definitions. This means that the list of formals
+ in a function definition will be traversed twice, once as part of the
+ function type and second as part of the formals in a function
+ definition.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvvrbl"></a>vvrbl : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked on each variable use. Here only the <code class="code">SkipChildren</code> and
+ <code class="code">ChangeTo</code> actions make sense since there are no subtrees. Note that
+ the type and attributes of the variable are not traversed for a
+ variable use<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvexpr"></a>vexpr : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked on each expression occurrence. The subtrees are the
+ subexpressions, the types (for a <code class="code">Cast</code> or <code class="code">SizeOf</code> expression) or the
+ variable use.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvlval"></a>vlval : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked on each lvalue occurrence<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvoffs"></a>voffs : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked on each offset occurrence that is *not* as part
+ of an initializer list specification, i.e. in an lval or
+ recursively inside an offset.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvinitoffs"></a>vinitoffs : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked on each offset appearing in the list of a
+ CompoundInit initializer.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvinst"></a>vinst : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Invoked on each instruction occurrence. The <code class="code">ChangeTo</code> action can
+ replace this instruction with a list of instructions<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvstmt"></a>vstmt : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Cil.html#TYPEstmt">stmt</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Control-flow statement. The default <code class="code">DoChildren</code> action does not
+ create a new statement when the components change. Instead it updates
+ the contents of the original statement. This is done to preserve the
+ sharing with <code class="code">Goto</code> and <code class="code">Case</code> statements that point to the original
+ statement. If you use the <code class="code">ChangeTo</code> action then you should take care
+ of preserving that sharing yourself.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvblock"></a>vblock : <code class="type"><a href="Cil.html#TYPEblock">block</a> -> <a href="Cil.html#TYPEblock">block</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Block.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvfunc"></a>vfunc : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEfundec">fundec</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Function definition.
+ Replaced in place.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvglob"></a>vglob : <code class="type"><a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPEglobal">global</a> list <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Global (vars, types,
+ etc.)<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvinit"></a>vinit : <code class="type"><a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEinit">init</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Initializers for globals<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvtype"></a>vtype : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Use of some type. Note
+ that for structure/union
+ and enumeration types the
+ definition of the
+ composite type is not
+ visited. Use <code class="code">vglob</code> to
+ visit it.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvattr"></a>vattr : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Cil.html#TYPEattribute">attribute</a> list <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Attribute. Each attribute can be replaced by a list<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODvattrparam"></a>vattrparam : <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Cil.html#TYPEattrparam">attrparam</a> <a href="Cil.html#TYPEvisitAction">visitAction</a></code></pre><div class="info">
+Attribute parameters.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODqueueInstr"></a>queueInstr : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> list -> unit</code></pre><div class="info">
+Add here instructions while visiting to queue them to preceede the
+ current statement or instruction being processed. Use this method only
+ when you are visiting an expression that is inside a function body, or
+ a statement, because otherwise there will no place for the visitor to
+ place your instructions.<br>
+</div>
+<pre><span class="keyword">method</span> <a name="METHODunqueueInstr"></a>unqueueInstr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> list</code></pre><div class="info">
+Gets the queue of instructions and resets the queue. This is done
+ automatically for you when you visit statments.<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cil.defaultCilPrinterClass.html b/cil/doc/api/Cil.defaultCilPrinterClass.html
new file mode 100644
index 0000000..d859559
--- /dev/null
+++ b/cil/doc/api/Cil.defaultCilPrinterClass.html
@@ -0,0 +1,36 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Cil.nopCilVisitor.html">
+<link rel="next" href="Cil.plainCilPrinterClass.html">
+<link rel="Up" href="Cil.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.defaultCilPrinterClass</title>
+</head>
+<body>
+<div class="navbar"><a href="Cil.nopCilVisitor.html">Previous</a>
+&nbsp;<a href="Cil.html">Up</a>
+&nbsp;<a href="Cil.plainCilPrinterClass.html">Next</a>
+</div>
+<center><h1>Class <a href="type_Cil.defaultCilPrinterClass.html">Cil.defaultCilPrinterClass</a></h1></center>
+<br>
+<pre><span class="keyword">class</span> <a name="TYPEdefaultCilPrinterClass"></a>defaultCilPrinterClass : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><hr width="100%">
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cil.html b/cil/doc/api/Cil.html
new file mode 100644
index 0000000..f2e09c2
--- /dev/null
+++ b/cil/doc/api/Cil.html
@@ -0,0 +1,3337 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Stats.html">
+<link rel="next" href="Formatcil.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil</title>
+</head>
+<body>
+<div class="navbar"><a href="Stats.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Formatcil.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Cil.html">Cil</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Cil: <code class="code">sig</code> <a href="Cil.html">..</a> <code class="code">end</code></pre>CIL API Documentation. An html version of this document can be found at
+ http://manju.cs.berkeley.edu/cil.<br>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALinitCIL"></a>initCIL : <code class="type">unit -> unit</code></pre><div class="info">
+Call this function to perform some initialization. Call if after you have
+ set <a href="Cil.html#VALmsvcMode"><code class="code">Cil.msvcMode</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcilVersion"></a>cilVersion : <code class="type">string</code></pre><div class="info">
+This are the CIL version numbers. A CIL version is a number of the form
+ M.m.r (major, minor and release)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcilVersionMajor"></a>cilVersionMajor : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALcilVersionMinor"></a>cilVersionMinor : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALcilVersionRevision"></a>cilVersionRevision : <code class="type">int</code></pre><br>
+This module defines the abstract syntax of CIL. It also provides utility
+ functions for traversing the CIL data structures, and pretty-printing
+ them. The parser for both the GCC and MSVC front-ends can be invoked as
+ <code class="code">Frontc.parse: string -&gt; unit -&gt;</code> <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a>. This function must be given
+ the name of a preprocessed C file and will return the top-level data
+ structure that describes a whole source file. By default the parsing and
+ elaboration into CIL is done as for GCC source. If you want to use MSVC
+ source you must set the <a href="Cil.html#VALmsvcMode"><code class="code">Cil.msvcMode</code></a> to <code class="code">true</code> and must also invoke the
+ function <code class="code">Frontc.setMSVCMode: unit -&gt; unit</code>.<br>
+<br>
+<b>The Abstract Syntax of CIL</b><br>
+<br>
+The top-level representation of a CIL source file (and the result of the
+ parsing and elaboration). Its main contents is the list of global
+ declarations and definitions. You can iterate over the globals in a
+ <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> using the following iterators: <a href="Cil.html#VALmapGlobals"><code class="code">Cil.mapGlobals</code></a>,
+ <a href="Cil.html#VALiterGlobals"><code class="code">Cil.iterGlobals</code></a> and <a href="Cil.html#VALfoldGlobals"><code class="code">Cil.foldGlobals</code></a>. You can also use the
+ <a href="Cil.html#VALdummyFile"><code class="code">Cil.dummyFile</code></a> when you need a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> as a placeholder. For each
+ global item CIL stores the source location where it appears (using the
+ type <a href="Cil.html#TYPElocation"><code class="code">Cil.location</code></a>)<br>
+<br><code><span class="keyword">type</span> <a name="TYPEfile"></a><code class="type"></code>file = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>fileName&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The complete file name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>globals&nbsp;: <code class="type"><a href="Cil.html#TYPEglobal">global</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>List of globals as they will appear
+ in the printed file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>globinit&nbsp;: <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> option</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An optional global initializer function. This is a function where
+ you can put stuff that must be executed before the program is
+ started. This function, is conceptually at the end of the file,
+ although it is not part of the globals list. Use <a href="Cil.html#VALgetGlobInit"><code class="code">Cil.getGlobInit</code></a>
+ to create/get one.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>globinitcalled&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Whether the global initialization function is called in main. This
+ should always be false if there is no global initializer. When you
+ create a global initialization CIL will try to insert code in main
+ to call it. This will not happen if your file does not contain a
+ function called "main"</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Top-level representation of a C source file<br>
+</div>
+
+<pre><span class="keyword">type</span> <a name="TYPEcomment"></a><code class="type"></code>comment = <code class="type"><a href="Cil.html#TYPElocation">location</a> * string</code> </pre>
+
+<br>
+<b>Globals</b>. The main type for representing global declarations and
+ definitions. A list of these form a CIL file. The order of globals in the
+ file is generally important.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEglobal"></a><code class="type"></code>global = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GType</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypeinfo">typeinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A typedef. All uses of type names (through the <code class="code">TNamed</code> constructor)
+ must be preceded in the file by a definition of the name. The string
+ is the defined name and always not-empty.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GCompTag</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Defines a struct/union tag with some fields. There must be one of
+ these for each struct/union tag that you use (through the <code class="code">TComp</code>
+ constructor) since this is the only context in which the fields are
+ printed. Consequently nested structure tag definitions must be
+ broken into individual definitions with the innermost structure
+ defined first.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GCompTagDecl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Declares a struct/union tag. Use as a forward declaration. This is
+ printed without the fields.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GEnumTag</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEenuminfo">enuminfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Declares an enumeration tag with some fields. There must be one of
+ these for each enumeration tag that you use (through the <code class="code">TEnum</code>
+ constructor) since this is the only context in which the items are
+ printed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GEnumTagDecl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEenuminfo">enuminfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Declares an enumeration tag. Use as a forward declaration. This is
+ printed without the items.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GVarDecl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A variable declaration (not a definition). If the variable has a
+ function type then this is a prototype. There can be several
+ declarations and at most one definition for a given variable. If both
+ forms appear then they must share the same varinfo structure. A
+ prototype shares the varinfo with the fundec of the definition. Either
+ has storage Extern or there must be a definition in this file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GVar</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> * <a href="Cil.html#TYPEinitinfo">initinfo</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A variable definition. Can have an initializer. The initializer is
+ updateable so that you can change it without requiring to recreate
+ the list of globals. There can be at most one definition for a
+ variable in an entire program. Cannot have storage Extern or function
+ type.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GFun</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A function definition.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GAsm</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Global asm statement. These ones
+ can contain only a template</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GPragma</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Pragmas at top level. Use the same
+ syntax as attributes</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GText</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Some text (printed verbatim) at
+ top level. E.g., this way you can
+ put comments in the output.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+A global declaration or definition<br>
+</div>
+
+<br>
+<b>Types</b>. A C type is represented in CIL using the type <a href="Cil.html#TYPEtyp"><code class="code">Cil.typ</code></a>.
+ Among types we differentiate the integral types (with different kinds
+ denoting the sign and precision), floating point types, enumeration types,
+ array and pointer types, and function types. Every type is associated with
+ a list of attributes, which are always kept in sorted order. Use
+ <a href="Cil.html#VALaddAttribute"><code class="code">Cil.addAttribute</code></a> and <a href="Cil.html#VALaddAttributes"><code class="code">Cil.addAttributes</code></a> to construct list of
+ attributes. If you want to inspect a type, you should use
+ <a href="Cil.html#VALunrollType"><code class="code">Cil.unrollType</code></a> or <a href="Cil.html#VALunrollTypeDeep"><code class="code">Cil.unrollTypeDeep</code></a> to see through the uses of
+ named types.<br>
+<br>
+CIL is configured at build-time with the sizes and alignments of the
+ underlying compiler (GCC or MSVC). CIL contains functions that can compute
+ the size of a type (in bits) <a href="Cil.html#VALbitsSizeOf"><code class="code">Cil.bitsSizeOf</code></a>, the alignment of a type
+ (in bytes) <a href="Cil.html#VALalignOf_int"><code class="code">Cil.alignOf_int</code></a>, and can convert an offset into a start and
+ width (both in bits) using the function <a href="Cil.html#VALbitsOffset"><code class="code">Cil.bitsOffset</code></a>. At the moment
+ these functions do not take into account the <code class="code">packed</code> attributes and
+ pragmas.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEtyp"></a><code class="type"></code>typ = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TVoid</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Void type. Also predefined as <a href="Cil.html#VALvoidType"><code class="code">Cil.voidType</code></a></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TInt</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEikind">ikind</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An integer type. The kind specifies the sign and width. Several
+ useful variants are predefined as <a href="Cil.html#VALintType"><code class="code">Cil.intType</code></a>, <a href="Cil.html#VALuintType"><code class="code">Cil.uintType</code></a>,
+ <a href="Cil.html#VALlongType"><code class="code">Cil.longType</code></a>, <a href="Cil.html#VALcharType"><code class="code">Cil.charType</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TFloat</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEfkind">fkind</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A floating-point type. The kind specifies the precision. You can
+ also use the predefined constant <a href="Cil.html#VALdoubleType"><code class="code">Cil.doubleType</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TPtr</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Pointer type. Several useful variants are predefined as
+ <a href="Cil.html#VALcharPtrType"><code class="code">Cil.charPtrType</code></a>, <a href="Cil.html#VALcharConstPtrType"><code class="code">Cil.charConstPtrType</code></a> (pointer to a
+ constant character), <a href="Cil.html#VALvoidPtrType"><code class="code">Cil.voidPtrType</code></a>,
+ <a href="Cil.html#VALintPtrType"><code class="code">Cil.intPtrType</code></a></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TArray</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEexp">exp</a> option * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Array type. It indicates the base type and the array length.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TFun</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option * bool<br> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Function type. Indicates the type of the result, the name, type
+ and name attributes of the formal arguments (<code class="code">None</code> if no
+ arguments were specified, as in a function whose definition or
+ prototype we have not seen; <code class="code">Some []</code> means void). Use
+ <a href="Cil.html#VALargsToList"><code class="code">Cil.argsToList</code></a> to obtain a list of arguments. The boolean
+ indicates if it is a variable-argument function. If this is the
+ type of a varinfo for which we have a function declaration then
+ the information for the formals must match that in the
+ function's sformals. Use <a href="Cil.html#VALsetFormals"><code class="code">Cil.setFormals</code></a>, or
+ <a href="Cil.html#VALsetFunctionType"><code class="code">Cil.setFunctionType</code></a>, or <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a> for this
+ purpose.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TNamed</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypeinfo">typeinfo</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TComp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The most delicate issue for C types is that recursion that is possible by
+ using structures and pointers. To address this issue we have a more
+ complex representation for structured types (struct and union). Each such
+ type is represented using the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> type. For each composite
+ type the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> structure must be declared at top level using
+ <code class="code">GCompTag</code> and all references to it must share the same copy of the
+ structure. The attributes given are those pertaining to this use of the
+ type and are in addition to the attributes that were given at the
+ definition of the type and which are stored in the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TEnum</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEenuminfo">enuminfo</a> * <a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A reference to an enumeration type. All such references must
+ share the enuminfo among them and with a <code class="code">GEnumTag</code> global that
+ precedes all uses. The attributes refer to this use of the
+ enumeration and are in addition to the attributes of the
+ enumeration itself, which are stored inside the enuminfo</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TBuiltin_va_list</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This is the same as the gcc's type with the same name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+
+<br>
+There are a number of functions for querying the kind of a type. These are
+ <a href="Cil.html#VALisIntegralType"><code class="code">Cil.isIntegralType</code></a>,
+ <a href="Cil.html#VALisArithmeticType"><code class="code">Cil.isArithmeticType</code></a>,
+ <a href="Cil.html#VALisPointerType"><code class="code">Cil.isPointerType</code></a>,
+ <a href="Cil.html#VALisFunctionType"><code class="code">Cil.isFunctionType</code></a>,
+ <a href="Cil.html#VALisArrayType"><code class="code">Cil.isArrayType</code></a>.
+<p>
+
+ There are two easy ways to scan a type. First, you can use the
+<a href="Cil.html#VALexistsType"><code class="code">Cil.existsType</code></a> to return a boolean answer about a type. This function
+is controlled by a user-provided function that is queried for each type that is
+used to construct the current type. The function can specify whether to
+terminate the scan with a boolean result or to continue the scan for the
+nested types.
+<p>
+
+ The other method for scanning types is provided by the visitor interface (see
+ <a href="Cil.cilVisitor.html"><code class="code">Cil.cilVisitor</code></a>).
+<p>
+
+ If you want to compare types (or to use them as hash-values) then you should
+use instead type signatures (represented as <a href="Cil.html#TYPEtypsig"><code class="code">Cil.typsig</code></a>). These
+contain the same information as types but canonicalized such that simple Ocaml
+structural equality will tell whether two types are equal. Use
+<a href="Cil.html#VALtypeSig"><code class="code">Cil.typeSig</code></a> to compute the signature of a type. If you want to ignore
+certain type attributes then use <a href="Cil.html#VALtypeSigWithAttrs"><code class="code">Cil.typeSigWithAttrs</code></a>.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEikind"></a><code class="type"></code>ikind = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IChar</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">char</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ISChar</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">signed char</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IUChar</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned char</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IInt</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">int</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IUInt</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned int</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IShort</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">short</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IUShort</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned short</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ILong</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">long</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IULong</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned long</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ILongLong</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">long long</code> (or <code class="code">_int64</code> on Microsoft Visual C)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IULongLong</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">unsigned long long</code> (or <code class="code">unsigned _int64</code> on Microsoft
+ Visual C)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Various kinds of integers<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEfkind"></a><code class="type"></code>fkind = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FFloat</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">float</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FDouble</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">double</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FLongDouble</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code><code class="code">long double</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Various kinds of floating-point numbers<br>
+</div>
+
+<br>
+<b>Attributes.</b><br>
+<br><code><span class="keyword">type</span> <a name="TYPEattribute"></a><code class="type"></code>attribute = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Attr</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEattrparam">attrparam</a> list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An attribute has a name and some optional parameters. The name should not
+ start or end with underscore. When CIL parses attribute names it will
+ strip leading and ending underscores (to ensure that the multitude of GCC
+ attributes such as const, __const and __const__ all mean the same thing.)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+
+<pre><span class="keyword">type</span> <a name="TYPEattributes"></a><code class="type"></code>attributes = <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list</code> </pre>
+<div class="info">
+Attributes are lists sorted by the attribute name. Use the functions
+ <a href="Cil.html#VALaddAttribute"><code class="code">Cil.addAttribute</code></a> and <a href="Cil.html#VALaddAttributes"><code class="code">Cil.addAttributes</code></a> to insert attributes in an
+ attribute list and maintain the sortedness.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEattrparam"></a><code class="type"></code>attrparam = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AInt</span> <span class="keyword">of</span> <code class="type">int</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An integer constant</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AStr</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A string constant</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ACons</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEattrparam">attrparam</a> list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Constructed attributes. These
+ are printed <code class="code">foo(a1,a2,...,an)</code>.
+ The list of parameters can be
+ empty and in that case the
+ parentheses are not printed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ASizeOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A way to talk about types</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ASizeOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ASizeOfS</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Replacement for ASizeOf in type
+ signatures. Only used for
+ attributes inside typsigs.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AAlignOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AAlignOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AAlignOfS</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AUnOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEunop">unop</a> * <a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ABinOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEbinop">binop</a> * <a href="Cil.html#TYPEattrparam">attrparam</a> * <a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ADot</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a> * string</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>a.foo *</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+The type of parameters of attributes<br>
+</div>
+
+<br>
+<b>Structures.</b> The <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> describes the definition of a
+ structure or union type. Each such <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> must be defined at the
+ top-level using the <code class="code">GCompTag</code> constructor and must be shared by all
+ references to this type (using either the <code class="code">TComp</code> type constructor or from
+ the definition of the fields.
+<p>
+
+ If all you need is to scan the definition of each
+ composite type once, you can do that by scanning all top-level <code class="code">GCompTag</code>.
+<p>
+
+ Constructing a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> can be tricky since it must contain fields
+ that might refer to the host <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> and furthermore the type of
+ the field might need to refer to the <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> for recursive types.
+ Use the <a href="Cil.html#VALmkCompInfo"><code class="code">Cil.mkCompInfo</code></a> function to create a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a>. You can
+ easily fetch the <a href="Cil.html#TYPEfieldinfo"><code class="code">Cil.fieldinfo</code></a> for a given field in a structure with
+ <a href="Cil.html#VALgetCompField"><code class="code">Cil.getCompField</code></a>.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEcompinfo"></a><code class="type"></code>compinfo = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>cstruct&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if struct, False if union</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>cname&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name. Always non-empty. Use <a href="Cil.html#VALcompFullName"><code class="code">Cil.compFullName</code></a> to get the full
+ name of a comp (along with the struct or union)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>ckey&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A unique integer. This is assigned by <a href="Cil.html#VALmkCompInfo"><code class="code">Cil.mkCompInfo</code></a> using a
+ global variable in the Cil module. Thus two identical structs in two
+ different files might have different keys. Use <a href="Cil.html#VALcopyCompInfo"><code class="code">Cil.copyCompInfo</code></a> to
+ copy structures so that a new key is assigned.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>cfields&nbsp;: <code class="type"><a href="Cil.html#TYPEfieldinfo">fieldinfo</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Information about the fields. Notice that each fieldinfo has a
+ pointer back to the host compinfo. This means that you should not
+ share fieldinfo's between two compinfo's</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>cattr&nbsp;: <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The attributes that are defined at the same time as the composite
+ type. These attributes can be supplemented individually at each
+ reference to this <code class="code">compinfo</code> using the <code class="code">TComp</code> type constructor.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>cdefined&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This boolean flag can be used to distinguish between structures
+ that have not been defined and those that have been defined but have
+ no fields (such things are allowed in gcc).</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>creferenced&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if used. Initially set to false.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+The definition of a structure or union type. Use <a href="Cil.html#VALmkCompInfo"><code class="code">Cil.mkCompInfo</code></a> to
+ make one and use <a href="Cil.html#VALcopyCompInfo"><code class="code">Cil.copyCompInfo</code></a> to copy one (this ensures that a new
+ key is assigned and that the fields have the right pointers to parents.).<br>
+</div>
+
+<br>
+<b>Structure fields.</b> The <a href="Cil.html#TYPEfieldinfo"><code class="code">Cil.fieldinfo</code></a> structure is used to describe
+ a structure or union field. Fields, just like variables, can have
+ attributes associated with the field itself or associated with the type of
+ the field (stored along with the type of the field).<br>
+<br><code><span class="keyword">type</span> <a name="TYPEfieldinfo"></a><code class="type"></code>fieldinfo = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>fcomp&nbsp;: <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The host structure that contains this field. There can be only one
+ <code class="code">compinfo</code> that contains the field.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>fname&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name of the field. Might be the value of <a href="Cil.html#VALmissingFieldName"><code class="code">Cil.missingFieldName</code></a>
+ in which case it must be a bitfield and is not printed and it does not
+ participate in initialization</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>ftype&nbsp;: <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>fbitfield&nbsp;: <code class="type">int option</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>If a bitfield then ftype should be an integer type and the width of
+ the bitfield must be 0 or a positive integer smaller or equal to the
+ width of the integer type. A field of width 0 is used in C to control
+ the alignment of fields.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>fattr&nbsp;: <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The attributes for this field (not for its type)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>floc&nbsp;: <code class="type"><a href="Cil.html#TYPElocation">location</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The location where this field is defined</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Information about a struct/union field<br>
+</div>
+
+<br>
+<b>Enumerations.</b> Information about an enumeration. This is shared by all
+ references to an enumeration. Make sure you have a <code class="code">GEnumTag</code> for each of
+ of these.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEenuminfo"></a><code class="type"></code>enuminfo = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>ename&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name. Always non-empty.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>eitems&nbsp;: <code class="type">(string * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPElocation">location</a>) list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Items with names and values. This list should be non-empty. The item
+ values must be compile-time constants.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>eattr&nbsp;: <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The attributes that are defined at the same time as the enumeration
+ type. These attributes can be supplemented individually at each
+ reference to this <code class="code">enuminfo</code> using the <code class="code">TEnum</code> type constructor.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>ereferenced&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if used. Initially set to false</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Information about an enumeration<br>
+</div>
+
+<br>
+<b>Enumerations.</b> Information about an enumeration. This is shared by all
+ references to an enumeration. Make sure you have a <code class="code">GEnumTag</code> for each of
+ of these.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEtypeinfo"></a><code class="type"></code>typeinfo = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>tname&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name. Can be empty only in a <code class="code">GType</code> when introducing a composite
+ or enumeration tag. If empty cannot be referred to from the file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>ttype&nbsp;: <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The actual type. This includes the attributes that were present in
+ the typedef</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>treferenced&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if used. Initially set to false</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Information about a defined type<br>
+</div>
+
+<br>
+<b>Variables.</b>
+ Each local or global variable is represented by a unique <a href="Cil.html#TYPEvarinfo"><code class="code">Cil.varinfo</code></a>
+structure. A global <a href="Cil.html#TYPEvarinfo"><code class="code">Cil.varinfo</code></a> can be introduced with the <code class="code">GVarDecl</code> or
+<code class="code">GVar</code> or <code class="code">GFun</code> globals. A local varinfo can be introduced as part of a
+function definition <a href="Cil.html#TYPEfundec"><code class="code">Cil.fundec</code></a>.
+<p>
+
+ All references to a given global or local variable must refer to the same
+copy of the <code class="code">varinfo</code>. Each <code class="code">varinfo</code> has a globally unique identifier that
+can be used to index maps and hashtables (the name can also be used for this
+purpose, except for locals from different functions). This identifier is
+constructor using a global counter.
+<p>
+
+ It is very important that you construct <code class="code">varinfo</code> structures using only one
+ of the following functions:<ul>
+<li><a href="Cil.html#VALmakeGlobalVar"><code class="code">Cil.makeGlobalVar</code></a> : to make a global variable</li>
+<li><a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a> : to make a temporary local variable whose name
+will be generated so that to avoid conflict with other locals. </li>
+<li><a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> : like <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a> but you can specify the
+exact name to be used. </li>
+<li><a href="Cil.html#VALcopyVarinfo"><code class="code">Cil.copyVarinfo</code></a>: make a shallow copy of a varinfo assigning a new name
+and a new unique identifier</li>
+</ul>
+
+ A <code class="code">varinfo</code> is also used in a function type to denote the list of formals.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEvarinfo"></a><code class="type"></code>varinfo = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vname&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name of the variable. Cannot be empty. It is primarily your
+ responsibility to ensure the uniqueness of a variable name. For local
+ variables <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a> helps you ensure that the name is unique.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vtype&nbsp;: <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The declared type of the variable.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vattr&nbsp;: <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A list of attributes associated with the variable.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vstorage&nbsp;: <code class="type"><a href="Cil.html#TYPEstorage">storage</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The storage-class</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vglob&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if this is a global variable</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vinline&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Whether this varinfo is for an inline function.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vdecl&nbsp;: <code class="type"><a href="Cil.html#TYPElocation">location</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Location of variable declaration.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vid&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A unique integer identifier. This field will be
+ set for you if you use one of the <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a>,
+ <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a>, <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>, <a href="Cil.html#VALmakeGlobalVar"><code class="code">Cil.makeGlobalVar</code></a>, or
+ <a href="Cil.html#VALcopyVarinfo"><code class="code">Cil.copyVarinfo</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vaddrof&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if the address of this variable is taken. CIL will set these
+ flags when it parses C, but you should make sure to set the flag
+ whenever your transformation create <code class="code">AddrOf</code> expression.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>vreferenced&nbsp;: <code class="type">bool</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>True if this variable is ever referenced. This is computed by
+ <code class="code">removeUnusedVars</code>. It is safe to just initialize this to False</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Information about a variable.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEstorage"></a><code class="type"></code>storage = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">NoStorage</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default storage. Nothing is printed</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Static</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Register</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Extern</span></code></td>
+
+</tr></table>
+
+<div class="info">
+Storage-class information<br>
+</div>
+
+<br>
+<b>Expressions.</b> The CIL expression language contains only the side-effect free expressions of
+C. They are represented as the type <a href="Cil.html#TYPEexp"><code class="code">Cil.exp</code></a>. There are several
+interesting aspects of CIL expressions:
+<p>
+
+ Integer and floating point constants can carry their textual representation.
+This way the integer 15 can be printed as 0xF if that is how it occurred in the
+source.
+<p>
+
+ CIL uses 64 bits to represent the integer constants and also stores the width
+of the integer type. Care must be taken to ensure that the constant is
+representable with the given width. Use the functions <a href="Cil.html#VALkinteger"><code class="code">Cil.kinteger</code></a>,
+<a href="Cil.html#VALkinteger64"><code class="code">Cil.kinteger64</code></a> and <a href="Cil.html#VALinteger"><code class="code">Cil.integer</code></a> to construct constant
+expressions. CIL predefines the constants <a href="Cil.html#VALzero"><code class="code">Cil.zero</code></a>,
+<a href="Cil.html#VALone"><code class="code">Cil.one</code></a> and <a href="Cil.html#VALmone"><code class="code">Cil.mone</code></a> (for -1).
+<p>
+
+ Use the functions <a href="Cil.html#VALisConstant"><code class="code">Cil.isConstant</code></a> and <a href="Cil.html#VALisInteger"><code class="code">Cil.isInteger</code></a> to test if
+an expression is a constant and a constant integer respectively.
+<p>
+
+ CIL keeps the type of all unary and binary expressions. You can think of that
+type qualifying the operator. Furthermore there are different operators for
+arithmetic and comparisons on arithmetic types and on pointers.
+<p>
+
+ Another unusual aspect of CIL is that the implicit conversion between an
+expression of array type and one of pointer type is made explicit, using the
+<code class="code">StartOf</code> expression constructor (which is not printed). If you apply the
+<code class="code">AddrOf}</code>constructor to an lvalue of type <code class="code">T</code> then you will be getting an
+expression of type <code class="code">TPtr(T)</code>.
+<p>
+
+ You can find the type of an expression with <a href="Cil.html#VALtypeOf"><code class="code">Cil.typeOf</code></a>.
+<p>
+
+ You can perform constant folding on expressions using the function
+<a href="Cil.html#VALconstFold"><code class="code">Cil.constFold</code></a>.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEexp"></a><code class="type"></code>exp = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Const</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEconstant">constant</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Constant</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Lval</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Lvalue</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SizeOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>sizeof(&lt;type&gt;). Has <code class="code">unsigned int</code> type (ISO 6.5.3.4). This is not
+ turned into a constant because some transformations might want to
+ change types</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SizeOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>sizeof(&lt;expression&gt;)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SizeOfStr</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>sizeof(string_literal). We separate this case out because this is the
+ only instance in which a string literal should not be treated as
+ having type pointer to character.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AlignOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This corresponds to the GCC __alignof_. Has <code class="code">unsigned int</code> type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AlignOfE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">UnOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEunop">unop</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Unary operation. Includes the type of the result.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">BinOp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEbinop">binop</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Binary operation. Includes the type of the result. The arithmetic
+ conversions are made explicit for the arguments.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CastE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEexp">exp</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Use <a href="Cil.html#VALmkCast"><code class="code">Cil.mkCast</code></a> to make casts.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AddrOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Always use <a href="Cil.html#VALmkAddrOf"><code class="code">Cil.mkAddrOf</code></a> to construct one of these. Apply to an
+ lvalue of type <code class="code">T</code> yields an expression of type <code class="code">TPtr(T)</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">StartOf</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Conversion from an array to a pointer to the beginning of the array.
+ Given an lval of type <code class="code">TArray(T)</code> produces an expression of type
+ <code class="code">TPtr(T)</code>. In C this operation is implicit, the <code class="code">StartOf</code> operator is
+ not printed. We have it in CIL because it makes the typing rules
+ simpler.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Expressions (Side-effect free)<br>
+</div>
+
+<br>
+<b>Constants.</b><br>
+<br><code><span class="keyword">type</span> <a name="TYPEconstant"></a><code class="type"></code>constant = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CInt64</span> <span class="keyword">of</span> <code class="type">int64 * <a href="Cil.html#TYPEikind">ikind</a> * string option</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Integer constant. Give the ikind (see ISO9899 6.1.3.2) and the
+ textual representation, if available. (This allows us to print a
+ constant as, for example, 0xF instead of 15.) Use <a href="Cil.html#VALinteger"><code class="code">Cil.integer</code></a> or
+ <a href="Cil.html#VALkinteger"><code class="code">Cil.kinteger</code></a> to create these. Watch out for integers that cannot be
+ represented on 64 bits. OCAML does not give Overflow exceptions.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CStr</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CWStr</span> <span class="keyword">of</span> <code class="type">int64 list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CChr</span> <span class="keyword">of</span> <code class="type">char</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Character constant. This has type int, so use charConstToInt
+ to read the value in case sign-extension is needed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CReal</span> <span class="keyword">of</span> <code class="type">float * <a href="Cil.html#TYPEfkind">fkind</a> * string option</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Floating point constant. Give the fkind (see ISO 6.4.4.2) and also
+ the textual representation, if available.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CEnum</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * string * <a href="Cil.html#TYPEenuminfo">enuminfo</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An enumeration constant with the given value, name, from the given
+ enuminfo. This is used only if <a href="Cil.html#VALlowerConstants"><code class="code">Cil.lowerConstants</code></a> is true
+ (default). Use <a href="Cil.html#VALconstFoldVisitor"><code class="code">Cil.constFoldVisitor</code></a> to replace these with integer
+ constants.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Literal constants<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEunop"></a><code class="type"></code>unop = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Neg</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Unary minus</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">BNot</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Bitwise complement (~)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">LNot</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Logical Not (!)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Unary operators<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEbinop"></a><code class="type"></code>binop = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">PlusA</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>arithmetic +</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">PlusPI</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer + integer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">IndexPI</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer + integer but only when
+ it arises from an expression
+ <code class="code">e[i]</code> when <code class="code">e</code> is a pointer and
+ not an array. This is semantically
+ the same as PlusPI but CCured uses
+ this as a hint that the integer is
+ probably positive.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">MinusA</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>arithmetic -</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">MinusPI</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer - integer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">MinusPP</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>pointer - pointer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Mult</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Div</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>/</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Mod</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>%</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Shiftlt</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>shift left</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Shiftrt</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>shift right</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Lt</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>&lt; (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Gt</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>&gt; (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Le</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>&lt;= (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Ge</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>&gt; (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Eq</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>== (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Ne</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>!= (arithmetic comparison)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">BAnd</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>bitwise and</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">BXor</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>exclusive-or</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">BOr</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>inclusive-or</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">LAnd</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>logical and. Unlike other
+ expressions this one does not
+ always evaluate both operands. If
+ you want to use these, you must
+ set <a href="Cil.html#VALuseLogicalOperators"><code class="code">Cil.useLogicalOperators</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">LOr</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>logical or. Unlike other
+ expressions this one does not
+ always evaluate both operands. If
+ you want to use these, you must
+ set <a href="Cil.html#VALuseLogicalOperators"><code class="code">Cil.useLogicalOperators</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Binary operations<br>
+</div>
+
+<br>
+<b>Lvalues.</b> Lvalues are the sublanguage of expressions that can appear at the left of an assignment or as operand to the address-of operator.
+In C the syntax for lvalues is not always a good indication of the meaning
+of the lvalue. For example the C value
+<pre>
+a[0][1][2]
+</pre>
+ might involve 1, 2 or 3 memory reads when used in an expression context,
+depending on the declared type of the variable <code class="code">a</code>. If <code class="code">a</code> has type <code class="code">int
+[4][4][4]</code> then we have one memory read from somewhere inside the area
+that stores the array <code class="code">a</code>. On the other hand if <code class="code">a</code> has type <code class="code">int ***</code> then
+the expression really means <code class="code">* ( * ( * (a + 0) + 1) + 2)</code>, in which case it is
+clear that it involves three separate memory operations.
+<p>
+
+An lvalue denotes the contents of a range of memory addresses. This range
+is denoted as a host object along with an offset within the object. The
+host object can be of two kinds: a local or global variable, or an object
+whose address is in a pointer expression. We distinguish the two cases so
+that we can tell quickly whether we are accessing some component of a
+variable directly or we are accessing a memory location through a pointer.
+To make it easy to
+tell what an lvalue means CIL represents lvalues as a host object and an
+offset (see <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>). The host object (represented as
+<a href="Cil.html#TYPElhost"><code class="code">Cil.lhost</code></a>) can be a local or global variable or can be the object
+pointed-to by a pointer expression. The offset (represented as
+<a href="Cil.html#TYPEoffset"><code class="code">Cil.offset</code></a>) is a sequence of field or array index designators.
+<p>
+
+ Both the typing rules and the meaning of an lvalue is very precisely
+specified in CIL.
+<p>
+
+ The following are a few useful function for operating on lvalues:<ul>
+<li><a href="Cil.html#VALmkMem"><code class="code">Cil.mkMem</code></a> - makes an lvalue of <code class="code">Mem</code> kind. Use this to ensure
+that certain equivalent forms of lvalues are canonized.
+For example, <code class="code">*&amp;x = x</code>. </li>
+<li><a href="Cil.html#VALtypeOfLval"><code class="code">Cil.typeOfLval</code></a> - the type of an lvalue</li>
+<li><a href="Cil.html#VALtypeOffset"><code class="code">Cil.typeOffset</code></a> - the type of an offset, given the type of the
+host. </li>
+<li><a href="Cil.html#VALaddOffset"><code class="code">Cil.addOffset</code></a> and <a href="Cil.html#VALaddOffsetLval"><code class="code">Cil.addOffsetLval</code></a> - extend sequences
+of offsets.</li>
+<li><a href="Cil.html#VALremoveOffset"><code class="code">Cil.removeOffset</code></a> and <a href="Cil.html#VALremoveOffsetLval"><code class="code">Cil.removeOffsetLval</code></a> - shrink sequences
+of offsets.</li>
+</ul>
+
+The following equivalences hold <pre>
+Mem(AddrOf(Mem a, aoff)), off = Mem a, aoff + off
+Mem(AddrOf(Var v, aoff)), off = Var v, aoff + off
+AddrOf (Mem a, NoOffset) = a
+</pre><br>
+<pre><span class="keyword">type</span> <a name="TYPElval"></a><code class="type"></code>lval = <code class="type"><a href="Cil.html#TYPElhost">lhost</a> * <a href="Cil.html#TYPEoffset">offset</a></code> </pre>
+<div class="info">
+An lvalue<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPElhost"></a><code class="type"></code>lhost = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Var</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The host is a variable.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Mem</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The host is an object of type <code class="code">T</code> when the expression has pointer
+ <code class="code">TPtr(T)</code>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+The host part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEoffset"></a><code class="type"></code>offset = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">NoOffset</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>No offset. Can be applied to any lvalue and does
+ not change either the starting address or the type.
+ This is used when the lval consists of just a host
+ or as a terminator in a list of other kinds of
+ offsets.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Field</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEfieldinfo">fieldinfo</a> * <a href="Cil.html#TYPEoffset">offset</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A field offset. Can be applied only to an lvalue
+ that denotes a structure or a union that contains
+ the mentioned field. This advances the offset to the
+ beginning of the mentioned field and changes the
+ type to the type of the mentioned field.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Index</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEoffset">offset</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An array index offset. Can be applied only to an
+ lvalue that denotes an array. This advances the
+ starting address of the lval to the beginning of the
+ mentioned array element and changes the denoted type
+ to be the type of the array element</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+The offset part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>. Each offset can be applied to certain
+ kinds of lvalues and its effect is that it advances the starting address
+ of the lvalue and changes the denoted type, essentially focusing to some
+ smaller lvalue that is contained in the original one.<br>
+</div>
+
+<br>
+<b>Initializers.</b>
+A special kind of expressions are those that can appear as initializers for
+global variables (initialization of local variables is turned into
+assignments). The initializers are represented as type <a href="Cil.html#TYPEinit"><code class="code">Cil.init</code></a>. You
+can create initializers with <a href="Cil.html#VALmakeZeroInit"><code class="code">Cil.makeZeroInit</code></a> and you can conveniently
+scan compound initializers them with <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> or with <a href="Cil.html#VALfoldLeftCompoundAll"><code class="code">Cil.foldLeftCompoundAll</code></a>.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEinit"></a><code class="type"></code>init = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SingleInit</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A single initializer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CompoundInit</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a> * (<a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEinit">init</a>) list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Used only for initializers of structures, unions and arrays. The
+ offsets are all of the form <code class="code">Field(f, NoOffset)</code> or <code class="code">Index(i,
+ NoOffset)</code> and specify the field or the index being initialized. For
+ structures all fields must have an initializer (except the unnamed
+ bitfields), in the proper order. This is necessary since the offsets
+ are not printed. For unions there must be exactly one initializer. If
+ the initializer is not for the first field then a field designator is
+ printed, so you better be on GCC since MSVC does not understand this.
+ For arrays, however, we allow you to give only a prefix of the
+ initializers. You can scan an initializer list with
+ <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> or with <a href="Cil.html#VALfoldLeftCompoundAll"><code class="code">Cil.foldLeftCompoundAll</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Initializers for global variables.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEinitinfo"></a><code class="type"></code>initinfo = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>init&nbsp;: <code class="type"><a href="Cil.html#TYPEinit">init</a> option</code>;</code></td>
+
+</tr></table>
+}
+
+<div class="info">
+We want to be able to update an initializer in a global variable, so we
+ define it as a mutable field<br>
+</div>
+
+<br>
+<b>Function definitions.</b>
+A function definition is always introduced with a <code class="code">GFun</code> constructor at the
+top level. All the information about the function is stored into a
+<a href="Cil.html#TYPEfundec"><code class="code">Cil.fundec</code></a>. Some of the information (e.g. its name, type,
+storage, attributes) is stored as a <a href="Cil.html#TYPEvarinfo"><code class="code">Cil.varinfo</code></a> that is a field of the
+<code class="code">fundec</code>. To refer to the function from the expression language you must use
+the <code class="code">varinfo</code>.
+<p>
+
+ The function definition contains, in addition to the body, a list of all the
+local variables and separately a list of the formals. Both kind of variables
+can be referred to in the body of the function. The formals must also be shared
+with the formals that appear in the function type. For that reason, to
+manipulate formals you should use the provided functions
+<a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a> and <a href="Cil.html#VALsetFormals"><code class="code">Cil.setFormals</code></a> and <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a>.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEfundec"></a><code class="type"></code>fundec = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>svar&nbsp;: <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Holds the name and type as a variable, so we can refer to it
+ easily from the program. All references to this function either
+ in a function call or in a prototype must point to the same
+ <code class="code">varinfo</code>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>sformals&nbsp;: <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Formals. These must be in the same order and with the same
+ information as the formal information in the type of the function.
+ Use <a href="Cil.html#VALsetFormals"><code class="code">Cil.setFormals</code></a> or
+ <a href="Cil.html#VALsetFunctionType"><code class="code">Cil.setFunctionType</code></a> or <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a>
+ to set these formals and ensure that they
+ are reflected in the function type. Do not make copies of these
+ because the body refers to them.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>slocals&nbsp;: <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Locals. Does NOT include the sformals. Do not make copies of
+ these because the body refers to them.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>smaxid&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Max local id. Starts at 0. Used for
+ creating the names of new temporary
+ variables. Updated by
+ <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> and
+ <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>. You can also use
+ <a href="Cil.html#VALsetMaxId"><code class="code">Cil.setMaxId</code></a> to set it after you
+ have added the formals and locals.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>sbody&nbsp;: <code class="type"><a href="Cil.html#TYPEblock">block</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The function body.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>smaxstmtid&nbsp;: <code class="type">int option</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>max id of a (reachable) statement
+ in this function, if we have
+ computed it. range = 0 ...
+ (smaxstmtid-1). This is computed by
+ <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>sallstmts&nbsp;: <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>After you call <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>
+ this field is set to contain all
+ statements in the function</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Function definitions.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEblock"></a><code class="type"></code>block = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>battrs&nbsp;: <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attributes for the block</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>bstmts&nbsp;: <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The statements comprising the block</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+A block is a sequence of statements with the control falling through from
+ one element to the next<br>
+</div>
+
+<br>
+<b>Statements</b>.
+CIL statements are the structural elements that make the CFG. They are
+represented using the type <a href="Cil.html#TYPEstmt"><code class="code">Cil.stmt</code></a>. Every
+statement has a (possibly empty) list of labels. The
+<a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a> field of a statement indicates what kind of statement it
+is.
+<p>
+
+ Use <a href="Cil.html#VALmkStmt"><code class="code">Cil.mkStmt</code></a> to make a statement and the fill-in the fields.
+<p>
+
+CIL also comes with support for control-flow graphs. The <code class="code">sid</code> field in
+<code class="code">stmt</code> can be used to give unique numbers to statements, and the <code class="code">succs</code>
+and <code class="code">preds</code> fields can be used to maintain a list of successors and
+predecessors for every statement. The CFG information is not computed by
+default. Instead you must explicitly use the functions
+<a href="Cil.html#VALprepareCFG"><code class="code">Cil.prepareCFG</code></a> and <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a> to do it.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEstmt"></a><code class="type"></code>stmt = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>labels&nbsp;: <code class="type"><a href="Cil.html#TYPElabel">label</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Whether the statement starts with some labels, case statements or
+ default statements.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>skind&nbsp;: <code class="type"><a href="Cil.html#TYPEstmtkind">stmtkind</a></code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The kind of statement</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>sid&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A number (&gt;= 0) that is unique in a function. Filled in only after
+ the CFG is computed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>succs&nbsp;: <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The successor statements. They can always be computed from the skind
+ and the context in which this statement appears. Filled in only after
+ the CFG is computed.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span class="keyword">mutable&nbsp;</span>preds&nbsp;: <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The inverse of the succs function.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Statements.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPElabel"></a><code class="type"></code>label = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Label</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPElocation">location</a> * bool</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A real label. If the bool is "true", the label is from the
+ input source program. If the bool is "false", the label was
+ created by CIL or some other transformation</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Case</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A case statement. This expression
+ is lowered into a constant if
+ <a href="Cil.html#VALlowerConstants"><code class="code">Cil.lowerConstants</code></a> is set to
+ true.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Default</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A default statement</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Labels<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEstmtkind"></a><code class="type"></code>stmtkind = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Instr</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEinstr">instr</a> list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A group of instructions that do not contain control flow. Control
+ implicitly falls through.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Return</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> option * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The return statement. This is a leaf in the CFG.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Goto</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> Pervasives.ref * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A goto statement. Appears from actual goto's in the code or from
+ goto's that have been inserted during elaboration. The reference
+ points to the statement that is the target of the Goto. This means that
+ you have to update the reference whenever you replace the target
+ statement. The target statement MUST have at least a label.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Break</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A break to the end of the nearest enclosing Loop or Switch</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Continue</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A continue to the start of the nearest enclosing <code class="code">Loop</code></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">If</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A conditional. Two successors, the "then" and the "else" branches.
+ Both branches fall-through to the successor of the If statement.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Switch</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPEstmt">stmt</a> list * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A switch statement. The statements that implement the cases can be
+ reached through the provided list. For each such target you can find
+ among its labels what cases it implements. The statements that
+ implement the cases are somewhere within the provided <code class="code">block</code>.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Loop</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a> * <a href="Cil.html#TYPEstmt">stmt</a> option * <a href="Cil.html#TYPEstmt">stmt</a> option</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A <code class="code">while(1)</code> loop. The termination test is implemented in the body of
+ a loop using a <code class="code">Break</code> statement. If prepareCFG has been called,
+ the first stmt option will point to the stmt containing the continue
+ label for this loop and the second will point to the stmt containing
+ the break label for this loop.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Block</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Just a block of statements. Use it as a way to keep some block
+ attributes local</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TryFinally</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TryExcept</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEblock">block</a> * (<a href="Cil.html#TYPEinstr">instr</a> list * <a href="Cil.html#TYPEexp">exp</a>) * <a href="Cil.html#TYPEblock">block</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+
+</tr></table>
+
+<div class="info">
+The various kinds of control-flow statements statements<br>
+</div>
+
+<br>
+<b>Instructions</b>.
+ An instruction <a href="Cil.html#TYPEinstr"><code class="code">Cil.instr</code></a> is a statement that has no local
+(intraprocedural) control flow. It can be either an assignment,
+function call, or an inline assembly instruction.<br>
+<br><code><span class="keyword">type</span> <a name="TYPEinstr"></a><code class="type"></code>instr = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Set</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a> * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>An assignment. The type of the expression is guaranteed to be the same
+ with that of the lvalue</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Call</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a> option * <a href="Cil.html#TYPEexp">exp</a> * <a href="Cil.html#TYPEexp">exp</a> list * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>A function call with the (optional) result placed in an lval. It is
+ possible that the returned type of the function is not identical to
+ that of the lvalue. In that case a cast is printed. The type of the
+ actual arguments are identical to those of the declared formals. The
+ number of arguments is the same as that of the declared formals, except
+ for vararg functions. This construct is also used to encode a call to
+ "__builtin_va_arg". In this case the second argument (which should be a
+ type T) is encoded SizeOf(T)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Asm</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a> * string list * (string * <a href="Cil.html#TYPElval">lval</a>) list<br> * (string * <a href="Cil.html#TYPEexp">exp</a>) list * string list * <a href="Cil.html#TYPElocation">location</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>There are for storing inline assembly. They follow the GCC
+ specification:
+<pre>
+ asm [volatile] ("...template..." "..template.."
+ : "c1" (o1), "c2" (o2), ..., "cN" (oN)
+ : "d1" (i1), "d2" (i2), ..., "dM" (iM)
+ : "r1", "r2", ..., "nL" );
+</pre>
+<p>
+
+where the parts are
+<p>
+<ul>
+<li><code class="code">volatile</code> (optional): when present, the assembler instruction
+ cannot be removed, moved, or otherwise optimized</li>
+<li>template: a sequence of strings, with %0, %1, %2, etc. in the string to
+ refer to the input and output expressions. I think they're numbered
+ consecutively, but the docs don't specify. Each string is printed on
+ a separate line. This is the only part that is present for MSVC inline
+ assembly.</li>
+<li>"ci" (oi): pairs of constraint-string and output-lval; the
+ constraint specifies that the register used must have some
+ property, like being a floating-point register; the constraint
+ string for outputs also has "=" to indicate it is written, or
+ "+" to indicate it is both read and written; 'oi' is the
+ name of a C lvalue (probably a variable name) to be used as
+ the output destination</li>
+<li>"dj" (ij): pairs of constraint and input expression; the constraint
+ is similar to the "ci"s. the 'ij' is an arbitrary C expression
+ to be loaded into the corresponding register</li>
+<li>"rk": registers to be regarded as "clobbered" by the instruction;
+ "memory" may be specified for arbitrary memory effects</li>
+</ul>
+
+an example (from gcc manual):
+<pre>
+ asm volatile ("movc3 %0,%1,%2"
+ : /* no outputs */
+ : "g" (from), "g" (to), "g" (count)
+ : "r0", "r1", "r2", "r3", "r4", "r5");
+</pre></code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Instructions.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPElocation"></a><code class="type"></code>location = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>line&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The line number. -1 means "do not know"</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>file&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The name of the source file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>byte&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The byte position in the source file</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Describes a location in a source file.<br>
+</div>
+
+<br><code><span class="keyword">type</span> <a name="TYPEtypsig"></a><code class="type"></code>typsig = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TSArray</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> * int64 option * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TSPtr</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TSComp</span> <span class="keyword">of</span> <code class="type">bool * string * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TSFun</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> * <a href="Cil.html#TYPEtypsig">typsig</a> list * bool * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TSEnum</span> <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEattribute">attribute</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">TSBase</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+
+</tr></table>
+
+<div class="info">
+Type signatures. Two types are identical iff they have identical
+ signatures. These contain the same information as types but canonicalized.
+ For example, two function types that are identical except for the name of
+ the formal arguments are given the same signature. Also, <code class="code">TNamed</code>
+ constructors are unrolled.<br>
+</div>
+
+<br>
+<b>Lowering Options</b><br>
+<pre><span class="keyword">val</span> <a name="VALlowerConstants"></a>lowerConstants : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Do lower constants (default true)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALinsertImplicitCasts"></a>insertImplicitCasts : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Do insert implicit casts (default true)<br>
+</div>
+<br><code><span class="keyword">type</span> <a name="TYPEfeatureDescr"></a><code class="type"></code>featureDescr = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>fd_enabled&nbsp;: <code class="type">bool Pervasives.ref</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The enable flag. Set to default value</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>fd_name&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This is used to construct an option "--doxxx" and "--dontxxx" that
+ enable and disable the feature</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>fd_description&nbsp;: <code class="type">string</code>;</code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>fd_extraopt&nbsp;: <code class="type">(string * Arg.spec * string) list</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Additional command line options</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>fd_doit&nbsp;: <code class="type"><a href="Cil.html#TYPEfile">file</a> -> unit</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>This performs the transformation</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>fd_post_check&nbsp;: <code class="type">bool</code>;</code></td>
+
+</tr></table>
+}
+
+<div class="info">
+To be able to add/remove features easily, each feature should be package
+ as an interface with the following interface. These features should be<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALcompareLoc"></a>compareLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> -> <a href="Cil.html#TYPElocation">location</a> -> int</code></pre><div class="info">
+Comparison function for locations.
+* Compares first by filename, then line, then byte<br>
+</div>
+<br>
+<b>Values for manipulating globals</b><br>
+<pre><span class="keyword">val</span> <a name="VALemptyFunction"></a>emptyFunction : <code class="type">string -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
+Make an empty function<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetFormals"></a>setFormals : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> list -> unit</code></pre><div class="info">
+Update the formals of a <code class="code">fundec</code> and make sure that the function type
+ has the same information. Will copy the name as well into the type.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetFunctionType"></a>setFunctionType : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> unit</code></pre><div class="info">
+Set the types of arguments and results as given by the function type
+ passed as the second argument. Will not copy the names from the function
+ type to the formals<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetFunctionTypeMakeFormals"></a>setFunctionTypeMakeFormals : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> unit</code></pre><div class="info">
+Set the type of the function and make formal arguments for them<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetMaxId"></a>setMaxId : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> unit</code></pre><div class="info">
+Update the smaxid after you have populated with locals and formals
+ (unless you constructed those using <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> or
+ <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdummyFunDec"></a>dummyFunDec : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
+A dummy function declaration handy when you need one as a placeholder. It
+ contains inside a dummy varinfo.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdummyFile"></a>dummyFile : <code class="type"><a href="Cil.html#TYPEfile">file</a></code></pre><div class="info">
+A dummy file<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsaveBinaryFile"></a>saveBinaryFile : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> string -> unit</code></pre><div class="info">
+Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem. The file can be
+ read back in later using <a href="Cil.html#VALloadBinaryFile"><code class="code">Cil.loadBinaryFile</code></a>, possibly saving parsing
+ time. The second argument is the name of the file that should be
+ created.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsaveBinaryFileChannel"></a>saveBinaryFileChannel : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> Pervasives.out_channel -> unit</code></pre><div class="info">
+Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem. The file can be
+ read back in later using <a href="Cil.html#VALloadBinaryFile"><code class="code">Cil.loadBinaryFile</code></a>, possibly saving parsing
+ time. Does not close the channel.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALloadBinaryFile"></a>loadBinaryFile : <code class="type">string -> <a href="Cil.html#TYPEfile">file</a></code></pre><div class="info">
+Read a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form from the filesystem. The first
+ argument is the name of a file previously created by
+ <a href="Cil.html#VALsaveBinaryFile"><code class="code">Cil.saveBinaryFile</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALgetGlobInit"></a>getGlobInit : <code class="type">?main_name:string -> <a href="Cil.html#TYPEfile">file</a> -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
+Get the global initializer and create one if it does not already exist.
+ When it creates a global initializer it attempts to place a call to it in
+ the main function named by the optional argument (default "main")<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALiterGlobals"></a>iterGlobals : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> (<a href="Cil.html#TYPEglobal">global</a> -> unit) -> unit</code></pre><div class="info">
+Iterate over all globals, including the global initializer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfoldGlobals"></a>foldGlobals : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> ('a -> <a href="Cil.html#TYPEglobal">global</a> -> 'a) -> 'a -> 'a</code></pre><div class="info">
+Fold over all globals, including the global initializer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmapGlobals"></a>mapGlobals : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> (<a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPEglobal">global</a>) -> unit</code></pre><div class="info">
+Map over all globals, including the global initializer and change things
+ in place<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnew_sid"></a>new_sid : <code class="type">unit -> int</code></pre><pre><span class="keyword">val</span> <a name="VALprepareCFG"></a>prepareCFG : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> unit</code></pre><div class="info">
+Prepare a function for CFG information computation by
+ <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>. This function converts all <code class="code">Break</code>, <code class="code">Switch</code>,
+ <code class="code">Default</code> and <code class="code">Continue</code> <a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a>s and <a href="Cil.html#TYPElabel"><code class="code">Cil.label</code></a>s into <code class="code">If</code>s
+ and <code class="code">Goto</code>s, giving the function body a very CFG-like character. This
+ function modifies its argument in place.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcomputeCFGInfo"></a>computeCFGInfo : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> bool -> unit</code></pre><div class="info">
+Compute the CFG information for all statements in a fundec and return a
+ list of the statements. The input fundec cannot have <code class="code">Break</code>, <code class="code">Switch</code>,
+ <code class="code">Default</code>, or <code class="code">Continue</code> <a href="Cil.html#TYPEstmtkind"><code class="code">Cil.stmtkind</code></a>s or <a href="Cil.html#TYPElabel"><code class="code">Cil.label</code></a>s. Use
+ <a href="Cil.html#VALprepareCFG"><code class="code">Cil.prepareCFG</code></a> to transform them away. The second argument should
+ be <code class="code">true</code> if you wish a global statement number, <code class="code">false</code> if you wish a
+ local (per-function) statement numbering. The list of statements is set
+ in the sallstmts field of a fundec.
+<p>
+
+ NOTE: unless you want the simpler control-flow graph provided by
+ prepareCFG, or you need the function's smaxstmtid and sallstmt fields
+ filled in, we recommend you use <a href="Cfg.html#VALcomputeFileCFG"><code class="code">Cfg.computeFileCFG</code></a> instead of this
+ function to compute control-flow information.
+ <a href="Cfg.html#VALcomputeFileCFG"><code class="code">Cfg.computeFileCFG</code></a> is newer and will handle switch, break, and
+ continue correctly.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcopyFunction"></a>copyFunction : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> string -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
+Create a deep copy of a function. There should be no sharing between the
+ copy and the original function<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALpushGlobal"></a>pushGlobal : <code class="type"><a href="Cil.html#TYPEglobal">global</a> -><br> types:<a href="Cil.html#TYPEglobal">global</a> list Pervasives.ref -><br> variables:<a href="Cil.html#TYPEglobal">global</a> list Pervasives.ref -> unit</code></pre><div class="info">
+CIL keeps the types at the beginning of the file and the variables at the
+ end of the file. This function will take a global and add it to the
+ corresponding stack. Its operation is actually more complicated because if
+ the global declares a type that contains references to variables (e.g. in
+ sizeof in an array length) then it will also add declarations for the
+ variables to the types stack<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALinvalidStmt"></a>invalidStmt : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
+An empty statement. Used in pretty printing<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALgccBuiltins"></a>gccBuiltins : <code class="type">(string, <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEtyp">typ</a> list * bool) Hashtbl.t</code></pre><div class="info">
+A list of the GCC built-in functions. Maps the name to the result and
+ argument types, and whether it is vararg<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmsvcBuiltins"></a>msvcBuiltins : <code class="type">(string, <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEtyp">typ</a> list * bool) Hashtbl.t</code></pre><div class="info">
+A list of the MSVC built-in functions. Maps the name to the result and
+ argument types, and whether it is vararg<br>
+</div>
+<br>
+<b>Values for manipulating initializers</b><br>
+<pre><span class="keyword">val</span> <a name="VALmakeZeroInit"></a>makeZeroInit : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEinit">init</a></code></pre><div class="info">
+Make a initializer for zero-ing a data type<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfoldLeftCompound"></a>foldLeftCompound : <code class="type">doinit:(<a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> 'a -> 'a) -><br> ct:<a href="Cil.html#TYPEtyp">typ</a> -> initl:(<a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEinit">init</a>) list -> acc:'a -> 'a</code></pre><div class="info">
+Fold over the list of initializers in a Compound. <code class="code">doinit</code> is called on
+ every present initializer, even if it is of compound type. In the case of
+ arrays there might be missing zero-initializers at the end of the list.
+ These are not scanned. This is much like <code class="code">List.fold_left</code> except we also
+ pass the type of the initializer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfoldLeftCompoundAll"></a>foldLeftCompoundAll : <code class="type">doinit:(<a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> 'a -> 'a) -><br> ct:<a href="Cil.html#TYPEtyp">typ</a> -> initl:(<a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEinit">init</a>) list -> acc:'a -> 'a</code></pre><div class="info">
+Fold over the list of initializers in a Compound, like
+ <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> but in the case of an array it scans even missing
+ zero initializers at the end of the array<br>
+</div>
+<br>
+<b>Values for manipulating types</b><br>
+<pre><span class="keyword">val</span> <a name="VALvoidType"></a>voidType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+void<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisVoidType"></a>isVoidType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><pre><span class="keyword">val</span> <a name="VALisVoidPtrType"></a>isVoidPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><pre><span class="keyword">val</span> <a name="VALintType"></a>intType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+int<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALuintType"></a>uintType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+unsigned int<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlongType"></a>longType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+long<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALulongType"></a>ulongType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+unsigned long<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcharType"></a>charType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+char<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcharPtrType"></a>charPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+char *<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwcharKind"></a>wcharKind : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> Pervasives.ref</code></pre><div class="info">
+wchar_t (depends on architecture) and is set when you call
+ <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwcharType"></a>wcharType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALcharConstPtrType"></a>charConstPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+char const *<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvoidPtrType"></a>voidPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+void *<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALintPtrType"></a>intPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+int *<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALuintPtrType"></a>uintPtrType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+unsigned int *<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdoubleType"></a>doubleType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+double<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALupointType"></a>upointType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALtypeOfSizeOf"></a>typeOfSizeOf : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALisSigned"></a>isSigned : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> -> bool</code></pre><div class="info">
+Returns true if and only if the given integer type is signed.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkCompInfo"></a>mkCompInfo : <code class="type">bool -><br> string -><br> (<a href="Cil.html#TYPEcompinfo">compinfo</a> -><br> (string * <a href="Cil.html#TYPEtyp">typ</a> * int option * <a href="Cil.html#TYPEattributes">attributes</a> * <a href="Cil.html#TYPElocation">location</a>) list) -><br> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEcompinfo">compinfo</a></code></pre><div class="info">
+Creates a a (potentially recursive) composite type. The arguments are:
+ (1) a boolean indicating whether it is a struct or a union, (2) the name
+ (always non-empty), (3) a function that when given a representation of the
+ structure type constructs the type of the fields recursive type (the first
+ argument is only useful when some fields need to refer to the type of the
+ structure itself), and (4) a list of attributes to be associated with the
+ composite type. The resulting compinfo has the field "cdefined" only if
+ the list of fields is non-empty.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcopyCompInfo"></a>copyCompInfo : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> -> string -> <a href="Cil.html#TYPEcompinfo">compinfo</a></code></pre><div class="info">
+Makes a shallow copy of a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> changing the name and the key.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmissingFieldName"></a>missingFieldName : <code class="type">string</code></pre><div class="info">
+This is a constant used as the name of an unnamed bitfield. These fields
+ do not participate in initialization and their name is not printed.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcompFullName"></a>compFullName : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> -> string</code></pre><div class="info">
+Get the full name of a comp<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisCompleteType"></a>isCompleteType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+Returns true if this is a complete type.
+ This means that sizeof(t) makes sense.
+ Incomplete types are not yet defined
+ structures and empty arrays.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunrollType"></a>unrollType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Unroll a type until it exposes a non
+ <code class="code">TNamed</code>. Will collect all attributes appearing in <code class="code">TNamed</code>!!!<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunrollTypeDeep"></a>unrollTypeDeep : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Unroll all the TNamed in a type (even under type constructors such as
+ <code class="code">TPtr</code>, <code class="code">TFun</code> or <code class="code">TArray</code>. Does not unroll the types of fields in <code class="code">TComp</code>
+ types. Will collect all attributes<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALseparateStorageModifiers"></a>separateStorageModifiers : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEattribute">attribute</a> list * <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
+Separate out the storage-modifier name attributes<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisIntegralType"></a>isIntegralType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+True if the argument is an integral type (i.e. integer or enum)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisArithmeticType"></a>isArithmeticType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+True if the argument is an arithmetic type (i.e. integer, enum or
+ floating point<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisPointerType"></a>isPointerType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+True if the argument is a pointer type<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisFunctionType"></a>isFunctionType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+True if the argument is a function type<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALargsToList"></a>argsToList : <code class="type">(string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option -><br> (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list</code></pre><div class="info">
+Obtain the argument list ([] if None)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisArrayType"></a>isArrayType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+True if the argument is an array type<br>
+</div>
+<pre><span class="keyword">exception</span> <a name="EXCEPTIONLenOfArray"></a>LenOfArray</pre>
+<div class="info">
+Raised when <a href="Cil.html#VALlenOfArray"><code class="code">Cil.lenOfArray</code></a> fails either because the length is <code class="code">None</code>
+ or because it is a non-constant expression<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlenOfArray"></a>lenOfArray : <code class="type"><a href="Cil.html#TYPEexp">exp</a> option -> int</code></pre><div class="info">
+Call to compute the array length as present in the array type, to an
+ integer. Raises <a href="Cil.html#EXCEPTIONLenOfArray"><code class="code">Cil.LenOfArray</code></a> if not able to compute the length, such
+ as when there is no length or the length is not a constant.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALgetCompField"></a>getCompField : <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a> -> string -> <a href="Cil.html#TYPEfieldinfo">fieldinfo</a></code></pre><div class="info">
+Return a named fieldinfo in compinfo, or raise Not_found<br>
+</div>
+<br><code><span class="keyword">type</span> <a name="TYPEexistsAction"></a><code class="type"></code>existsAction = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ExistsTrue</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ExistsFalse</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ExistsMaybe</span></code></td>
+
+</tr></table>
+
+<div class="info">
+A datatype to be used in conjunction with <code class="code">existsType</code><br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALexistsType"></a>existsType : <code class="type">(<a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexistsAction">existsAction</a>) -> <a href="Cil.html#TYPEtyp">typ</a> -> bool</code></pre><div class="info">
+Scans a type by applying the function on all elements.
+ When the function returns ExistsTrue, the scan stops with
+ true. When the function returns ExistsFalse then the current branch is not
+ scanned anymore. Care is taken to
+ apply the function only once on each composite type, thus avoiding
+ circularity. When the function returns ExistsMaybe then the types that
+ construct the current type are scanned (e.g. the base type for TPtr and
+ TArray, the type of fields for a TComp, etc).<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsplitFunctionType"></a>splitFunctionType : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -><br> <a href="Cil.html#TYPEtyp">typ</a> * (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option * bool *<br> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Given a function type split it into return type,
+ arguments, is_vararg and attributes. An error is raised if the type is not
+ a function type
+<p>
+Same as <a href="Cil.html#VALsplitFunctionType"><code class="code">Cil.splitFunctionType</code></a> but takes a varinfo. Prints a nicer
+ error message if the varinfo is not for a function<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsplitFunctionTypeVI"></a>splitFunctionTypeVI : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -><br> <a href="Cil.html#TYPEtyp">typ</a> * (string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list option * bool *<br> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><br>
+<b>Type signatures</b><br>
+<br>
+Type signatures. Two types are identical iff they have identical
+ signatures. These contain the same information as types but canonicalized.
+ For example, two function types that are identical except for the name of
+ the formal arguments are given the same signature. Also, <code class="code">TNamed</code>
+ constructors are unrolled. You shoud use <code class="code">Util.equals</code> to compare type
+ signatures because they might still contain circular structures (through
+ attributes, and sizeof)<br>
+<pre><span class="keyword">val</span> <a name="VALd_typsig"></a>d_typsig : <code class="type">unit -> <a href="Cil.html#TYPEtypsig">typsig</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a type signature<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeSig"></a>typeSig : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtypsig">typsig</a></code></pre><div class="info">
+Compute a type signature<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeSigWithAttrs"></a>typeSigWithAttrs : <code class="type">?ignoreSign:bool -><br> (<a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a>) -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtypsig">typsig</a></code></pre><div class="info">
+Like <a href="Cil.html#VALtypeSig"><code class="code">Cil.typeSig</code></a> but customize the incorporation of attributes.
+ Use ~ignoreSign:true to convert all signed integer types to unsigned,
+ so that signed and unsigned will compare the same.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetTypeSigAttrs"></a>setTypeSigAttrs : <code class="type"><a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEtypsig">typsig</a> -> <a href="Cil.html#TYPEtypsig">typsig</a></code></pre><div class="info">
+Replace the attributes of a signature (only at top level)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeSigAttrs"></a>typeSigAttrs : <code class="type"><a href="Cil.html#TYPEtypsig">typsig</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Get the top-level attributes of a signature<br>
+</div>
+<br>
+LVALUES<br>
+<pre><span class="keyword">val</span> <a name="VALmakeVarinfo"></a>makeVarinfo : <code class="type">bool -> string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Make a varinfo. Use this (rarely) to make a raw varinfo. Use other
+ functions to make locals (<a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> or <a href="Cil.html#VALmakeFormalVar"><code class="code">Cil.makeFormalVar</code></a> or
+ <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>) and globals (<a href="Cil.html#VALmakeGlobalVar"><code class="code">Cil.makeGlobalVar</code></a>). Note that this
+ function will assign a new identifier. The first argument specifies
+ whether the varinfo is for a global.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmakeFormalVar"></a>makeFormalVar : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> ?where:string -> string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Make a formal variable for a function. Insert it in both the sformals
+ and the type of the function. You can optionally specify where to insert
+ this one. If where = "^" then it is inserted first. If where = "$" then
+ it is inserted last. Otherwise where must be the name of a formal after
+ which to insert this. By default it is inserted at the end.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmakeLocalVar"></a>makeLocalVar : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> ?insert:bool -> string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Make a local variable and add it to a function's slocals (only if insert =
+ true, which is the default). Make sure you know what you are doing if you
+ set insert=false.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmakeTempVar"></a>makeTempVar : <code class="type"><a href="Cil.html#TYPEfundec">fundec</a> -> ?name:string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Make a temporary variable and add it to a function's slocals. The name of
+ the temporary variable will be generated based on the given name hint so
+ that to avoid conflicts with other locals.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmakeGlobalVar"></a>makeGlobalVar : <code class="type">string -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Make a global variable. Your responsibility to make sure that the name
+ is unique<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcopyVarinfo"></a>copyVarinfo : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> string -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Make a shallow copy of a <code class="code">varinfo</code> and assign a new identifier<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnewVID"></a>newVID : <code class="type">unit -> int</code></pre><div class="info">
+Generate a new variable ID. This will be different than any variable ID
+ that is generated by <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> and friends<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALaddOffsetLval"></a>addOffsetLval : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
+Add an offset at the end of an lvalue. Make sure the type of the lvalue
+ and the offset are compatible.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALaddOffset"></a>addOffset : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
+<code class="code">addOffset o1 o2</code> adds <code class="code">o1</code> to the end of <code class="code">o2</code>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALremoveOffsetLval"></a>removeOffsetLval : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a> * <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
+Remove ONE offset from the end of an lvalue. Returns the lvalue with the
+ trimmed offset and the final offset. If the final offset is <code class="code">NoOffset</code>
+ then the original <code class="code">lval</code> did not have an offset.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALremoveOffset"></a>removeOffset : <code class="type"><a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a> * <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
+Remove ONE offset from the end of an offset sequence. Returns the
+ trimmed offset and the final offset. If the final offset is <code class="code">NoOffset</code>
+ then the original <code class="code">lval</code> did not have an offset.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeOfLval"></a>typeOfLval : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Compute the type of an lvalue<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeOffset"></a>typeOffset : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Compute the type of an offset from a base type<br>
+</div>
+<br>
+<b>Values for manipulating expressions</b><br>
+<pre><span class="keyword">val</span> <a name="VALzero"></a>zero : <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+0<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALone"></a>one : <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+1<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmone"></a>mone : <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+-1<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALkinteger64"></a>kinteger64 : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> -> int64 -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Construct an integer of a given kind, using OCaml's int64 type. If needed
+ it will truncate the integer to be within the representable range for the
+ given kind.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALkinteger"></a>kinteger : <code class="type"><a href="Cil.html#TYPEikind">ikind</a> -> int -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Construct an integer of a given kind. Converts the integer to int64 and
+ then uses kinteger64. This might truncate the value if you use a kind
+ that cannot represent the given integer. This can only happen for one of
+ the Char or Short kinds<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALinteger"></a>integer : <code class="type">int -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Construct an integer of kind IInt. You can use this always since the
+ OCaml integers are 31 bits and are guaranteed to fit in an IInt<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisInteger"></a>isInteger : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> int64 option</code></pre><div class="info">
+True if the given expression is a (possibly cast'ed)
+ character or an integer constant<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisConstant"></a>isConstant : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> bool</code></pre><div class="info">
+True if the expression is a compile-time constant<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALisZero"></a>isZero : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> bool</code></pre><div class="info">
+True if the given expression is a (possibly cast'ed) integer or character
+ constant with value zero<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcharConstToInt"></a>charConstToInt : <code class="type">char -> <a href="Cil.html#TYPEconstant">constant</a></code></pre><div class="info">
+Given the character c in a (CChr c), sign-extend it to 32 bits.
+ (This is the official way of interpreting character constants, according to
+ ISO C 6.4.4.4.10, which says that character constants are chars cast to ints)
+ Returns CInt64(sign-extened c, IInt, None)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALconstFold"></a>constFold : <code class="type">bool -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Do constant folding on an expression. If the first argument is true then
+ will also compute compiler-dependent expressions such as sizeof<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALconstFoldBinOp"></a>constFoldBinOp : <code class="type">bool -> <a href="Cil.html#TYPEbinop">binop</a> -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Do constant folding on a binary operation. The bulk of the work done by
+ <code class="code">constFold</code> is done here. If the first argument is true then
+ will also compute compiler-dependent expressions such as sizeof<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALincrem"></a>increm : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> int -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Increment an expression. Can be arithmetic or pointer type<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvar"></a>var : <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
+Makes an lvalue out of a given variable<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkAddrOf"></a>mkAddrOf : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Make an AddrOf. Given an lvalue of type T will give back an expression of
+ type ptr(T). It optimizes somewhat expressions like "&amp; v" and "&amp; v<code class="code">0</code>"<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkAddrOrStartOf"></a>mkAddrOrStartOf : <code class="type"><a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Like mkAddrOf except if the type of lval is an array then it uses
+ StartOf. This is the right operation for getting a pointer to the start
+ of the storage denoted by lval.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkMem"></a>mkMem : <code class="type">addr:<a href="Cil.html#TYPEexp">exp</a> -> off:<a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
+Make a Mem, while optimizing AddrOf. The type of the addr must be
+ TPtr(t) and the type of the resulting lval is t. Note that in CIL the
+ implicit conversion between an array and the pointer to the first
+ element does not apply. You must do the conversion yourself using
+ StartOf<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkString"></a>mkString : <code class="type">string -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Make an expression that is a string constant (of pointer type)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkCastT"></a>mkCastT : <code class="type">e:<a href="Cil.html#TYPEexp">exp</a> -> oldt:<a href="Cil.html#TYPEtyp">typ</a> -> newt:<a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Construct a cast when having the old type of the expression. If the new
+ type is the same as the old type, then no cast is added.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkCast"></a>mkCast : <code class="type">e:<a href="Cil.html#TYPEexp">exp</a> -> newt:<a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Like <a href="Cil.html#VALmkCastT"><code class="code">Cil.mkCastT</code></a> but uses typeOf to get <code class="code">oldt</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALstripCasts"></a>stripCasts : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Removes casts from this expression, but ignores casts within
+ other expression constructs. So we delete the (A) and (B) casts from
+ "(A)(B)(x + (C)y)", but leave the (C) cast.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeOf"></a>typeOf : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Compute the type of an expression<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALparseInt"></a>parseInt : <code class="type">string -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Convert a string representing a C integer literal to an expression.
+ Handles the prefixes 0x and 0 and the suffixes L, U, UL, LL, ULL<br>
+</div>
+<br>
+<b>Values for manipulating statements</b><br>
+<pre><span class="keyword">val</span> <a name="VALmkStmt"></a>mkStmt : <code class="type"><a href="Cil.html#TYPEstmtkind">stmtkind</a> -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
+Construct a statement, given its kind. Initialize the <code class="code">sid</code> field to -1,
+ and <code class="code">labels</code>, <code class="code">succs</code> and <code class="code">preds</code> to the empty list<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkBlock"></a>mkBlock : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEblock">block</a></code></pre><div class="info">
+Construct a block with no attributes, given a list of statements<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkStmtOneInstr"></a>mkStmtOneInstr : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
+Construct a statement consisting of just one instruction<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcompactStmts"></a>compactStmts : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
+Try to compress statements so as to get maximal basic blocks<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkEmptyStmt"></a>mkEmptyStmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
+Returns an empty statement (of kind <code class="code">Instr</code>)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdummyInstr"></a>dummyInstr : <code class="type"><a href="Cil.html#TYPEinstr">instr</a></code></pre><div class="info">
+A instr to serve as a placeholder<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdummyStmt"></a>dummyStmt : <code class="type"><a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
+A statement consisting of just <code class="code">dummyInstr</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkWhile"></a>mkWhile : <code class="type">guard:<a href="Cil.html#TYPEexp">exp</a> -> body:<a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
+Make a while loop. Can contain Break or Continue<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkForIncr"></a>mkForIncr : <code class="type">iter:<a href="Cil.html#TYPEvarinfo">varinfo</a> -><br> first:<a href="Cil.html#TYPEexp">exp</a> -><br> stopat:<a href="Cil.html#TYPEexp">exp</a> -> incr:<a href="Cil.html#TYPEexp">exp</a> -> body:<a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
+Make a for loop for(i=start; i&lt;past; i += incr) { ... }. The body
+ can contain Break but not Continue. Can be used with i a pointer
+ or an integer. Start and done must have the same type but incr
+ must be an integer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmkFor"></a>mkFor : <code class="type">start:<a href="Cil.html#TYPEstmt">stmt</a> list -><br> guard:<a href="Cil.html#TYPEexp">exp</a> -> next:<a href="Cil.html#TYPEstmt">stmt</a> list -> body:<a href="Cil.html#TYPEstmt">stmt</a> list -> <a href="Cil.html#TYPEstmt">stmt</a> list</code></pre><div class="info">
+Make a for loop for(start; guard; next) { ... }. The body can
+ contain Break but not Continue !!!<br>
+</div>
+<br>
+<b>Values for manipulating attributes</b><br>
+<br><code><span class="keyword">type</span> <a name="TYPEattributeClass"></a><code class="type"></code>attributeClass = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AttrName</span> <span class="keyword">of</span> <code class="type">bool</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attribute of a name. If argument is true and we are on MSVC then
+ the attribute is printed using __declspec as part of the storage
+ specifier</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AttrFunType</span> <span class="keyword">of</span> <code class="type">bool</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attribute of a function type. If argument is true and we are on
+ MSVC then the attribute is printed just before the function name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">AttrType</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Attribute of a type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Various classes of attributes<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALattributeHash"></a>attributeHash : <code class="type">(string, <a href="Cil.html#TYPEattributeClass">attributeClass</a>) Hashtbl.t</code></pre><div class="info">
+This table contains the mapping of predefined attributes to classes.
+ Extend this table with more attributes as you need. This table is used to
+ determine how to associate attributes with names or types<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALpartitionAttributes"></a>partitionAttributes : <code class="type">default:<a href="Cil.html#TYPEattributeClass">attributeClass</a> -><br> <a href="Cil.html#TYPEattributes">attributes</a> -><br> <a href="Cil.html#TYPEattribute">attribute</a> list * <a href="Cil.html#TYPEattribute">attribute</a> list * <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
+Partition the attributes into classes:name attributes, function type,
+ and type attributes<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALaddAttribute"></a>addAttribute : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Add an attribute. Maintains the attributes in sorted order of the second
+ argument<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALaddAttributes"></a>addAttributes : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Add a list of attributes. Maintains the attributes in sorted order. The
+ second argument must be sorted, but not necessarily the first<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdropAttribute"></a>dropAttribute : <code class="type">string -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Remove all attributes with the given name. Maintains the attributes in
+ sorted order.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdropAttributes"></a>dropAttributes : <code class="type">string list -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Remove all attributes with names appearing in the string list.
+ Maintains the attributes in sorted order<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfilterAttributes"></a>filterAttributes : <code class="type">string -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEattributes">attributes</a></code></pre><div class="info">
+Retains attributes with the given name<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALhasAttribute"></a>hasAttribute : <code class="type">string -> <a href="Cil.html#TYPEattributes">attributes</a> -> bool</code></pre><div class="info">
+True if the named attribute appears in the attribute list. The list of
+ attributes must be sorted.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeAttrs"></a>typeAttrs : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
+Returns all the attributes contained in a type. This requires a traversal
+ of the type structure, in case of composite, enumeration and named types<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetTypeAttrs"></a>setTypeAttrs : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><pre><span class="keyword">val</span> <a name="VALtypeAddAttributes"></a>typeAddAttributes : <code class="type"><a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Add some attributes to a type<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtypeRemoveAttributes"></a>typeRemoveAttributes : <code class="type">string list -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Remove all attributes with the given names from a type. Note that this
+ does not remove attributes from typedef and tag definitions, just from
+ their uses<br>
+</div>
+<br>
+<b>The visitor</b><br>
+<br><code><span class="keyword">type</span> <a name="TYPEvisitAction"></a><code class="type">'a</code> visitAction = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SkipChildren</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not visit the children. Return
+ the node as it is.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">DoChildren</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Continue with the children of this
+ node. Rebuild the node on return
+ if any of the children changes
+ (use == test)</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ChangeTo</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Replace the expression with the
+ given one</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">ChangeDoChildrenPost</span> <span class="keyword">of</span> <code class="type">'a * ('a -> 'a)</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>First consider that the entire
+ exp is replaced by the first
+ parameter. Then continue with
+ the children. On return rebuild
+ the node if any of the children
+ has changed and then apply the
+ function on the node</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+Different visiting actions. 'a will be instantiated with <code class="code">exp</code>, <code class="code">instr</code>,
+ etc.<br>
+</div>
+
+<pre><span class="keyword">class type</span> <a name="TYPEcilVisitor"></a><a href="Cil.cilVisitor.html">cilVisitor</a> = <code class="code">object</code> <a href="Cil.cilVisitor.html">..</a> <code class="code">end</code></pre><div class="info">
+A visitor interface for traversing CIL trees.
+</div>
+<pre><span class="keyword">class</span> <a name="TYPEnopCilVisitor"></a><a href="Cil.nopCilVisitor.html">nopCilVisitor</a> : <code class="type"></code><code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a></code></pre><div class="info">
+Default Visitor.
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilFile"></a>visitCilFile : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
+Visit a file. This will will re-cons all globals TWICE (so that it is
+ tail-recursive). Use <a href="Cil.html#VALvisitCilFileSameGlobals"><code class="code">Cil.visitCilFileSameGlobals</code></a> if your visitor will
+ not change the list of globals.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilFileSameGlobals"></a>visitCilFileSameGlobals : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
+A visitor for the whole file that does not change the globals (but maybe
+ changes things inside the globals). Use this function instead of
+ <a href="Cil.html#VALvisitCilFile"><code class="code">Cil.visitCilFile</code></a> whenever appropriate because it is more efficient for
+ long files.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilGlobal"></a>visitCilGlobal : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPEglobal">global</a> list</code></pre><div class="info">
+Visit a global<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilFunction"></a>visitCilFunction : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEfundec">fundec</a> -> <a href="Cil.html#TYPEfundec">fundec</a></code></pre><div class="info">
+Visit a function definition<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilExpr"></a>visitCilExpr : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><pre><span class="keyword">val</span> <a name="VALvisitCilLval"></a>visitCilLval : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Cil.html#TYPElval">lval</a></code></pre><div class="info">
+Visit an lvalue<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilOffset"></a>visitCilOffset : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
+Visit an lvalue or recursive offset<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilInitOffset"></a>visitCilInitOffset : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Cil.html#TYPEoffset">offset</a></code></pre><div class="info">
+Visit an initializer offset<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilInstr"></a>visitCilInstr : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list</code></pre><div class="info">
+Visit an instruction<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilStmt"></a>visitCilStmt : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Cil.html#TYPEstmt">stmt</a></code></pre><div class="info">
+Visit a statement<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilBlock"></a>visitCilBlock : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Cil.html#TYPEblock">block</a></code></pre><div class="info">
+Visit a block<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilType"></a>visitCilType : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEtyp">typ</a></code></pre><div class="info">
+Visit a type<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilVarDecl"></a>visitCilVarDecl : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a> -> <a href="Cil.html#TYPEvarinfo">varinfo</a></code></pre><div class="info">
+Visit a variable declaration<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilInit"></a>visitCilInit : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Cil.html#TYPEinit">init</a></code></pre><div class="info">
+Visit an initializer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALvisitCilAttributes"></a>visitCilAttributes : <code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a> -> <a href="Cil.html#TYPEattribute">attribute</a> list -> <a href="Cil.html#TYPEattribute">attribute</a> list</code></pre><div class="info">
+Visit a list of attributes<br>
+</div>
+<br>
+<b>Utility functions</b><br>
+<pre><span class="keyword">val</span> <a name="VALmsvcMode"></a>msvcMode : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether the pretty printer should print output for the MS VC compiler.
+ Default is GCC. After you set this function you should call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALuseLogicalOperators"></a>useLogicalOperators : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether to use the logical operands LAnd and LOr. By default, do not use
+ them because they are unlike other expressions and do not evaluate both of
+ their operands<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALconstFoldVisitor"></a>constFoldVisitor : <code class="type">bool -> <a href="Cil.cilVisitor.html">cilVisitor</a></code></pre><div class="info">
+A visitor that does constant folding. Pass as argument whether you want
+ machine specific simplifications to be done, or not.<br>
+</div>
+<br><code><span class="keyword">type</span> <a name="TYPElineDirectiveStyle"></a><code class="type"></code>lineDirectiveStyle = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">LineComment</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">LinePreprocessorInput</span></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">LinePreprocessorOutput</span></code></td>
+
+</tr></table>
+
+<div class="info">
+Styles of printing line directives<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALlineDirectiveStyle"></a>lineDirectiveStyle : <code class="type"><a href="Cil.html#TYPElineDirectiveStyle">lineDirectiveStyle</a> option Pervasives.ref</code></pre><div class="info">
+How to print line directives<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprint_CIL_Input"></a>print_CIL_Input : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether we print something that will only be used as input to our own
+ parser. In that case we are a bit more liberal in what we print<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintCilAsIs"></a>printCilAsIs : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether to print the CIL as they are, without trying to be smart and
+ print nicer code. Normally this is false, in which case the pretty
+ printer will turn the while(1) loops of CIL into nicer loops, will not
+ print empty "else" blocks, etc. These is one case howewer in which if you
+ turn this on you will get code that does not compile: if you use varargs
+ the __builtin_va_arg function will be printed in its internal form.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlineLength"></a>lineLength : <code class="type">int Pervasives.ref</code></pre><div class="info">
+The length used when wrapping output lines. Setting this variable to
+ a large integer will prevent wrapping and make #line directives more
+ accurate.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALforgcc"></a>forgcc : <code class="type">string -> string</code></pre><div class="info">
+Return the string 's' if we're printing output for gcc, suppres
+ it if we're printing for CIL to parse back in. the purpose is to
+ hide things from gcc that it complains about, but still be able
+ to do lossless transformations when CIL is the consumer<br>
+</div>
+<br>
+<b>Debugging support</b><br>
+<pre><span class="keyword">val</span> <a name="VALcurrentLoc"></a>currentLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> Pervasives.ref</code></pre><div class="info">
+A reference to the current location. If you are careful to set this to
+ the current location then you can use some built-in logging functions that
+ will print the location.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcurrentGlobal"></a>currentGlobal : <code class="type"><a href="Cil.html#TYPEglobal">global</a> Pervasives.ref</code></pre><div class="info">
+A reference to the current global being visited<br>
+</div>
+<br>
+CIL has a fairly easy to use mechanism for printing error messages. This
+ mechanism is built on top of the pretty-printer mechanism (see
+ <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a>) and the error-message modules (see <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a>).
+<p>
+
+ Here is a typical example for printing a log message: <pre>
+ignore (Errormsg.log "Expression %a is not positive (at %s:%i)\n"
+ d_exp e loc.file loc.line)
+</pre>
+<p>
+
+ and here is an example of how you print a fatal error message that stop the
+ execution: <pre>
+Errormsg.s (Errormsg.bug "Why am I here?")
+</pre>
+<p>
+
+ Notice that you can use C format strings with some extension. The most
+useful extension is "%a" that means to consumer the next two argument from
+the argument list and to apply the first to <code class="code">unit</code> and then to the second
+and to print the resulting <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a>. For each major type in CIL there is
+a corresponding function that pretty-prints an element of that type:<br>
+<pre><span class="keyword">val</span> <a name="VALd_loc"></a>d_loc : <code class="type">unit -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a location<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_thisloc"></a>d_thisloc : <code class="type">unit -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_ikind"></a>d_ikind : <code class="type">unit -> <a href="Cil.html#TYPEikind">ikind</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an integer of a given kind<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_fkind"></a>d_fkind : <code class="type">unit -> <a href="Cil.html#TYPEfkind">fkind</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a floating-point kind<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_storage"></a>d_storage : <code class="type">unit -> <a href="Cil.html#TYPEstorage">storage</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print storage-class information<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_const"></a>d_const : <code class="type">unit -> <a href="Cil.html#TYPEconstant">constant</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a constant<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALderefStarLevel"></a>derefStarLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALindexLevel"></a>indexLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALarrowLevel"></a>arrowLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALaddrOfLevel"></a>addrOfLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALadditiveLevel"></a>additiveLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALcomparativeLevel"></a>comparativeLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALbitwiseLevel"></a>bitwiseLevel : <code class="type">int</code></pre><pre><span class="keyword">val</span> <a name="VALgetParenthLevel"></a>getParenthLevel : <code class="type"><a href="Cil.html#TYPEexp">exp</a> -> int</code></pre><div class="info">
+Parentheses level. An expression "a op b" is printed parenthesized if its
+ parentheses level is &gt;= that that of its context. Identifiers have the
+ lowest level and weakly binding operators (e.g. |) have the largest level.
+ The correctness criterion is that a smaller level MUST correspond to a
+ stronger precedence!<br>
+</div>
+<pre><span class="keyword">class type</span> <a name="TYPEcilPrinter"></a><a href="Cil.cilPrinter.html">cilPrinter</a> = <code class="code">object</code> <a href="Cil.cilPrinter.html">..</a> <code class="code">end</code></pre><div class="info">
+A printer interface for CIL trees.
+</div>
+<pre><span class="keyword">class</span> <a name="TYPEdefaultCilPrinterClass"></a><a href="Cil.defaultCilPrinterClass.html">defaultCilPrinterClass</a> : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><pre><span class="keyword">val</span> <a name="VALdefaultCilPrinter"></a>defaultCilPrinter : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><pre><span class="keyword">class</span> <a name="TYPEplainCilPrinterClass"></a><a href="Cil.plainCilPrinterClass.html">plainCilPrinterClass</a> : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><div class="info">
+These are pretty-printers that will show you more details on the internal
+ CIL representation, without trying hard to make it look like C
+</div>
+<pre><span class="keyword">val</span> <a name="VALplainCilPrinter"></a>plainCilPrinter : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre><pre><span class="keyword">val</span> <a name="VALprinterForMaincil"></a>printerForMaincil : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALprintType"></a>printType : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a type given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintExp"></a>printExp : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print an expression given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintLval"></a>printLval : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print an lvalue given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintGlobal"></a>printGlobal : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a global given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintAttr"></a>printAttr : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print an attribute given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintAttrs"></a>printAttrs : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a set of attributes given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintInstr"></a>printInstr : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print an instruction given a pretty printer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintStmt"></a>printStmt : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a statement given a pretty printer. This can take very long
+ (or even overflow the stack) for huge statements. Use <a href="Cil.html#VALdumpStmt"><code class="code">Cil.dumpStmt</code></a>
+ instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintBlock"></a>printBlock : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print a block given a pretty printer. This can take very long
+ (or even overflow the stack) for huge block. Use <a href="Cil.html#VALdumpBlock"><code class="code">Cil.dumpBlock</code></a>
+ instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdumpStmt"></a>dumpStmt : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> int -> <a href="Cil.html#TYPEstmt">stmt</a> -> unit</code></pre><div class="info">
+Dump a statement to a file using a given indentation. Use this instead of
+ <a href="Cil.html#VALprintStmt"><code class="code">Cil.printStmt</code></a> whenever possible.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdumpBlock"></a>dumpBlock : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> int -> <a href="Cil.html#TYPEblock">block</a> -> unit</code></pre><div class="info">
+Dump a block to a file using a given indentation. Use this instead of
+ <a href="Cil.html#VALprintBlock"><code class="code">Cil.printBlock</code></a> whenever possible.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintInit"></a>printInit : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Print an initializer given a pretty printer. This can take very long
+ (or even overflow the stack) for huge initializers. Use <a href="Cil.html#VALdumpInit"><code class="code">Cil.dumpInit</code></a>
+ instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdumpInit"></a>dumpInit : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> int -> <a href="Cil.html#TYPEinit">init</a> -> unit</code></pre><div class="info">
+Dump an initializer to a file using a given indentation. Use this instead of
+ <a href="Cil.html#VALprintInit"><code class="code">Cil.printInit</code></a> whenever possible.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_type"></a>d_type : <code class="type">unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a type using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_exp"></a>d_exp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an expression using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_lval"></a>d_lval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an lvalue using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_offset"></a>d_offset : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> unit -> <a href="Cil.html#TYPEoffset">offset</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an offset using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>, given the pretty
+ printing for the base.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_init"></a>d_init : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an initializer using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be
+ extremely slow (or even overflow the stack) for huge initializers. Use
+ <a href="Cil.html#VALdumpInit"><code class="code">Cil.dumpInit</code></a> instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_binop"></a>d_binop : <code class="type">unit -> <a href="Cil.html#TYPEbinop">binop</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a binary operator<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_unop"></a>d_unop : <code class="type">unit -> <a href="Cil.html#TYPEunop">unop</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a unary operator<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_attr"></a>d_attr : <code class="type">unit -> <a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_attrparam"></a>d_attrparam : <code class="type">unit -> <a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an argument of an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_attrlist"></a>d_attrlist : <code class="type">unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a list of attributes using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_instr"></a>d_instr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print an instruction using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_label"></a>d_label : <code class="type">unit -> <a href="Cil.html#TYPElabel">label</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a label using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_stmt"></a>d_stmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a statement using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be
+ extremely slow (or even overflow the stack) for huge statements. Use
+ <a href="Cil.html#VALdumpStmt"><code class="code">Cil.dumpStmt</code></a> instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_block"></a>d_block : <code class="type">unit -> <a href="Cil.html#TYPEblock">block</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a block using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be
+ extremely slow (or even overflow the stack) for huge blocks. Use
+ <a href="Cil.html#VALdumpBlock"><code class="code">Cil.dumpBlock</code></a> instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_global"></a>d_global : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the internal representation of a global using
+ <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>. This can be extremely slow (or even overflow the
+ stack) for huge globals (such as arrays with lots of initializers). Use
+ <a href="Cil.html#VALdumpGlobal"><code class="code">Cil.dumpGlobal</code></a> instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdn_exp"></a>dn_exp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Versions of the above pretty printers, that don't print #line directives<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdn_lval"></a>dn_lval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_init"></a>dn_init : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_type"></a>dn_type : <code class="type">unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_global"></a>dn_global : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_attrlist"></a>dn_attrlist : <code class="type">unit -> <a href="Cil.html#TYPEattributes">attributes</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_attr"></a>dn_attr : <code class="type">unit -> <a href="Cil.html#TYPEattribute">attribute</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_attrparam"></a>dn_attrparam : <code class="type">unit -> <a href="Cil.html#TYPEattrparam">attrparam</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_stmt"></a>dn_stmt : <code class="type">unit -> <a href="Cil.html#TYPEstmt">stmt</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALdn_instr"></a>dn_instr : <code class="type">unit -> <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALd_shortglobal"></a>d_shortglobal : <code class="type">unit -> <a href="Cil.html#TYPEglobal">global</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print a short description of the global. This is useful for error
+ messages<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdumpGlobal"></a>dumpGlobal : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> <a href="Cil.html#TYPEglobal">global</a> -> unit</code></pre><div class="info">
+Pretty-print a global. Here you give the channel where the printout
+ should be sent.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdumpFile"></a>dumpFile : <code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a> -> Pervasives.out_channel -> string -> <a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
+Pretty-print an entire file. Here you give the channel where the printout
+ should be sent.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALbug"></a>bug : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALbug"><code class="code">Errormsg.bug</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunimp"></a>unimp : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALunimp"><code class="code">Errormsg.unimp</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>is also printed<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALerror"></a>error : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALerrorLoc"></a>errorLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> -> ('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Cil.html#VALerror"><code class="code">Cil.error</code></a> except that it explicitly takes a location argument,
+ instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarn"></a>warn : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarnOpt"></a>warnOpt : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALwarnOpt"><code class="code">Errormsg.warnOpt</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed.
+ This warning is printed only of <a href="Errormsg.html#VALwarnFlag"><code class="code">Errormsg.warnFlag</code></a> is set.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarnContext"></a>warnContext : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context
+ is also printed<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarnContextOpt"></a>warnContextOpt : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context is also
+ printed. This warning is printed only of <a href="Errormsg.html#VALwarnFlag"><code class="code">Errormsg.warnFlag</code></a> is set.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarnLoc"></a>warnLoc : <code class="type"><a href="Cil.html#TYPElocation">location</a> -> ('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Cil.html#VALwarn"><code class="code">Cil.warn</code></a> except that it explicitly takes a location argument,
+ instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a><br>
+</div>
+<br>
+Sometimes you do not want to see the syntactic sugar that the above
+ pretty-printing functions add. In that case you can use the following
+ pretty-printing functions. But note that the output of these functions is
+ not valid C<br>
+<pre><span class="keyword">val</span> <a name="VALd_plainexp"></a>d_plainexp : <code class="type">unit -> <a href="Cil.html#TYPEexp">exp</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the internal representation of an expression<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_plaininit"></a>d_plaininit : <code class="type">unit -> <a href="Cil.html#TYPEinit">init</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the internal representation of an integer<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_plainlval"></a>d_plainlval : <code class="type">unit -> <a href="Cil.html#TYPElval">lval</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the internal representation of an lvalue<br>
+</div>
+<br>
+Pretty-print the internal representation of an lvalue offset
+val d_plainoffset: unit -&gt; offset -&gt; Pretty.doc<br>
+<pre><span class="keyword">val</span> <a name="VALd_plaintype"></a>d_plaintype : <code class="type">unit -> <a href="Cil.html#TYPEtyp">typ</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the internal representation of a type<br>
+</div>
+<br>
+<b>ALPHA conversion</b> has been moved to the Alpha module.<br>
+<pre><span class="keyword">val</span> <a name="VALuniqueVarNames"></a>uniqueVarNames : <code class="type"><a href="Cil.html#TYPEfile">file</a> -> unit</code></pre><div class="info">
+Assign unique names to local variables. This might be necessary after you
+ transformed the code and added or renamed some new variables. Names are
+ not used by CIL internally, but once you print the file out the compiler
+ downstream might be confused. You might
+ have added a new global that happens to have the same name as a local in
+ some function. Rename the local to ensure that there would never be
+ confusioin. Or, viceversa, you might have added a local with a name that
+ conflicts with a global<br>
+</div>
+<br>
+<b>Optimization Passes</b><br>
+<pre><span class="keyword">val</span> <a name="VALpeepHole2"></a>peepHole2 : <code class="type">(<a href="Cil.html#TYPEinstr">instr</a> * <a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list option) -> <a href="Cil.html#TYPEstmt">stmt</a> list -> unit</code></pre><div class="info">
+A peephole optimizer that processes two adjacent statements and possibly
+ replaces them both. If some replacement happens, then the new statements
+ are themselves subject to optimization<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALpeepHole1"></a>peepHole1 : <code class="type">(<a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPEinstr">instr</a> list option) -> <a href="Cil.html#TYPEstmt">stmt</a> list -> unit</code></pre><div class="info">
+Similar to <code class="code">peepHole2</code> except that the optimization window consists of
+ one statement, not two<br>
+</div>
+<br>
+<b>Machine dependency</b><br>
+<pre><span class="keyword">exception</span> <a name="EXCEPTIONSizeOfError"></a>SizeOfError <span class="keyword">of</span> <code class="type">string * <a href="Cil.html#TYPEtyp">typ</a></code></pre>
+<div class="info">
+Raised when one of the bitsSizeOf functions cannot compute the size of a
+ type. This can happen because the type contains array-length expressions
+ that we don't know how to compute or because it is a type whose size is
+ not defined (e.g. TFun or an undefined compinfo). The string is an
+ explanation of the error<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALbitsSizeOf"></a>bitsSizeOf : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> int</code></pre><div class="info">
+The size of a type, in bits. Trailing padding is added for structs and
+ arrays. Raises <a href="Cil.html#EXCEPTIONSizeOfError"><code class="code">Cil.SizeOfError</code></a> when it cannot compute the size. This
+ function is architecture dependent, so you should only call this after you
+ call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>. Remember that on GCC sizeof(void) is 1!<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsizeOf"></a>sizeOf : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><pre><span class="keyword">val</span> <a name="VALalignOf_int"></a>alignOf_int : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> int</code></pre><div class="info">
+The minimum alignment (in bytes) for a type. This function is
+ architecture dependent, so you should only call this after you call
+ <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALbitsOffset"></a>bitsOffset : <code class="type"><a href="Cil.html#TYPEtyp">typ</a> -> <a href="Cil.html#TYPEoffset">offset</a> -> int * int</code></pre><div class="info">
+Give a type of a base and an offset, returns the number of bits from the
+ base address and the width (also expressed in bits) for the subobject
+ denoted by the offset. Raises <a href="Cil.html#EXCEPTIONSizeOfError"><code class="code">Cil.SizeOfError</code></a> when it cannot compute
+ the size. This function is architecture dependent, so you should only call
+ this after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALchar_is_unsigned"></a>char_is_unsigned : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether "char" is unsigned. Set after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlittle_endian"></a>little_endian : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether the machine is little endian. Set after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunderscore_name"></a>underscore_name : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether the compiler generates assembly labels by prepending "_" to the
+ identifier. That is, will function foo() have the label "foo", or "_foo"?
+ Set after you call <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlocUnknown"></a>locUnknown : <code class="type"><a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
+Represents a location that cannot be determined<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALget_instrLoc"></a>get_instrLoc : <code class="type"><a href="Cil.html#TYPEinstr">instr</a> -> <a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
+Return the location of an instruction<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALget_globalLoc"></a>get_globalLoc : <code class="type"><a href="Cil.html#TYPEglobal">global</a> -> <a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
+Return the location of a global, or locUnknown<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALget_stmtLoc"></a>get_stmtLoc : <code class="type"><a href="Cil.html#TYPEstmtkind">stmtkind</a> -> <a href="Cil.html#TYPElocation">location</a></code></pre><div class="info">
+Return the location of a statement, or locUnknown<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdExp"></a>dExp : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPEexp">exp</a></code></pre><div class="info">
+Generate an <a href="Cil.html#TYPEexp"><code class="code">Cil.exp</code></a> to be used in case of errors.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdInstr"></a>dInstr : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Cil.html#TYPEinstr">instr</a></code></pre><div class="info">
+Generate an <a href="Cil.html#TYPEinstr"><code class="code">Cil.instr</code></a> to be used in case of errors.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdGlobal"></a>dGlobal : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Cil.html#TYPElocation">location</a> -> <a href="Cil.html#TYPEglobal">global</a></code></pre><div class="info">
+Generate a <a href="Cil.html#TYPEglobal"><code class="code">Cil.global</code></a> to be used in case of errors.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmapNoCopy"></a>mapNoCopy : <code class="type">('a -> 'a) -> 'a list -> 'a list</code></pre><div class="info">
+Like map but try not to make a copy of the list<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmapNoCopyList"></a>mapNoCopyList : <code class="type">('a -> 'a list) -> 'a list -> 'a list</code></pre><div class="info">
+Like map but each call can return a list. Try not to make a copy of the
+ list<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALstartsWith"></a>startsWith : <code class="type">string -> string -> bool</code></pre><div class="info">
+sm: return true if the first is a prefix of the second string<br>
+</div>
+<br>
+<b>An Interpreter for constructing CIL constructs</b><br>
+<br><code><span class="keyword">type</span> <a name="TYPEformatArg"></a><code class="type"></code>formatArg = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fe</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Feo</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> option</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For array lengths</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fu</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEunop">unop</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fb</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEbinop">binop</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fk</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEikind">ikind</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FE</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEexp">exp</a> list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For arguments in a function call</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Ff</span> <span class="keyword">of</span> <code class="type">(string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>)</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For a formal argument</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FF</span> <span class="keyword">of</span> <code class="type">(string * <a href="Cil.html#TYPEtyp">typ</a> * <a href="Cil.html#TYPEattributes">attributes</a>) list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For formal argument lists</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fva</span> <span class="keyword">of</span> <code class="type">bool</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>For the ellipsis in a function type</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fv</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEvarinfo">varinfo</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fl</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Flo</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPElval">lval</a> option</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fo</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEoffset">offset</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fc</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEcompinfo">compinfo</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fi</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEinstr">instr</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FI</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEinstr">instr</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Ft</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEtyp">typ</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fd</span> <span class="keyword">of</span> <code class="type">int</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fg</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fs</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEstmt">stmt</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FS</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEstmt">stmt</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FA</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattributes">attributes</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Fp</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a></code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FP</span> <span class="keyword">of</span> <code class="type"><a href="Cil.html#TYPEattrparam">attrparam</a> list</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">FX</span> <span class="keyword">of</span> <code class="type">string</code></code></td>
+
+</tr></table>
+
+<div class="info">
+The type of argument for the interpreter<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALd_formatarg"></a>d_formatarg : <code class="type">unit -> <a href="Cil.html#TYPEformatArg">formatArg</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-prints a format arg<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlowerConstants"></a>lowerConstants : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Do lower constant expressions into constants (default true)<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cil.nopCilVisitor.html b/cil/doc/api/Cil.nopCilVisitor.html
new file mode 100644
index 0000000..868e79d
--- /dev/null
+++ b/cil/doc/api/Cil.nopCilVisitor.html
@@ -0,0 +1,35 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="next" href="Cil.defaultCilPrinterClass.html">
+<link rel="Up" href="Cil.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.nopCilVisitor</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a href="Cil.html">Up</a>
+&nbsp;<a href="Cil.defaultCilPrinterClass.html">Next</a>
+</div>
+<center><h1>Class <a href="type_Cil.nopCilVisitor.html">Cil.nopCilVisitor</a></h1></center>
+<br>
+<pre><span class="keyword">class</span> <a name="TYPEnopCilVisitor"></a>nopCilVisitor : <code class="type"></code><code class="type"><a href="Cil.cilVisitor.html">cilVisitor</a></code></pre>Default Visitor. Traverses the CIL tree without modifying anything<br>
+<hr width="100%">
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cil.plainCilPrinterClass.html b/cil/doc/api/Cil.plainCilPrinterClass.html
new file mode 100644
index 0000000..0d5fca5
--- /dev/null
+++ b/cil/doc/api/Cil.plainCilPrinterClass.html
@@ -0,0 +1,36 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Cil.defaultCilPrinterClass.html">
+<link rel="Up" href="Cil.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.plainCilPrinterClass</title>
+</head>
+<body>
+<div class="navbar"><a href="Cil.defaultCilPrinterClass.html">Previous</a>
+&nbsp;<a href="Cil.html">Up</a>
+&nbsp;</div>
+<center><h1>Class <a href="type_Cil.plainCilPrinterClass.html">Cil.plainCilPrinterClass</a></h1></center>
+<br>
+<pre><span class="keyword">class</span> <a name="TYPEplainCilPrinterClass"></a>plainCilPrinterClass : <code class="type"></code><code class="type"><a href="Cil.cilPrinter.html">cilPrinter</a></code></pre>These are pretty-printers that will show you more details on the internal
+ CIL representation, without trying hard to make it look like C<br>
+<hr width="100%">
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Cillower.html b/cil/doc/api/Cillower.html
new file mode 100644
index 0000000..d8fa8dd
--- /dev/null
+++ b/cil/doc/api/Cillower.html
@@ -0,0 +1,40 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Alpha.html">
+<link rel="next" href="Cfg.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cillower</title>
+</head>
+<body>
+<div class="navbar"><a href="Alpha.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Cfg.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Cillower.html">Cillower</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Cillower: <code class="code">sig</code> <a href="Cillower.html">..</a> <code class="code">end</code></pre>A number of lowering passes over CIL<br>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALlowerEnumVisitor"></a>lowerEnumVisitor : <code class="type"><a href="Cil.cilVisitor.html">Cil.cilVisitor</a></code></pre><div class="info">
+Replace enumeration constants with integer constants<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Clist.html b/cil/doc/api/Clist.html
new file mode 100644
index 0000000..27f373e
--- /dev/null
+++ b/cil/doc/api/Clist.html
@@ -0,0 +1,118 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Errormsg.html">
+<link rel="next" href="Stats.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Clist</title>
+</head>
+<body>
+<div class="navbar"><a href="Errormsg.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Stats.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Clist.html">Clist</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Clist: <code class="code">sig</code> <a href="Clist.html">..</a> <code class="code">end</code></pre>Utilities for managing "concatenable lists" (clists). We often need to
+ concatenate sequences, and using lists for this purpose is expensive. This
+ module provides routines to manage such lists more efficiently. In this
+ model, we never do cons or append explicitly. Instead we maintain
+ the elements of the list in a special data structure. Routines are provided
+ to convert to/from ordinary lists, and carry out common list operations.<br>
+<hr width="100%">
+<br><code><span class="keyword">type</span> <a name="TYPEclist"></a><code class="type">'a</code> clist = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CList</span> <span class="keyword">of</span> <code class="type">'a list</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The only representation for the empty
+ list. Try to use sparingly.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CConsL</span> <span class="keyword">of</span> <code class="type">'a * 'a <a href="Clist.html#TYPEclist">clist</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not use this a lot because scanning
+ it is not tail recursive</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CConsR</span> <span class="keyword">of</span> <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> * 'a</code></code></td>
+
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">CSeq</span> <span class="keyword">of</span> <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> * 'a <a href="Clist.html#TYPEclist">clist</a></code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>We concatenate only two of them at this
+ time. Neither is the empty clist. To be
+ sure always use append to make these</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+<div class="info">
+The clist datatype. A clist can be an ordinary list, or a clist preceded
+ or followed by an element, or two clists implicitly appended together<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALtoList"></a>toList : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> 'a list</code></pre><div class="info">
+Convert a clist to an ordinary list<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfromList"></a>fromList : <code class="type">'a list -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
+Convert an ordinary list to a clist<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsingle"></a>single : <code class="type">'a -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
+Create a clist containing one element<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALempty"></a>empty : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
+The empty clist<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALappend"></a>append : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
+Append two clists<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcheckBeforeAppend"></a>checkBeforeAppend : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a> -> bool</code></pre><div class="info">
+A useful check to assert before an append. It checks that the two lists
+ are not identically the same (Except if they are both empty)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlength"></a>length : <code class="type">'a <a href="Clist.html#TYPEclist">clist</a> -> int</code></pre><div class="info">
+Find the length of a clist<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmap"></a>map : <code class="type">('a -> 'b) -> 'a <a href="Clist.html#TYPEclist">clist</a> -> 'b <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
+Map a function over a clist. Returns another clist<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfold_left"></a>fold_left : <code class="type">('a -> 'b -> 'a) -> 'a -> 'b <a href="Clist.html#TYPEclist">clist</a> -> 'a</code></pre><div class="info">
+A version of fold_left that works on clists<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALiter"></a>iter : <code class="type">('a -> unit) -> 'a <a href="Clist.html#TYPEclist">clist</a> -> unit</code></pre><div class="info">
+A version of iter that works on clists<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALrev"></a>rev : <code class="type">('a -> 'a) -> 'a <a href="Clist.html#TYPEclist">clist</a> -> 'a <a href="Clist.html#TYPEclist">clist</a></code></pre><div class="info">
+Reverse a clist. The first function reverses an element.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdocCList"></a>docCList : <code class="type"><a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> ('a -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> 'a <a href="Clist.html#TYPEclist">clist</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+A document for printing a clist (similar to <code class="code">docList</code>)<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Dataflow.BackwardsDataFlow.html b/cil/doc/api/Dataflow.BackwardsDataFlow.html
new file mode 100644
index 0000000..782d318
--- /dev/null
+++ b/cil/doc/api/Dataflow.BackwardsDataFlow.html
@@ -0,0 +1,54 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Dataflow.ForwardsDataFlow.html">
+<link rel="Up" href="Dataflow.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsDataFlow</title>
+</head>
+<body>
+<div class="navbar"><a href="Dataflow.ForwardsDataFlow.html">Previous</a>
+&nbsp;<a href="Dataflow.html">Up</a>
+&nbsp;</div>
+<center><h1>Functor <a href="type_Dataflow.BackwardsDataFlow.html">Dataflow.BackwardsDataFlow</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> BackwardsDataFlow: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a></code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Dataflow.BackwardsDataFlow.html">..</a> <code class="code">end</code></div></pre><table border="0" cellpadding="3" width="100%">
+<tr>
+<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
+<td>
+<table class="paramstable">
+<tr>
+<td align="center" valign="top" width="15%">
+<code>T</code></td>
+<td align="center" valign="top">:</td>
+<td><code class="type"><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a></code>
+</table>
+</td>
+</tr>
+</table>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALcompute"></a>compute : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> list -> unit</code></pre><div class="info">
+Fill in the T.stmtStartData, given a number of initial statements to
+ start from (the sinks for the backwards data flow). All of the statements
+ (not just the initial ones!) must have some entry in T.stmtStartData
+ (i.e., the initial data should not be bottom)<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Dataflow.BackwardsTransfer.html b/cil/doc/api/Dataflow.BackwardsTransfer.html
new file mode 100644
index 0000000..0ff812d
--- /dev/null
+++ b/cil/doc/api/Dataflow.BackwardsTransfer.html
@@ -0,0 +1,83 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Dataflow.ForwardsTransfer.html">
+<link rel="Up" href="Dataflow.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsTransfer</title>
+</head>
+<body>
+<div class="navbar"><a href="Dataflow.ForwardsTransfer.html">Previous</a>
+&nbsp;<a href="Dataflow.html">Up</a>
+&nbsp;</div>
+<center><h1>Module type <a href="type_Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a></h1></center>
+<br>
+<pre><span class="keyword">module type</span> BackwardsTransfer = <code class="code">sig</code> <a href="Dataflow.BackwardsTransfer.html">..</a> <code class="code">end</code></pre><hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALname"></a>name : <code class="type">string</code></pre><div class="info">
+For debugging purposes, the name of the analysis<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdebug"></a>debug : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether to turn on debugging<br>
+</div>
+<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
+<div class="info">
+The type of the data we compute for each block start. In many
+ presentations of backwards data flow analysis we maintain the
+ data at the block end. This is not easy to do with JVML because
+ a block has many exceptional ends. So we maintain the data for
+ the statement start.<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALpretty"></a>pretty : <code class="type">unit -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the state<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALstmtStartData"></a>stmtStartData : <code class="type"><a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> Inthash.t</code></pre><div class="info">
+For each block id, the data at the start. This data structure must be
+ initialized with the initial data for each block<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcombineStmtStartData"></a>combineStmtStartData : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -><br> old:<a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> option</code></pre><div class="info">
+When the analysis reaches the start of a block, combine the old data
+ with the one we have just computed. Return None if the combination is
+ the same as the old data, otherwise return the combination. In the
+ latter case, the predecessors of the statement are put on the working
+ list.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcombineSuccessors"></a>combineSuccessors : <code class="type"><a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a></code></pre><div class="info">
+Take the data from two successors and combine it<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdoStmt"></a>doStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEaction">Dataflow.action</a></code></pre><div class="info">
+The (backwards) transfer function for a branch. The <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is
+ set before calling this. If it returns None, then we have some default
+ handling. Otherwise, the returned data is the data before the branch
+ (not considering the exception handlers)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdoInstr"></a>doInstr : <code class="type"><a href="Cil.html#TYPEinstr">Cil.instr</a> -><br> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEaction">Dataflow.action</a></code></pre><div class="info">
+The (backwards) transfer function for an instruction. The
+ <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is set before calling this. If it returns None, then we
+ have some default handling. Otherwise, the returned data is the data
+ before the branch (not considering the exception handlers)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfilterStmt"></a>filterStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> bool</code></pre><div class="info">
+Whether to put this predecessor block in the worklist. We give the
+ predecessor and the block whose predecessor we are (and whose data has
+ changed)<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Dataflow.ForwardsDataFlow.html b/cil/doc/api/Dataflow.ForwardsDataFlow.html
new file mode 100644
index 0000000..760dc2b
--- /dev/null
+++ b/cil/doc/api/Dataflow.ForwardsDataFlow.html
@@ -0,0 +1,53 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="next" href="Dataflow.BackwardsDataFlow.html">
+<link rel="Up" href="Dataflow.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsDataFlow</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a href="Dataflow.html">Up</a>
+&nbsp;<a href="Dataflow.BackwardsDataFlow.html">Next</a>
+</div>
+<center><h1>Functor <a href="type_Dataflow.ForwardsDataFlow.html">Dataflow.ForwardsDataFlow</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> ForwardsDataFlow: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a></code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Dataflow.ForwardsDataFlow.html">..</a> <code class="code">end</code></div></pre><table border="0" cellpadding="3" width="100%">
+<tr>
+<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
+<td>
+<table class="paramstable">
+<tr>
+<td align="center" valign="top" width="15%">
+<code>T</code></td>
+<td align="center" valign="top">:</td>
+<td><code class="type"><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a></code>
+</table>
+</td>
+</tr>
+</table>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALcompute"></a>compute : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> list -> unit</code></pre><div class="info">
+Fill in the T.stmtStartData, given a number of initial statements to
+ start from. All of the initial statements must have some entry in
+ T.stmtStartData (i.e., the initial data should not be bottom)<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Dataflow.ForwardsTransfer.html b/cil/doc/api/Dataflow.ForwardsTransfer.html
new file mode 100644
index 0000000..dbefaa0
--- /dev/null
+++ b/cil/doc/api/Dataflow.ForwardsTransfer.html
@@ -0,0 +1,88 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="next" href="Dataflow.BackwardsTransfer.html">
+<link rel="Up" href="Dataflow.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsTransfer</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a href="Dataflow.html">Up</a>
+&nbsp;<a href="Dataflow.BackwardsTransfer.html">Next</a>
+</div>
+<center><h1>Module type <a href="type_Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a></h1></center>
+<br>
+<pre><span class="keyword">module type</span> ForwardsTransfer = <code class="code">sig</code> <a href="Dataflow.ForwardsTransfer.html">..</a> <code class="code">end</code></pre><hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALname"></a>name : <code class="type">string</code></pre><div class="info">
+For debugging purposes, the name of the analysis<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdebug"></a>debug : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Whether to turn on debugging<br>
+</div>
+<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
+<div class="info">
+The type of the data we compute for each block start. May be
+ imperative.<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALcopy"></a>copy : <code class="type"><a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a></code></pre><div class="info">
+Make a deep copy of the data<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALstmtStartData"></a>stmtStartData : <code class="type"><a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> Inthash.t</code></pre><div class="info">
+For each statement id, the data at the start. Not found in the hash
+ table means nothing is known about the state at this point. At the end
+ of the analysis this means that the block is not reachable.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALpretty"></a>pretty : <code class="type">unit -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Pretty-print the state<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcomputeFirstPredecessor"></a>computeFirstPredecessor : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a></code></pre><div class="info">
+Give the first value for a predecessors, compute the value to be set
+ for the block<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcombinePredecessors"></a>combinePredecessors : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -><br> old:<a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> option</code></pre><div class="info">
+Take some old data for the start of a statement, and some new data for
+ the same point. Return None if the combination is identical to the old
+ data. Otherwise, compute the combination, and return it.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdoInstr"></a>doInstr : <code class="type"><a href="Cil.html#TYPEinstr">Cil.instr</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEaction">Dataflow.action</a></code></pre><div class="info">
+The (forwards) transfer function for an instruction. The
+ <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is set before calling this. The default action is to
+ continue with the state unchanged.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdoStmt"></a>doStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEstmtaction">Dataflow.stmtaction</a></code></pre><div class="info">
+The (forwards) transfer function for a statement. The <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
+ is set before calling this. The default action is to do the instructions
+ in this statement, if applicable, and continue with the successors.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdoGuard"></a>doGuard : <code class="type"><a href="Cil.html#TYPEexp">Cil.exp</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> -><br> <a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> <a href="Dataflow.html#TYPEguardaction">Dataflow.guardaction</a></code></pre><div class="info">
+Generate the successor to an If statement assuming the given expression
+ is nonzero. Analyses that don't need guard information can return
+ GDefault; this is equivalent to returning GUse of the input.
+ A return value of GUnreachable indicates that this half of the branch
+ will not be taken and should not be explored. This will be called
+ twice per If, once for "then" and once for "else".<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfilterStmt"></a>filterStmt : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> -> bool</code></pre><div class="info">
+Whether to put this statement in the worklist. This is called when a
+ block would normally be put in the worklist.<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Dataflow.html b/cil/doc/api/Dataflow.html
new file mode 100644
index 0000000..9f744ea
--- /dev/null
+++ b/cil/doc/api/Dataflow.html
@@ -0,0 +1,114 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Cfg.html">
+<link rel="next" href="Dominators.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow</title>
+</head>
+<body>
+<div class="navbar"><a href="Cfg.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Dominators.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Dataflow.html">Dataflow</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Dataflow: <code class="code">sig</code> <a href="Dataflow.html">..</a> <code class="code">end</code></pre>A framework for data flow analysis for CIL code. Before using
+ this framework, you must initialize the Control-flow Graph for your
+ program, e.g using <a href="Cfg.html#VALcomputeFileCFG"><code class="code">Cfg.computeFileCFG</code></a><br>
+<hr width="100%">
+<br><code><span class="keyword">type</span> <a name="TYPEaction"></a><code class="type">'a</code> action = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Default</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default action</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Done</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not do the default action. Use this result</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">Post</span> <span class="keyword">of</span> <code class="type">('a -> 'a)</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default action, followed by the given
+ transformer</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+
+<br><code><span class="keyword">type</span> <a name="TYPEstmtaction"></a><code class="type">'a</code> stmtaction = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SDefault</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default action</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SDone</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Do not visit this statement or its successors</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">SUse</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Visit the instructions and successors of this statement
+ as usual, but use the specified state instead of the
+ one that was passed to doStmt</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+
+<br><code><span class="keyword">type</span> <a name="TYPEguardaction"></a><code class="type">'a</code> guardaction = </code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GDefault</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The default state</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GUse</span> <span class="keyword">of</span> <code class="type">'a</code></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>Use this data for the branch</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code><span class="keyword">|</span></code></td>
+<td align="left" valign="top" >
+<code><span class="constructor">GUnreachable</span></code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The branch will never be taken.</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+
+
+<pre><span class="keyword">module type</span> <a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a> = <code class="code">sig</code> <a href="Dataflow.ForwardsTransfer.html">..</a> <code class="code">end</code></pre><pre><span class="keyword">module</span> <a href="Dataflow.ForwardsDataFlow.html">ForwardsDataFlow</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a></code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Dataflow.ForwardsDataFlow.html">..</a> <code class="code">end</code></div></pre><pre><span class="keyword">module type</span> <a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a> = <code class="code">sig</code> <a href="Dataflow.BackwardsTransfer.html">..</a> <code class="code">end</code></pre><pre><span class="keyword">module</span> <a href="Dataflow.BackwardsDataFlow.html">BackwardsDataFlow</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">T</code><code class="code"> : </code><code class="type"><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a></code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Dataflow.BackwardsDataFlow.html">..</a> <code class="code">end</code></div></pre></body></html> \ No newline at end of file
diff --git a/cil/doc/api/Dominators.html b/cil/doc/api/Dominators.html
new file mode 100644
index 0000000..4d8eaf9
--- /dev/null
+++ b/cil/doc/api/Dominators.html
@@ -0,0 +1,58 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Dataflow.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dominators</title>
+</head>
+<body>
+<div class="navbar"><a href="Dataflow.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;</div>
+<center><h1>Module <a href="type_Dominators.html">Dominators</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Dominators: <code class="code">sig</code> <a href="Dominators.html">..</a> <code class="code">end</code></pre>Compute dominators using data flow analysis<br>
+<hr width="100%">
+<br>
+Author: George Necula
+ 5/28/2004
+<br>
+<pre><span class="keyword">val</span> <a name="VALcomputeIDom"></a>computeIDom : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t</code></pre><div class="info">
+Invoke on a code after filling in the CFG info and it computes the
+ immediate dominator information. We map each statement to its immediate
+ dominator (None for the start statement, and for the unreachable
+ statements).<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALgetIdom"></a>getIdom : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> option</code></pre><div class="info">
+This is like Inthash.find but gives an error if the information is
+ Not_found<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdominates"></a>dominates : <code class="type"><a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> -> bool</code></pre><div class="info">
+Check whether one statement dominates another.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfindNaturalLoops"></a>findNaturalLoops : <code class="type"><a href="Cil.html#TYPEfundec">Cil.fundec</a> -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> option Inthash.t -> (<a href="Cil.html#TYPEstmt">Cil.stmt</a> * <a href="Cil.html#TYPEstmt">Cil.stmt</a> list) list</code></pre><div class="info">
+Compute the start of the natural loops. This assumes that the "idom"
+ field has been computed. For each start, keep a list of origin of a back
+ edge. The loop consists of the loop start and all predecessors of the
+ origins of back edges, up to and including the loop start<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Errormsg.html b/cil/doc/api/Errormsg.html
new file mode 100644
index 0000000..bc19472
--- /dev/null
+++ b/cil/doc/api/Errormsg.html
@@ -0,0 +1,141 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Pretty.html">
+<link rel="next" href="Clist.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Errormsg</title>
+</head>
+<body>
+<div class="navbar"><a href="Pretty.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Clist.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Errormsg.html">Errormsg</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Errormsg: <code class="code">sig</code> <a href="Errormsg.html">..</a> <code class="code">end</code></pre>Utility functions for error-reporting<br>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALlogChannel"></a>logChannel : <code class="type">Pervasives.out_channel Pervasives.ref</code></pre><div class="info">
+A channel for printing log messages<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdebugFlag"></a>debugFlag : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+If set then print debugging info<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALverboseFlag"></a>verboseFlag : <code class="type">bool Pervasives.ref</code></pre><pre><span class="keyword">val</span> <a name="VALwarnFlag"></a>warnFlag : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Set to true if you want to see all warnings.<br>
+</div>
+<pre><span class="keyword">exception</span> <a name="EXCEPTIONError"></a>Error</pre>
+<div class="info">
+Error reporting functions raise this exception<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALerror"></a>error : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Prints an error message of the form <code class="code">Error: ...</code>.
+ Use in conjunction with s, for example: <code class="code">E.s (E.error ... )</code>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALbug"></a>bug : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Similar to <code class="code">error</code> except that its output has the form <code class="code">Bug: ...</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunimp"></a>unimp : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Similar to <code class="code">error</code> except that its output has the form <code class="code">Unimplemented: ...</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALs"></a>s : <code class="type">'a -> 'b</code></pre><div class="info">
+Stop the execution by raising an Error.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALhadErrors"></a>hadErrors : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+This is set whenever one of the above error functions are called. It must
+ be cleared manually<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarn"></a>warn : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> but does not raise the <a href="Errormsg.html#EXCEPTIONError"><code class="code">Errormsg.Error</code></a>
+ exception. Return type is unit.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwarnOpt"></a>warnOpt : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> but optional. Printed only if the
+ <a href="Errormsg.html#VALwarnFlag"><code class="code">Errormsg.warnFlag</code></a> is set<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlog"></a>log : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Print something to <code class="code">logChannel</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlogg"></a>logg : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+same as <a href="Errormsg.html#VALlog"><code class="code">Errormsg.log</code></a> but do not wrap lines<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnull"></a>null : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">Pretty.doc</a>, unit) format4 -> 'a</code></pre><div class="info">
+Do not actually print (i.e. print to /dev/null)<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALpushContext"></a>pushContext : <code class="type">(unit -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit</code></pre><div class="info">
+Registers a context printing function<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALpopContext"></a>popContext : <code class="type">unit -> unit</code></pre><div class="info">
+Removes the last registered context printing function<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALshowContext"></a>showContext : <code class="type">unit -> unit</code></pre><div class="info">
+Show the context stack to stderr<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwithContext"></a>withContext : <code class="type">(unit -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> ('a -> 'b) -> 'a -> 'b</code></pre><div class="info">
+To ensure that the context is registered and removed properly, use the
+ function below<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnewline"></a>newline : <code class="type">unit -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALnewHline"></a>newHline : <code class="type">unit -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALgetPosition"></a>getPosition : <code class="type">unit -> int * string * int</code></pre><pre><span class="keyword">val</span> <a name="VALgetHPosition"></a>getHPosition : <code class="type">unit -> int * string</code></pre><div class="info">
+high-level position<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsetHLine"></a>setHLine : <code class="type">int -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALsetHFile"></a>setHFile : <code class="type">string -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALsetCurrentLine"></a>setCurrentLine : <code class="type">int -> unit</code></pre><pre><span class="keyword">val</span> <a name="VALsetCurrentFile"></a>setCurrentFile : <code class="type">string -> unit</code></pre><br><code><span class="keyword">type</span> <a name="TYPElocation"></a><code class="type"></code>location = {</code><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>file&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The file name</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>line&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The line number</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>hfile&nbsp;: <code class="type">string</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The high-level file name, or "" if not present</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr>
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code>hline&nbsp;: <code class="type">int</code>;</code></td>
+<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><code>The high-level line number, or 0 if not present</code></td><td class="typefieldcomment" align="left" valign="bottom" ><code>*)</code></td>
+</tr></table>
+}
+
+<div class="info">
+Type for source-file locations<br>
+</div>
+
+<pre><span class="keyword">val</span> <a name="VALd_loc"></a>d_loc : <code class="type">unit -> <a href="Errormsg.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALd_hloc"></a>d_hloc : <code class="type">unit -> <a href="Errormsg.html#TYPElocation">location</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALgetLocation"></a>getLocation : <code class="type">unit -> <a href="Errormsg.html#TYPElocation">location</a></code></pre><pre><span class="keyword">val</span> <a name="VALparse_error"></a>parse_error : <code class="type">string -> 'a</code></pre><pre><span class="keyword">val</span> <a name="VALlocUnknown"></a>locUnknown : <code class="type"><a href="Errormsg.html#TYPElocation">location</a></code></pre><div class="info">
+An unknown location for use when you need one but you don't have one<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALreadingFromStdin"></a>readingFromStdin : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+Records whether the stdin is open for reading the goal *<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALstartParsing"></a>startParsing : <code class="type">?useBasename:bool -> string -> Lexing.lexbuf</code></pre><pre><span class="keyword">val</span> <a name="VALstartParsingFromString"></a>startParsingFromString : <code class="type">?file:string -> ?line:int -> string -> Lexing.lexbuf</code></pre><pre><span class="keyword">val</span> <a name="VALfinishParsing"></a>finishParsing : <code class="type">unit -> unit</code></pre></body></html> \ No newline at end of file
diff --git a/cil/doc/api/Formatcil.html b/cil/doc/api/Formatcil.html
new file mode 100644
index 0000000..8dee76d
--- /dev/null
+++ b/cil/doc/api/Formatcil.html
@@ -0,0 +1,84 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Cil.html">
+<link rel="next" href="Alpha.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Formatcil</title>
+</head>
+<body>
+<div class="navbar"><a href="Cil.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Alpha.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Formatcil.html">Formatcil</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Formatcil: <code class="code">sig</code> <a href="Formatcil.html">..</a> <code class="code">end</code></pre><b>An Interpreter for constructing CIL constructs</b><br>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALcExp"></a>cExp : <code class="type">string -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEexp">Cil.exp</a></code></pre><div class="info">
+Constructs an expression based on the program and the list of arguments.
+ Each argument consists of a name followed by the actual data. This
+ argument will be placed instead of occurrences of "%v:name" in the pattern
+ (where the "v" is dependent on the type of the data). The parsing of the
+ string is memoized. * Only the first expression is parsed.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcLval"></a>cLval : <code class="type">string -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPElval">Cil.lval</a></code></pre><div class="info">
+Constructs an lval based on the program and the list of arguments.
+ Only the first lvalue is parsed.
+ The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcType"></a>cType : <code class="type">string -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEtyp">Cil.typ</a></code></pre><div class="info">
+Constructs a type based on the program and the list of arguments.
+ Only the first type is parsed.
+ The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcInstr"></a>cInstr : <code class="type">string -> <a href="Cil.html#TYPElocation">Cil.location</a> -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEinstr">Cil.instr</a></code></pre><div class="info">
+Constructs an instruction based on the program and the list of arguments.
+ Only the first instruction is parsed.
+ The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcStmt"></a>cStmt : <code class="type">string -><br> (string -> <a href="Cil.html#TYPEtyp">Cil.typ</a> -> <a href="Cil.html#TYPEvarinfo">Cil.varinfo</a>) -><br> <a href="Cil.html#TYPElocation">Cil.location</a> -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEstmt">Cil.stmt</a></code></pre><pre><span class="keyword">val</span> <a name="VALcStmts"></a>cStmts : <code class="type">string -><br> (string -> <a href="Cil.html#TYPEtyp">Cil.typ</a> -> <a href="Cil.html#TYPEvarinfo">Cil.varinfo</a>) -><br> <a href="Cil.html#TYPElocation">Cil.location</a> -> (string * <a href="Cil.html#TYPEformatArg">Cil.formatArg</a>) list -> <a href="Cil.html#TYPEstmt">Cil.stmt</a> list</code></pre><div class="info">
+Constructs a list of statements<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdExp"></a>dExp : <code class="type">string -> <a href="Cil.html#TYPEexp">Cil.exp</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
+Deconstructs an expression based on the program. Produces an optional
+ list of format arguments. The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdLval"></a>dLval : <code class="type">string -> <a href="Cil.html#TYPElval">Cil.lval</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
+Deconstructs an lval based on the program. Produces an optional
+ list of format arguments. The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdType"></a>dType : <code class="type">string -> <a href="Cil.html#TYPEtyp">Cil.typ</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
+Deconstructs a type based on the program. Produces an optional list of
+ format arguments. The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdInstr"></a>dInstr : <code class="type">string -> <a href="Cil.html#TYPEinstr">Cil.instr</a> -> <a href="Cil.html#TYPEformatArg">Cil.formatArg</a> list option</code></pre><div class="info">
+Deconstructs an instruction based on the program. Produces an optional
+ list of format arguments. The parsing of the string is memoized.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnoMemoize"></a>noMemoize : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+If set then will not memoize the parsed patterns<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtest"></a>test : <code class="type">unit -> unit</code></pre><div class="info">
+Just a testing function<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Pretty.MakeMapPrinter.html b/cil/doc/api/Pretty.MakeMapPrinter.html
new file mode 100644
index 0000000..9693a68
--- /dev/null
+++ b/cil/doc/api/Pretty.MakeMapPrinter.html
@@ -0,0 +1,63 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="next" href="Pretty.MakeSetPrinter.html">
+<link rel="Up" href="Pretty.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeMapPrinter</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a href="Pretty.html">Up</a>
+&nbsp;<a href="Pretty.MakeSetPrinter.html">Next</a>
+</div>
+<center><h1>Functor <a href="type_Pretty.MakeMapPrinter.html">Pretty.MakeMapPrinter</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> MakeMapPrinter: <div class="sig_block"><code class="code">functor (</code><code class="code">Map</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEkey"></a><code class="type"></code>key </pre>
+
+<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type">'a</code> t </pre>
+
+<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(key -> 'a -> 'b -> 'b) -><br> 'a t -> 'b -> 'b</code></pre></div><code class="code">end</code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Pretty.MakeMapPrinter.html">..</a> <code class="code">end</code></div></pre>Format maps.<br>
+<table border="0" cellpadding="3" width="100%">
+<tr>
+<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
+<td>
+<table class="paramstable">
+<tr>
+<td align="center" valign="top" width="15%">
+<code>Map</code></td>
+<td align="center" valign="top">:</td>
+<td><code class="type">sig
+ type key
+ type 'a t
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ end</code>
+</table>
+</td>
+</tr>
+</table>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALdocMap"></a>docMap : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">Pretty.doc</a> -><br> (Map.key -> 'a -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> 'a Map.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Format a map, analogous to docList.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_map"></a>d_map : <code class="type">?dmaplet:(<a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -><br> string -><br> (unit -> Map.key -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -><br> (unit -> 'a -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> 'a Map.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Format a map, analogous to d_list.<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Pretty.MakeSetPrinter.html b/cil/doc/api/Pretty.MakeSetPrinter.html
new file mode 100644
index 0000000..e9343b2
--- /dev/null
+++ b/cil/doc/api/Pretty.MakeSetPrinter.html
@@ -0,0 +1,63 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Pretty.MakeMapPrinter.html">
+<link rel="Up" href="Pretty.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeSetPrinter</title>
+</head>
+<body>
+<div class="navbar"><a href="Pretty.MakeMapPrinter.html">Previous</a>
+&nbsp;<a href="Pretty.html">Up</a>
+&nbsp;</div>
+<center><h1>Functor <a href="type_Pretty.MakeSetPrinter.html">Pretty.MakeSetPrinter</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> MakeSetPrinter: <div class="sig_block"><code class="code">functor (</code><code class="code">Set</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEelt"></a><code class="type"></code>elt </pre>
+
+<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
+
+<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(elt -> 'a -> 'a) -><br> t -> 'a -> 'a</code></pre></div><code class="code">end</code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Pretty.MakeSetPrinter.html">..</a> <code class="code">end</code></div></pre>Format sets.<br>
+<table border="0" cellpadding="3" width="100%">
+<tr>
+<td align="left" valign="top" width="1%%"><b>Parameters: </b></td>
+<td>
+<table class="paramstable">
+<tr>
+<td align="center" valign="top" width="15%">
+<code>Set</code></td>
+<td align="center" valign="top">:</td>
+<td><code class="type">sig
+ type elt
+ type t
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ end</code>
+</table>
+</td>
+</tr>
+</table>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALdocSet"></a>docSet : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">Pretty.doc</a> -> (Set.elt -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> Set.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Format a set, analogous to docList.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_set"></a>d_set : <code class="type">string -> (unit -> Set.elt -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a>) -> unit -> Set.t -> <a href="Pretty.html#TYPEdoc">Pretty.doc</a></code></pre><div class="info">
+Format a set, analogous to d_list.<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Pretty.html b/cil/doc/api/Pretty.html
new file mode 100644
index 0000000..c9c48c8
--- /dev/null
+++ b/cil/doc/api/Pretty.html
@@ -0,0 +1,268 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="next" href="Errormsg.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Errormsg.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Pretty.html">Pretty</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Pretty: <code class="code">sig</code> <a href="Pretty.html">..</a> <code class="code">end</code></pre>Utility functions for pretty-printing. The major features provided by
+ this module are <ul>
+<li>An <code class="code">fprintf</code>-style interface with support for user-defined printers</li>
+<li>The printout is fit to a width by selecting some of the optional newlines</li>
+<li>Constructs for alignment and indentation</li>
+<li>Print ellipsis starting at a certain nesting depth</li>
+<li>Constructs for printing lists and arrays</li>
+</ul>
+
+ Pretty-printing occurs in two stages:<ul>
+<li>Construct a <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a> object that encodes all of the elements to be
+ printed
+ along with alignment specifiers and optional and mandatory newlines</li>
+<li>Format the <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a> to a certain width and emit it as a string, to an
+ output stream or pass it to a user-defined function</li>
+</ul>
+
+ The formatting algorithm is not optimal but it does a pretty good job while
+ still operating in linear time. The original version was based on a pretty
+ printer by Philip Wadler which turned out to not scale to large jobs.<br>
+<hr width="100%">
+<br>
+API<br>
+<pre><span class="keyword">type</span> <a name="TYPEdoc"></a><code class="type"></code>doc </pre>
+<div class="info">
+The type of unformated documents. Elements of this type can be
+ constructed in two ways. Either with a number of constructor shown below,
+ or using the <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> function with a <code class="code">printf</code>-like interface.
+ The <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> method is slightly slower so we do not use it for
+ large jobs such as the output routines for a compiler. But we use it for
+ small jobs such as logging and error messages.<br>
+</div>
+
+<br>
+Constructors for the doc type.<br>
+<pre><span class="keyword">val</span> <a name="VALnil"></a>nil : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Constructs an empty document<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VAL(++)"></a>(++) : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Concatenates two documents. This is an infix operator that associates to
+ the left.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALconcat"></a>concat : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALtext"></a>text : <code class="type">string -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A document that prints the given string<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALnum"></a>num : <code class="type">int -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A document that prints an integer in decimal form<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALreal"></a>real : <code class="type">float -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A document that prints a real number<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALchr"></a>chr : <code class="type">char -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A document that prints a character. This is just like <a href="Pretty.html#VALtext"><code class="code">Pretty.text</code></a>
+ with a one-character string.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALline"></a>line : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A document that consists of a mandatory newline. This is just like <code class="code">(text
+ "\n")</code>. The new line will be indented to the current indentation level,
+ unless you use <a href="Pretty.html#VALleftflush"><code class="code">Pretty.leftflush</code></a> right after this.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALleftflush"></a>leftflush : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Use after a <a href="Pretty.html#VALline"><code class="code">Pretty.line</code></a> to prevent the indentation. Whatever follows
+ next will be flushed left. Indentation resumes on the next line.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALbreak"></a>break : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A document that consists of either a space or a line break. Also called
+ an optional line break. Such a break will be
+ taken only if necessary to fit the document in a given width. If the break
+ is not taken a space is printed instead.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALalign"></a>align : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Mark the current column as the current indentation level. Does not print
+ anything. All taken line breaks will align to this column. The previous
+ alignment level is saved on a stack.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunalign"></a>unalign : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Reverts to the last saved indentation level.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmark"></a>mark : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Mark the beginning of a markup section. The width of a markup section is
+ considered 0 for the purpose of computing identation<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALunmark"></a>unmark : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+The end of a markup section<br>
+</div>
+<br>
+Syntactic sugar<br>
+<pre><span class="keyword">val</span> <a name="VALindent"></a>indent : <code class="type">int -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Indents the document. Same as <code class="code">((text " ") ++ align ++ doc ++ unalign)</code>,
+ with the specified number of spaces.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALmarkup"></a>markup : <code class="type"><a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Prints a document as markup. The marked document cannot contain line
+ breaks or alignment constructs.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALseq"></a>seq : <code class="type">sep:<a href="Pretty.html#TYPEdoc">doc</a> -> doit:('a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> elements:'a list -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Formats a sequence. <code class="code">sep</code> is a separator, <code class="code">doit</code> is a function that
+ converts an element to a document.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdocList"></a>docList : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">doc</a> -> ('a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a list -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+An alternative function for printing a list. The <code class="code">unit</code> argument is there
+ to make this function more easily usable with the <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a>
+ interface. The first argument is a separator, by default a comma.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_list"></a>d_list : <code class="type">string -> (unit -> 'a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a list -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+sm: Yet another list printer. This one accepts the same kind of
+ printing function that <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> does, and itself works
+ in the dprintf context. Also accepts
+ a string as the separator since that's by far the most common.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdocArray"></a>docArray : <code class="type">?sep:<a href="Pretty.html#TYPEdoc">doc</a> -><br> (int -> 'a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a array -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Formats an array. A separator and a function that prints an array
+ element. The default separator is a comma.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdocOpt"></a>docOpt : <code class="type">('a -> <a href="Pretty.html#TYPEdoc">doc</a>) -> unit -> 'a option -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Prints an <code class="code">'a option</code> with <code class="code">None</code> or <code class="code">Some</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALd_int32"></a>d_int32 : <code class="type">int32 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+Print an int32<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALf_int32"></a>f_int32 : <code class="type">unit -> int32 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALd_int64"></a>d_int64 : <code class="type">int64 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">val</span> <a name="VALf_int64"></a>f_int64 : <code class="type">unit -> int64 -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><pre><span class="keyword">module</span> <a href="Pretty.MakeMapPrinter.html">MakeMapPrinter</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">Map</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEkey"></a><code class="type"></code>key </pre>
+
+<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type">'a</code> t </pre>
+
+<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(key -> 'a -> 'b -> 'b) -><br> 'a t -> 'b -> 'b</code></pre></div><code class="code">end</code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Pretty.MakeMapPrinter.html">..</a> <code class="code">end</code></div></pre><div class="info">
+Format maps.
+</div>
+<pre><span class="keyword">module</span> <a href="Pretty.MakeSetPrinter.html">MakeSetPrinter</a>: <div class="sig_block"><code class="code">functor (</code><code class="code">Set</code><code class="code"> : </code><code class="code">sig</code><div class="sig_block"><pre><span class="keyword">type</span> <a name="TYPEelt"></a><code class="type"></code>elt </pre>
+
+<pre><span class="keyword">type</span> <a name="TYPEt"></a><code class="type"></code>t </pre>
+
+<pre><span class="keyword">val</span> <a name="VALfold"></a>fold : <code class="type">(elt -> 'a -> 'a) -><br> t -> 'a -> 'a</code></pre></div><code class="code">end</code><code class="code">) -&gt; </code><code class="code">sig</code> <a href="Pretty.MakeSetPrinter.html">..</a> <code class="code">end</code></div></pre><div class="info">
+Format sets.
+</div>
+<pre><span class="keyword">val</span> <a name="VALinsert"></a>insert : <code class="type">unit -> <a href="Pretty.html#TYPEdoc">doc</a> -> <a href="Pretty.html#TYPEdoc">doc</a></code></pre><div class="info">
+A function that is useful with the <code class="code">printf</code>-like interface<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALdprintf"></a>dprintf : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>, <a href="Pretty.html#TYPEdoc">doc</a>) format4 -> 'a</code></pre><div class="info">
+This function provides an alternative method for constructing
+ <code class="code">doc</code> objects. The first argument for this function is a format string
+ argument (of type <code class="code">('a, unit, doc) format</code>; if you insist on
+ understanding what that means see the module <code class="code">Printf</code>). The format string
+ is like that for the <code class="code">printf</code> function in C, except that it understands a
+ few more formatting controls, all starting with the @ character.
+<p>
+
+ See the gprintf function if you want to pipe the result of dprintf into
+ some other functions.
+<p>
+
+ The following special formatting characters are understood (these do not
+ correspond to arguments of the function):<ul>
+<li> @[ Inserts an <a href="Pretty.html#VALalign"><code class="code">Pretty.align</code></a>. Every format string must have matching
+ <a href="Pretty.html#VALalign"><code class="code">Pretty.align</code></a> and <a href="Pretty.html#VALunalign"><code class="code">Pretty.unalign</code></a>. </li>
+<li> @] Inserts an <a href="Pretty.html#VALunalign"><code class="code">Pretty.unalign</code></a>.</li>
+<li> @! Inserts a <a href="Pretty.html#VALline"><code class="code">Pretty.line</code></a>. Just like "\n"</li>
+<li> @? Inserts a <a href="Pretty.html#VALbreak"><code class="code">Pretty.break</code></a>.</li>
+<li> @&lt; Inserts a <a href="Pretty.html#VALmark"><code class="code">Pretty.mark</code></a>. </li>
+<li> @&gt; Inserts a <a href="Pretty.html#VALunmark"><code class="code">Pretty.unmark</code></a>.</li>
+<li> @^ Inserts a <a href="Pretty.html#VALleftflush"><code class="code">Pretty.leftflush</code></a>
+ Should be used immediately after @! or "\n".</li>
+<li> @@ : inserts a @ character</li>
+</ul>
+
+ In addition to the usual <code class="code">printf</code> % formatting characters the following two
+ new characters are supported:<ul>
+<li>%t Corresponds to an argument of type <code class="code">unit -&gt; doc</code>. This argument is
+ invoked to produce a document</li>
+<li>%a Corresponds to <b>two</b> arguments. The first of type <code class="code">unit -&gt; 'a -&gt; doc</code>
+ and the second of type <code class="code">'a</code>. (The extra <code class="code">unit</code> is do to the
+ peculiarities of the built-in support for format strings in Ocaml. It
+ turns out that it is not a major problem.) Here is an example of how
+ you use this:</li>
+</ul>
+
+<pre>dprintf "Name=%s, SSN=%7d, Children=@[%a@]\n"
+ pers.name pers.ssn (docList (chr ',' ++ break) text)
+ pers.children</pre>
+<p>
+
+ The result of <code class="code">dprintf</code> is a <a href="Pretty.html#TYPEdoc"><code class="code">Pretty.doc</code></a>. You can format the document and
+ emit it using the functions <a href="Pretty.html#VALfprint"><code class="code">Pretty.fprint</code></a> and <a href="Pretty.html#VALsprint"><code class="code">Pretty.sprint</code></a>.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALgprintf"></a>gprintf : <code class="type">(<a href="Pretty.html#TYPEdoc">doc</a> -> 'a) -> ('b, unit, <a href="Pretty.html#TYPEdoc">doc</a>, 'a) format4 -> 'b</code></pre><div class="info">
+Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> but more general. It also takes a function that is
+ invoked on the constructed document but before any formatting is done. The
+ type of the format argument means that 'a is the type of the parameters of
+ this function, unit is the type of the first argument to %a and %t
+ formats, doc is the type of the intermediate result, and 'b is the type of
+ the result of gprintf.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfprint"></a>fprint : <code class="type">Pervasives.out_channel -> width:int -> <a href="Pretty.html#TYPEdoc">doc</a> -> unit</code></pre><div class="info">
+Format the document to the given width and emit it to the given channel<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsprint"></a>sprint : <code class="type">width:int -> <a href="Pretty.html#TYPEdoc">doc</a> -> string</code></pre><div class="info">
+Format the document to the given width and emit it as a string<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfprintf"></a>fprintf : <code class="type">Pervasives.out_channel -> ('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> followed by <a href="Pretty.html#VALfprint"><code class="code">Pretty.fprint</code></a><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintf"></a>printf : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stdout</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALeprintf"></a>eprintf : <code class="type">('a, unit, <a href="Pretty.html#TYPEdoc">doc</a>) Pervasives.format -> 'a</code></pre><div class="info">
+Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stderr</code><br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALwithPrintDepth"></a>withPrintDepth : <code class="type">int -> (unit -> unit) -> unit</code></pre><div class="info">
+Invokes a thunk, with printDepth temporarily set to the specified value<br>
+</div>
+<br>
+The following variables can be used to control the operation of the printer<br>
+<pre><span class="keyword">val</span> <a name="VALprintDepth"></a>printDepth : <code class="type">int Pervasives.ref</code></pre><div class="info">
+Specifies the nesting depth of the <code class="code">align</code>/<code class="code">unalign</code> pairs at which
+ everything is replaced with ellipsis<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprintIndent"></a>printIndent : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+If false then does not indent<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALfastMode"></a>fastMode : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+If set to <code class="code">true</code> then optional breaks are taken only when the document
+ has exceeded the given width. This means that the printout will looked
+ more ragged but it will be faster<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALflushOften"></a>flushOften : <code class="type">bool Pervasives.ref</code></pre><div class="info">
+If true the it flushes after every print<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALcountNewLines"></a>countNewLines : <code class="type">int Pervasives.ref</code></pre><div class="info">
+Keep a running count of the taken newlines. You can read and write this
+ from the client code if you want<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALauto_printer"></a>auto_printer : <code class="type">string -> 'a</code></pre><div class="info">
+A function that when used at top-level in a module will direct
+ the pa_prtype module generate automatically the printing functions for a
+ type<br>
+</div>
+</body></html> \ No newline at end of file
diff --git a/cil/doc/api/Stats.html b/cil/doc/api/Stats.html
new file mode 100644
index 0000000..b3f8aa4
--- /dev/null
+++ b/cil/doc/api/Stats.html
@@ -0,0 +1,69 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link rel="previous" href="Clist.html">
+<link rel="next" href="Cil.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Stats</title>
+</head>
+<body>
+<div class="navbar"><a href="Clist.html">Previous</a>
+&nbsp;<a href="index.html">Up</a>
+&nbsp;<a href="Cil.html">Next</a>
+</div>
+<center><h1>Module <a href="type_Stats.html">Stats</a></h1></center>
+<br>
+<pre><span class="keyword">module</span> Stats: <code class="code">sig</code> <a href="Stats.html">..</a> <code class="code">end</code></pre>Utilities for maintaining timing statistics<br>
+<hr width="100%">
+<pre><span class="keyword">val</span> <a name="VALreset"></a>reset : <code class="type">bool -> unit</code></pre><div class="info">
+Resets all the timings. Invoke with "true" if you want to switch to using
+ the hardware performance counters from now on. You get an exception if
+ there are not performance counters available<br>
+</div>
+<pre><span class="keyword">exception</span> <a name="EXCEPTIONNoPerfCount"></a>NoPerfCount</pre>
+<pre><span class="keyword">val</span> <a name="VALhas_performance_counters"></a>has_performance_counters : <code class="type">unit -> bool</code></pre><div class="info">
+Check if we have performance counters<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsample_pentium_perfcount_20"></a>sample_pentium_perfcount_20 : <code class="type">unit -> int</code></pre><div class="info">
+Sample the current cycle count, in megacycles.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALsample_pentium_perfcount_10"></a>sample_pentium_perfcount_10 : <code class="type">unit -> int</code></pre><div class="info">
+Sample the current cycle count, in kilocycles.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtime"></a>time : <code class="type">string -> ('a -> 'b) -> 'a -> 'b</code></pre><div class="info">
+Time a function and associate the time with the given string. If some
+ timing information is already associated with that string, then accumulate
+ the times. If this function is invoked within another timed function then
+ you can have a hierarchy of timings<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALrepeattime"></a>repeattime : <code class="type">float -> string -> ('a -> 'b) -> 'a -> 'b</code></pre><div class="info">
+repeattime is like time but runs the function several times until the total
+ running time is greater or equal to the first argument. The total time is
+ then divided by the number of times the function was run.<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALprint"></a>print : <code class="type">Pervasives.out_channel -> string -> unit</code></pre><div class="info">
+Print the current stats preceeded by a message<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALlastTime"></a>lastTime : <code class="type">float Pervasives.ref</code></pre><div class="info">
+Time a function and set lastTime to the time it took<br>
+</div>
+<pre><span class="keyword">val</span> <a name="VALtimethis"></a>timethis : <code class="type">('a -> 'b) -> 'a -> 'b</code></pre></body></html> \ No newline at end of file
diff --git a/cil/doc/api/index.html b/cil/doc/api/index.html
new file mode 100644
index 0000000..f9636b2
--- /dev/null
+++ b/cil/doc/api/index.html
@@ -0,0 +1,83 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5)</title>
+</head>
+<body>
+<center><h1>CIL API Documentation (version 1.3.5)</h1></center>
+<a href="index_types.html">Index of types</a><br>
+<a href="index_exceptions.html">Index of exceptions</a><br>
+<a href="index_values.html">Index of values</a><br>
+<a href="index_methods.html">Index of class methods</a><br>
+<a href="index_classes.html">Index of classes</a><br>
+<a href="index_class_types.html">Index of class types</a><br>
+<a href="index_modules.html">Index of modules</a><br>
+<a href="index_module_types.html">Index of module types</a><br>
+<br/><br>
+<table class="indextable">
+<tr><td><a href="Pretty.html">Pretty</a></td><td><div class="info">
+Utility functions for pretty-printing.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html">Errormsg</a></td><td><div class="info">
+Utility functions for error-reporting
+</div>
+</td></tr>
+<tr><td><a href="Clist.html">Clist</a></td><td><div class="info">
+Utilities for managing "concatenable lists" (clists).
+</div>
+</td></tr>
+<tr><td><a href="Stats.html">Stats</a></td><td><div class="info">
+Utilities for maintaining timing statistics
+</div>
+</td></tr>
+<tr><td><a href="Cil.html">Cil</a></td><td><div class="info">
+CIL API Documentation.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html">Formatcil</a></td><td><div class="info">
+<b>An Interpreter for constructing CIL constructs</b>
+</div>
+</td></tr>
+<tr><td><a href="Alpha.html">Alpha</a></td><td><div class="info">
+<b>ALPHA conversion</b>
+</div>
+</td></tr>
+<tr><td><a href="Cillower.html">Cillower</a></td><td><div class="info">
+A number of lowering passes over CIL
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html">Cfg</a></td><td><div class="info">
+Code to compute the control-flow graph of a function or file.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.html">Dataflow</a></td><td><div class="info">
+A framework for data flow analysis for CIL code.
+</div>
+</td></tr>
+<tr><td><a href="Dominators.html">Dominators</a></td><td><div class="info">
+Compute dominators using data flow analysis
+</div>
+</td></tr>
+</table>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_attributes.html b/cil/doc/api/index_attributes.html
new file mode 100644
index 0000000..347bfa9
--- /dev/null
+++ b/cil/doc/api/index_attributes.html
@@ -0,0 +1,30 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of class attributes</title>
+</head>
+<body>
+<center><h1>Index of class attributes</h1></center>
+<table>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_class_types.html b/cil/doc/api/index_class_types.html
new file mode 100644
index 0000000..4c7faef
--- /dev/null
+++ b/cil/doc/api/index_class_types.html
@@ -0,0 +1,41 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of class types</title>
+</head>
+<body>
+<center><h1>Index of class types</h1></center>
+<table>
+<tr><td align="left"><br>C</td></tr>
+<tr><td><a href="Cil.cilPrinter.html">cilPrinter</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A printer interface for CIL trees.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html">cilVisitor</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A visitor interface for traversing CIL trees.
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_classes.html b/cil/doc/api/index_classes.html
new file mode 100644
index 0000000..1a5ba7d
--- /dev/null
+++ b/cil/doc/api/index_classes.html
@@ -0,0 +1,46 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of classes</title>
+</head>
+<body>
+<center><h1>Index of classes</h1></center>
+<table>
+<tr><td align="left"><br>D</td></tr>
+<tr><td><a href="Cil.defaultCilPrinterClass.html">defaultCilPrinterClass</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td align="left"><br>N</td></tr>
+<tr><td><a href="Cil.nopCilVisitor.html">nopCilVisitor</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Default Visitor.
+</div>
+</td></tr>
+<tr><td align="left"><br>P</td></tr>
+<tr><td><a href="Cil.plainCilPrinterClass.html">plainCilPrinterClass</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+These are pretty-printers that will show you more details on the internal
+ CIL representation, without trying hard to make it look like C
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_exceptions.html b/cil/doc/api/index_exceptions.html
new file mode 100644
index 0000000..e774a65
--- /dev/null
+++ b/cil/doc/api/index_exceptions.html
@@ -0,0 +1,53 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of exceptions</title>
+</head>
+<body>
+<center><h1>Index of exceptions</h1></center>
+<table>
+<tr><td align="left"><br>E</td></tr>
+<tr><td><a href="Errormsg.html#EXCEPTIONError">Error</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Error reporting functions raise this exception
+</div>
+</td></tr>
+<tr><td align="left"><br>L</td></tr>
+<tr><td><a href="Cil.html#EXCEPTIONLenOfArray">LenOfArray</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Raised when <a href="Cil.html#VALlenOfArray"><code class="code">Cil.lenOfArray</code></a> fails either because the length is <code class="code">None</code>
+ or because it is a non-constant expression
+</div>
+</td></tr>
+<tr><td align="left"><br>N</td></tr>
+<tr><td><a href="Stats.html#EXCEPTIONNoPerfCount">NoPerfCount</a> [<a href="Stats.html">Stats</a>]</td>
+<td></td></tr>
+<tr><td align="left"><br>S</td></tr>
+<tr><td><a href="Cil.html#EXCEPTIONSizeOfError">SizeOfError</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Raised when one of the bitsSizeOf functions cannot compute the size of a
+ type.
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_methods.html b/cil/doc/api/index_methods.html
new file mode 100644
index 0000000..1558de3
--- /dev/null
+++ b/cil/doc/api/index_methods.html
@@ -0,0 +1,228 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of class methods</title>
+</head>
+<body>
+<center><h1>Index of class methods</h1></center>
+<table>
+<tr><td align="left"><br>D</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODdBlock">dBlock</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Dump a control-flow block to a file with a given indentation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODdGlobal">dGlobal</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Dump a global to a file with a given indentation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODdInit">dInit</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Dump a global to a file with a given indentation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODdStmt">dStmt</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Dump a control-flow statement to a file with a given indentation.
+</div>
+</td></tr>
+<tr><td align="left"><br>P</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpAttr">pAttr</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Attribute.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpAttrParam">pAttrParam</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Attribute parameter
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpAttrs">pAttrs</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Attribute lists
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpBlock">pBlock</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpExp">pExp</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Print expressions
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpFieldDecl">pFieldDecl</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+A field declaration
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpGlobal">pGlobal</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Global (vars, types, etc.).
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpInit">pInit</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Print initializers.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpInstr">pInstr</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Invoked on each instruction occurrence.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpLabel">pLabel</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Print a label.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpLineDirective">pLineDirective</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Print a line-number.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpLval">pLval</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Invoked on each lvalue occurrence
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpOffset">pOffset</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Invoked on each offset occurrence.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpStmt">pStmt</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Control-flow statement.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpStmtKind">pStmtKind</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Print a statement kind.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpType">pType</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpVDecl">pVDecl</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Invoked for each variable declaration.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilPrinter.html#METHODpVar">pVar</a> [<a href="Cil.cilPrinter.html">Cil.cilPrinter</a>]</td>
+<td><div class="info">
+Invoked on each variable use.
+</div>
+</td></tr>
+<tr><td align="left"><br>Q</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODqueueInstr">queueInstr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Add here instructions while visiting to queue them to preceede the
+ current statement or instruction being processed.
+</div>
+</td></tr>
+<tr><td align="left"><br>U</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODunqueueInstr">unqueueInstr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Gets the queue of instructions and resets the queue.
+</div>
+</td></tr>
+<tr><td align="left"><br>V</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvattr">vattr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Attribute.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvattrparam">vattrparam</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Attribute parameters.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvblock">vblock</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Block.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvexpr">vexpr</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked on each expression occurrence.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvfunc">vfunc</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Function definition.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvglob">vglob</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Global (vars, types,
+ etc.)
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvinit">vinit</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Initializers for globals
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvinitoffs">vinitoffs</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked on each offset appearing in the list of a
+ CompoundInit initializer.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvinst">vinst</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked on each instruction occurrence.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvlval">vlval</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked on each lvalue occurrence
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvoffs">voffs</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked on each offset occurrence that is *not* as part
+ of an initializer list specification, i.e.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvstmt">vstmt</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Control-flow statement.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvtype">vtype</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Use of some type.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvvdec">vvdec</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked for each variable declaration.
+</div>
+</td></tr>
+<tr><td><a href="Cil.cilVisitor.html#METHODvvrbl">vvrbl</a> [<a href="Cil.cilVisitor.html">Cil.cilVisitor</a>]</td>
+<td><div class="info">
+Invoked on each variable use.
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_module_types.html b/cil/doc/api/index_module_types.html
new file mode 100644
index 0000000..244d402
--- /dev/null
+++ b/cil/doc/api/index_module_types.html
@@ -0,0 +1,36 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of module types</title>
+</head>
+<body>
+<center><h1>Index of module types</h1></center>
+<table>
+<tr><td align="left"><br>B</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html">BackwardsTransfer</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+<tr><td align="left"><br>F</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html">ForwardsTransfer</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_modules.html b/cil/doc/api/index_modules.html
new file mode 100644
index 0000000..090693f
--- /dev/null
+++ b/cil/doc/api/index_modules.html
@@ -0,0 +1,108 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of modules</title>
+</head>
+<body>
+<center><h1>Index of modules</h1></center>
+<table>
+<tr><td align="left"><br>A</td></tr>
+<tr><td><a href="Alpha.html">Alpha</a> </td>
+<td><div class="info">
+<b>ALPHA conversion</b>
+</div>
+</td></tr>
+<tr><td align="left"><br>B</td></tr>
+<tr><td><a href="Dataflow.BackwardsDataFlow.html">BackwardsDataFlow</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+<tr><td align="left"><br>C</td></tr>
+<tr><td><a href="Cfg.html">Cfg</a> </td>
+<td><div class="info">
+Code to compute the control-flow graph of a function or file.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html">Cil</a> </td>
+<td><div class="info">
+CIL API Documentation.
+</div>
+</td></tr>
+<tr><td><a href="Cillower.html">Cillower</a> </td>
+<td><div class="info">
+A number of lowering passes over CIL
+</div>
+</td></tr>
+<tr><td><a href="Clist.html">Clist</a> </td>
+<td><div class="info">
+Utilities for managing "concatenable lists" (clists).
+</div>
+</td></tr>
+<tr><td align="left"><br>D</td></tr>
+<tr><td><a href="Dataflow.html">Dataflow</a> </td>
+<td><div class="info">
+A framework for data flow analysis for CIL code.
+</div>
+</td></tr>
+<tr><td><a href="Dominators.html">Dominators</a> </td>
+<td><div class="info">
+Compute dominators using data flow analysis
+</div>
+</td></tr>
+<tr><td align="left"><br>E</td></tr>
+<tr><td><a href="Errormsg.html">Errormsg</a> </td>
+<td><div class="info">
+Utility functions for error-reporting
+</div>
+</td></tr>
+<tr><td align="left"><br>F</td></tr>
+<tr><td><a href="Formatcil.html">Formatcil</a> </td>
+<td><div class="info">
+<b>An Interpreter for constructing CIL constructs</b>
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsDataFlow.html">ForwardsDataFlow</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+<tr><td align="left"><br>M</td></tr>
+<tr><td><a href="Pretty.MakeMapPrinter.html">MakeMapPrinter</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Format maps.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.MakeSetPrinter.html">MakeSetPrinter</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Format sets.
+</div>
+</td></tr>
+<tr><td align="left"><br>P</td></tr>
+<tr><td><a href="Pretty.html">Pretty</a> </td>
+<td><div class="info">
+Utility functions for pretty-printing.
+</div>
+</td></tr>
+<tr><td align="left"><br>S</td></tr>
+<tr><td><a href="Stats.html">Stats</a> </td>
+<td><div class="info">
+Utilities for maintaining timing statistics
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_types.html b/cil/doc/api/index_types.html
new file mode 100644
index 0000000..1974acd
--- /dev/null
+++ b/cil/doc/api/index_types.html
@@ -0,0 +1,271 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of types</title>
+</head>
+<body>
+<center><h1>Index of types</h1></center>
+<table>
+<tr><td align="left"><br>A</td></tr>
+<tr><td><a href="Dataflow.html#TYPEaction">action</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+<tr><td><a href="Alpha.html#TYPEalphaTableData">alphaTableData</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td><div class="info">
+This is the type of the elements of the alpha renaming table.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEattribute">attribute</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#TYPEattributeClass">attributeClass</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Various classes of attributes
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEattributes">attributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Attributes are lists sorted by the attribute name.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEattrparam">attrparam</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The type of parameters of attributes
+</div>
+</td></tr>
+<tr><td align="left"><br>B</td></tr>
+<tr><td><a href="Cil.html#TYPEbinop">binop</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Binary operations
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEblock">block</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A block is a sequence of statements with the control falling through from
+ one element to the next
+</div>
+</td></tr>
+<tr><td align="left"><br>C</td></tr>
+<tr><td><a href="Clist.html#TYPEclist">clist</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+The clist datatype.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEcomment">comment</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#TYPEcompinfo">compinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The definition of a structure or union type.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEconstant">constant</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Literal constants
+</div>
+</td></tr>
+<tr><td align="left"><br>D</td></tr>
+<tr><td><a href="Pretty.html#TYPEdoc">doc</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+The type of unformated documents.
+</div>
+</td></tr>
+<tr><td align="left"><br>E</td></tr>
+<tr><td><a href="Cil.html#TYPEenuminfo">enuminfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Information about an enumeration
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEexistsAction">existsAction</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A datatype to be used in conjunction with <code class="code">existsType</code>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEexp">exp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Expressions (Side-effect free)
+</div>
+</td></tr>
+<tr><td align="left"><br>F</td></tr>
+<tr><td><a href="Cil.html#TYPEfeatureDescr">featureDescr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+To be able to add/remove features easily, each feature should be package
+ as an interface with the following interface.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEfieldinfo">fieldinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Information about a struct/union field
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEfile">file</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Top-level representation of a C source file
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEfkind">fkind</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Various kinds of floating-point numbers
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEformatArg">formatArg</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The type of argument for the interpreter
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEfundec">fundec</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Function definitions.
+</div>
+</td></tr>
+<tr><td align="left"><br>G</td></tr>
+<tr><td><a href="Cil.html#TYPEglobal">global</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A global declaration or definition
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.html#TYPEguardaction">guardaction</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+<tr><td align="left"><br>I</td></tr>
+<tr><td><a href="Cil.html#TYPEikind">ikind</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Various kinds of integers
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEinit">init</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Initializers for global variables.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEinitinfo">initinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+We want to be able to update an initializer in a global variable, so we
+ define it as a mutable field
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEinstr">instr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Instructions.
+</div>
+</td></tr>
+<tr><td align="left"><br>L</td></tr>
+<tr><td><a href="Cil.html#TYPElabel">label</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Labels
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPElhost">lhost</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The host part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPElineDirectiveStyle">lineDirectiveStyle</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Styles of printing line directives
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPElocation">location</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Describes a location in a source file.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#TYPElocation">location</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Type for source-file locations
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPElval">lval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+An lvalue
+</div>
+</td></tr>
+<tr><td align="left"><br>O</td></tr>
+<tr><td><a href="Cil.html#TYPEoffset">offset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The offset part of an <a href="Cil.html#TYPElval"><code class="code">Cil.lval</code></a>.
+</div>
+</td></tr>
+<tr><td align="left"><br>S</td></tr>
+<tr><td><a href="Cil.html#TYPEstmt">stmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Statements.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.html#TYPEstmtaction">stmtaction</a> [<a href="Dataflow.html">Dataflow</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#TYPEstmtkind">stmtkind</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The various kinds of control-flow statements statements
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEstorage">storage</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Storage-class information
+</div>
+</td></tr>
+<tr><td align="left"><br>T</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#TYPEt">t</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+The type of the data we compute for each block start.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#TYPEt">t</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+The type of the data we compute for each block start.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEtyp">typ</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#TYPEtypeinfo">typeinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Information about a defined type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEtypsig">typsig</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Type signatures.
+</div>
+</td></tr>
+<tr><td align="left"><br>U</td></tr>
+<tr><td><a href="Alpha.html#TYPEundoAlphaElement">undoAlphaElement</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td><div class="info">
+This is the type of the elements that are recorded by the alpha
+ conversion functions in order to be able to undo changes to the tables
+ they modify.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEunop">unop</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Unary operators
+</div>
+</td></tr>
+<tr><td align="left"><br>V</td></tr>
+<tr><td><a href="Cil.html#TYPEvarinfo">varinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Information about a variable.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#TYPEvisitAction">visitAction</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Different visiting actions.
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/index_values.html b/cil/doc/api/index_values.html
new file mode 100644
index 0000000..799daaf
--- /dev/null
+++ b/cil/doc/api/index_values.html
@@ -0,0 +1,1964 @@
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Index of values</title>
+</head>
+<body>
+<center><h1>Index of values</h1></center>
+<table>
+<tr><td align="left"><br></td></tr>
+<tr><td><a href="Pretty.html#VAL(++)">(++)</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Concatenates two documents.
+</div>
+</td></tr>
+<tr><td align="left"><br>A</td></tr>
+<tr><td><a href="Cil.html#VALaddAttribute">addAttribute</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Add an attribute.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALaddAttributes">addAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Add a list of attributes.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALaddOffset">addOffset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+<code class="code">addOffset o1 o2</code> adds <code class="code">o1</code> to the end of <code class="code">o2</code>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALaddOffsetLval">addOffsetLval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Add an offset at the end of an lvalue.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALadditiveLevel">additiveLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALaddrOfLevel">addrOfLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALalign">align</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Mark the current column as the current indentation level.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALalignOf_int">alignOf_int</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The minimum alignment (in bytes) for a type.
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALappend">append</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Append two clists
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALargsToList">argsToList</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Obtain the argument list ([] if None)
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALarrowLevel">arrowLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALattributeHash">attributeHash</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+This table contains the mapping of predefined attributes to classes.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALauto_printer">auto_printer</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A function that when used at top-level in a module will direct
+ the pa_prtype module generate automatically the printing functions for a
+ type
+</div>
+</td></tr>
+<tr><td align="left"><br>B</td></tr>
+<tr><td><a href="Cil.html#VALbitsOffset">bitsOffset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Give a type of a base and an offset, returns the number of bits from the
+ base address and the width (also expressed in bits) for the subobject
+ denoted by the offset.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALbitsSizeOf">bitsSizeOf</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The size of a type, in bits.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALbitwiseLevel">bitwiseLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALbreak">break</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A document that consists of either a space or a line break.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALbug">bug</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALbug"><code class="code">Errormsg.bug</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALbug">bug</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Similar to <code class="code">error</code> except that its output has the form <code class="code">Bug: ...</code>
+</div>
+</td></tr>
+<tr><td align="left"><br>C</td></tr>
+<tr><td><a href="Formatcil.html#VALcExp">cExp</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Constructs an expression based on the program and the list of arguments.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALcInstr">cInstr</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Constructs an instruction based on the program and the list of arguments.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALcLval">cLval</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Constructs an lval based on the program and the list of arguments.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALcStmt">cStmt</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Formatcil.html#VALcStmts">cStmts</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Constructs a list of statements
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALcType">cType</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Constructs a type based on the program and the list of arguments.
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALcfgFun">cfgFun</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+Compute a control flow graph for fd.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcharConstPtrType">charConstPtrType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+char const *
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcharConstToInt">charConstToInt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Given the character c in a (CChr c), sign-extend it to 32 bits.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcharPtrType">charPtrType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+char *
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcharType">charType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+char
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALchar_is_unsigned">char_is_unsigned</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether "char" is unsigned.
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALcheckBeforeAppend">checkBeforeAppend</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+A useful check to assert before an append.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALchr">chr</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A document that prints a character.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcilVersion">cilVersion</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+This are the CIL version numbers.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcilVersionMajor">cilVersionMajor</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALcilVersionMinor">cilVersionMinor</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALcilVersionRevision">cilVersionRevision</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cfg.html#VALclearCFGinfo">clearCFGinfo</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+clear the sid, succs, and preds fields of each statment in a function
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALclearFileCFG">clearFileCFG</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+clear the sid, succs, and preds fields of each statement.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALcombinePredecessors">combinePredecessors</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Take some old data for the start of a statement, and some new data for
+ the same point.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALcombineStmtStartData">combineStmtStartData</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+When the analysis reaches the start of a block, combine the old data
+ with the one we have just computed.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALcombineSuccessors">combineSuccessors</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+Take the data from two successors and combine it
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcompFullName">compFullName</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Get the full name of a comp
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcompactStmts">compactStmts</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Try to compress statements so as to get maximal basic blocks
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcomparativeLevel">comparativeLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALcompareLoc">compareLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Comparison function for locations.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsDataFlow.html#VALcompute">compute</a> [<a href="Dataflow.BackwardsDataFlow.html">Dataflow.BackwardsDataFlow</a>]</td>
+<td><div class="info">
+Fill in the T.stmtStartData, given a number of initial statements to
+ start from (the sinks for the backwards data flow).
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsDataFlow.html#VALcompute">compute</a> [<a href="Dataflow.ForwardsDataFlow.html">Dataflow.ForwardsDataFlow</a>]</td>
+<td><div class="info">
+Fill in the T.stmtStartData, given a number of initial statements to
+ start from.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcomputeCFGInfo">computeCFGInfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Compute the CFG information for all statements in a fundec and return a
+ list of the statements.
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALcomputeFileCFG">computeFileCFG</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+Compute the CFG for an entire file, by calling cfgFun on each function.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALcomputeFirstPredecessor">computeFirstPredecessor</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Give the first value for a predecessors, compute the value to be set
+ for the block
+</div>
+</td></tr>
+<tr><td><a href="Dominators.html#VALcomputeIDom">computeIDom</a> [<a href="Dominators.html">Dominators</a>]</td>
+<td><div class="info">
+Invoke on a code after filling in the CFG info and it computes the
+ immediate dominator information.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALconcat">concat</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALconstFold">constFold</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Do constant folding on an expression.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALconstFoldBinOp">constFoldBinOp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Do constant folding on a binary operation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALconstFoldVisitor">constFoldVisitor</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A visitor that does constant folding.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALcopy">copy</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Make a deep copy of the data
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcopyCompInfo">copyCompInfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Makes a shallow copy of a <a href="Cil.html#TYPEcompinfo"><code class="code">Cil.compinfo</code></a> changing the name and the key.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcopyFunction">copyFunction</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Create a deep copy of a function.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcopyVarinfo">copyVarinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a shallow copy of a <code class="code">varinfo</code> and assign a new identifier
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALcountNewLines">countNewLines</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Keep a running count of the taken newlines.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcurrentGlobal">currentGlobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A reference to the current global being visited
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALcurrentLoc">currentLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A reference to the current location.
+</div>
+</td></tr>
+<tr><td align="left"><br>D</td></tr>
+<tr><td><a href="Formatcil.html#VALdExp">dExp</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Deconstructs an expression based on the program.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdExp">dExp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Generate an <a href="Cil.html#TYPEexp"><code class="code">Cil.exp</code></a> to be used in case of errors.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdGlobal">dGlobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Generate a <a href="Cil.html#TYPEglobal"><code class="code">Cil.global</code></a> to be used in case of errors.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALdInstr">dInstr</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Deconstructs an instruction based on the program.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdInstr">dInstr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Generate an <a href="Cil.html#TYPEinstr"><code class="code">Cil.instr</code></a> to be used in case of errors.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALdLval">dLval</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Deconstructs an lval based on the program.
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALdType">dType</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Deconstructs a type based on the program.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_attr">d_attr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_attrlist">d_attrlist</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a list of attributes using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_attrparam">d_attrparam</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an argument of an attribute using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_binop">d_binop</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a binary operator
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_block">d_block</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a block using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_const">d_const</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a constant
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_exp">d_exp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an expression using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_fkind">d_fkind</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a floating-point kind
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_formatarg">d_formatarg</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-prints a format arg
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_global">d_global</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print the internal representation of a global using
+ <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALd_hloc">d_hloc</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALd_ikind">d_ikind</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an integer of a given kind
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_init">d_init</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an initializer using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_instr">d_instr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an instruction using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALd_int32">d_int32</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Print an int32
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALd_int64">d_int64</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALd_label">d_label</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a label using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALd_list">d_list</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+sm: Yet another list printer.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_loc">d_loc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a location
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALd_loc">d_loc</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALd_lval">d_lval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an lvalue using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Pretty.MakeMapPrinter.html#VALd_map">d_map</a> [<a href="Pretty.MakeMapPrinter.html">Pretty.MakeMapPrinter</a>]</td>
+<td><div class="info">
+Format a map, analogous to d_list.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_offset">d_offset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an offset using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>, given the pretty
+ printing for the base.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_plainexp">d_plainexp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print the internal representation of an expression
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_plaininit">d_plaininit</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print the internal representation of an integer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_plainlval">d_plainlval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print the internal representation of an lvalue
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_plaintype">d_plaintype</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print the internal representation of a type
+</div>
+</td></tr>
+<tr><td><a href="Pretty.MakeSetPrinter.html#VALd_set">d_set</a> [<a href="Pretty.MakeSetPrinter.html">Pretty.MakeSetPrinter</a>]</td>
+<td><div class="info">
+Format a set, analogous to d_list.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_shortglobal">d_shortglobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a short description of the global.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_stmt">d_stmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a statement using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_storage">d_storage</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print storage-class information
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_thisloc">d_thisloc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_type">d_type</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a type using <a href="Cil.html#VALdefaultCilPrinter"><code class="code">Cil.defaultCilPrinter</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_typsig">d_typsig</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print a type signature
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALd_unop">d_unop</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a unary operator
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALdebug">debug</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+Whether to turn on debugging
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdebug">debug</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Whether to turn on debugging
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALdebugFlag">debugFlag</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+If set then print debugging info
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdefaultCilPrinter">defaultCilPrinter</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALderefStarLevel">derefStarLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_attr">dn_attr</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_attrlist">dn_attrlist</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_attrparam">dn_attrparam</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_exp">dn_exp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Versions of the above pretty printers, that don't print #line directives
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdn_global">dn_global</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_init">dn_init</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_instr">dn_instr</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_lval">dn_lval</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_stmt">dn_stmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALdn_type">dn_type</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdoGuard">doGuard</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Generate the successor to an If statement assuming the given expression
+ is nonzero.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALdoInstr">doInstr</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+The (backwards) transfer function for an instruction.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdoInstr">doInstr</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+The (forwards) transfer function for an instruction.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALdoStmt">doStmt</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+The (backwards) transfer function for a branch.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALdoStmt">doStmt</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+The (forwards) transfer function for a statement.
+</div>
+</td></tr>
+<tr><td><a href="Alpha.html#VALdocAlphaTable">docAlphaTable</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td><div class="info">
+Split the name in preparation for newAlphaName.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALdocArray">docArray</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Formats an array.
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALdocCList">docCList</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+A document for printing a clist (similar to <code class="code">docList</code>)
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALdocList">docList</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+An alternative function for printing a list.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.MakeMapPrinter.html#VALdocMap">docMap</a> [<a href="Pretty.MakeMapPrinter.html">Pretty.MakeMapPrinter</a>]</td>
+<td><div class="info">
+Format a map, analogous to docList.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALdocOpt">docOpt</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Prints an <code class="code">'a option</code> with <code class="code">None</code> or <code class="code">Some</code>
+</div>
+</td></tr>
+<tr><td><a href="Pretty.MakeSetPrinter.html#VALdocSet">docSet</a> [<a href="Pretty.MakeSetPrinter.html">Pretty.MakeSetPrinter</a>]</td>
+<td><div class="info">
+Format a set, analogous to docList.
+</div>
+</td></tr>
+<tr><td><a href="Dominators.html#VALdominates">dominates</a> [<a href="Dominators.html">Dominators</a>]</td>
+<td><div class="info">
+Check whether one statement dominates another.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdoubleType">doubleType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+double
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALdprintf">dprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+This function provides an alternative method for constructing
+ <code class="code">doc</code> objects.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdropAttribute">dropAttribute</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Remove all attributes with the given name.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdropAttributes">dropAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Remove all attributes with names appearing in the string list.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdummyFile">dummyFile</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A dummy file
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdummyFunDec">dummyFunDec</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A dummy function declaration handy when you need one as a placeholder.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdummyInstr">dummyInstr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A instr to serve as a placeholder
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdummyStmt">dummyStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A statement consisting of just <code class="code">dummyInstr</code>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdumpBlock">dumpBlock</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Dump a block to a file using a given indentation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdumpFile">dumpFile</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print an entire file.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdumpGlobal">dumpGlobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Pretty-print a global.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdumpInit">dumpInit</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Dump an initializer to a file using a given indentation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALdumpStmt">dumpStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Dump a statement to a file using a given indentation.
+</div>
+</td></tr>
+<tr><td align="left"><br>E</td></tr>
+<tr><td><a href="Clist.html#VALempty">empty</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+The empty clist
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALemptyFunction">emptyFunction</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make an empty function
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALeprintf">eprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stderr</code>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALerror">error</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALerror">error</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Prints an error message of the form <code class="code">Error: ...</code>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALerrorLoc">errorLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Cil.html#VALerror"><code class="code">Cil.error</code></a> except that it explicitly takes a location argument,
+ instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALexistsType">existsType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Scans a type by applying the function on all elements.
+</div>
+</td></tr>
+<tr><td align="left"><br>F</td></tr>
+<tr><td><a href="Pretty.html#VALf_int32">f_int32</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALf_int64">f_int64</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALfastMode">fastMode</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+If set to <code class="code">true</code> then optional breaks are taken only when the document
+ has exceeded the given width.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALfilterAttributes">filterAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Retains attributes with the given name
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALfilterStmt">filterStmt</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+Whether to put this predecessor block in the worklist.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALfilterStmt">filterStmt</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Whether to put this statement in the worklist.
+</div>
+</td></tr>
+<tr><td><a href="Dominators.html#VALfindNaturalLoops">findNaturalLoops</a> [<a href="Dominators.html">Dominators</a>]</td>
+<td><div class="info">
+Compute the start of the natural loops.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALfinishParsing">finishParsing</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALflushOften">flushOften</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+If true the it flushes after every print
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALfoldGlobals">foldGlobals</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Fold over all globals, including the global initializer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALfoldLeftCompound">foldLeftCompound</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Fold over the list of initializers in a Compound.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALfoldLeftCompoundAll">foldLeftCompoundAll</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Fold over the list of initializers in a Compound, like
+ <a href="Cil.html#VALfoldLeftCompound"><code class="code">Cil.foldLeftCompound</code></a> but in the case of an array it scans even missing
+ zero initializers at the end of the array
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALfold_left">fold_left</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+A version of fold_left that works on clists
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALforgcc">forgcc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Return the string 's' if we're printing output for gcc, suppres
+ it if we're printing for CIL to parse back in.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALfprint">fprint</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Format the document to the given width and emit it to the given channel
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALfprintf">fprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> followed by <a href="Pretty.html#VALfprint"><code class="code">Pretty.fprint</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALfromList">fromList</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Convert an ordinary list to a clist
+</div>
+</td></tr>
+<tr><td align="left"><br>G</td></tr>
+<tr><td><a href="Cil.html#VALgccBuiltins">gccBuiltins</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A list of the GCC built-in functions.
+</div>
+</td></tr>
+<tr><td><a href="Alpha.html#VALgetAlphaPrefix">getAlphaPrefix</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALgetCompField">getCompField</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Return a named fieldinfo in compinfo, or raise Not_found
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALgetGlobInit">getGlobInit</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Get the global initializer and create one if it does not already exist.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALgetHPosition">getHPosition</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+high-level position
+</div>
+</td></tr>
+<tr><td><a href="Dominators.html#VALgetIdom">getIdom</a> [<a href="Dominators.html">Dominators</a>]</td>
+<td><div class="info">
+This is like Inthash.find but gives an error if the information is
+ Not_found
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALgetLocation">getLocation</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALgetParenthLevel">getParenthLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Parentheses level.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALgetPosition">getPosition</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALget_globalLoc">get_globalLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Return the location of a global, or locUnknown
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALget_instrLoc">get_instrLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Return the location of an instruction
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALget_stmtLoc">get_stmtLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Return the location of a statement, or locUnknown
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALgprintf">gprintf</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Like <a href="Pretty.html#VALdprintf"><code class="code">Pretty.dprintf</code></a> but more general.
+</div>
+</td></tr>
+<tr><td align="left"><br>H</td></tr>
+<tr><td><a href="Errormsg.html#VALhadErrors">hadErrors</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+This is set whenever one of the above error functions are called.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALhasAttribute">hasAttribute</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the named attribute appears in the attribute list.
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALhas_performance_counters">has_performance_counters</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Check if we have performance counters
+</div>
+</td></tr>
+<tr><td align="left"><br>I</td></tr>
+<tr><td><a href="Cil.html#VALincrem">increm</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Increment an expression.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALindent">indent</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Indents the document.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALindexLevel">indexLevel</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALinitCIL">initCIL</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Call this function to perform some initialization.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALinsert">insert</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A function that is useful with the <code class="code">printf</code>-like interface
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALinsertImplicitCasts">insertImplicitCasts</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Do insert implicit casts (default true)
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALintPtrType">intPtrType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+int *
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALintType">intType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+int
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALinteger">integer</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct an integer of kind IInt.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALinvalidStmt">invalidStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+An empty statement.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisArithmeticType">isArithmeticType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the argument is an arithmetic type (i.e.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisArrayType">isArrayType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the argument is an array type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisCompleteType">isCompleteType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Returns true if this is a complete type.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisConstant">isConstant</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the expression is a compile-time constant
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisFunctionType">isFunctionType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the argument is a function type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisInteger">isInteger</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the given expression is a (possibly cast'ed)
+ character or an integer constant
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisIntegralType">isIntegralType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the argument is an integral type (i.e.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisPointerType">isPointerType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the argument is a pointer type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisSigned">isSigned</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Returns true if and only if the given integer type is signed.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALisVoidPtrType">isVoidPtrType</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALisVoidType">isVoidType</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALisZero">isZero</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+True if the given expression is a (possibly cast'ed) integer or character
+ constant with value zero
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALiter">iter</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+A version of iter that works on clists
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALiterGlobals">iterGlobals</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Iterate over all globals, including the global initializer
+</div>
+</td></tr>
+<tr><td align="left"><br>K</td></tr>
+<tr><td><a href="Cil.html#VALkinteger">kinteger</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct an integer of a given kind.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALkinteger64">kinteger64</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct an integer of a given kind, using OCaml's int64 type.
+</div>
+</td></tr>
+<tr><td align="left"><br>L</td></tr>
+<tr><td><a href="Stats.html#VALlastTime">lastTime</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Time a function and set lastTime to the time it took
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALleftflush">leftflush</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Use after a <a href="Pretty.html#VALline"><code class="code">Pretty.line</code></a> to prevent the indentation.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlenOfArray">lenOfArray</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Call to compute the array length as present in the array type, to an
+ integer.
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALlength">length</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Find the length of a clist
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALline">line</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A document that consists of a mandatory newline.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlineDirectiveStyle">lineDirectiveStyle</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+How to print line directives
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlineLength">lineLength</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+The length used when wrapping output lines.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlittle_endian">little_endian</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether the machine is little endian.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALloadBinaryFile">loadBinaryFile</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Read a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form from the filesystem.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlocUnknown">locUnknown</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Represents a location that cannot be determined
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALlocUnknown">locUnknown</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+An unknown location for use when you need one but you don't have one
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALlog">log</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Print something to <code class="code">logChannel</code>
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALlogChannel">logChannel</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+A channel for printing log messages
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALlogg">logg</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+same as <a href="Errormsg.html#VALlog"><code class="code">Errormsg.log</code></a> but do not wrap lines
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlongType">longType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+long
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALlowerConstants">lowerConstants</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Do lower constants (default true)
+</div>
+</td></tr>
+<tr><td><a href="Cillower.html#VALlowerEnumVisitor">lowerEnumVisitor</a> [<a href="Cillower.html">Cillower</a>]</td>
+<td><div class="info">
+Replace enumeration constants with integer constants
+</div>
+</td></tr>
+<tr><td align="left"><br>M</td></tr>
+<tr><td><a href="Cil.html#VALmakeFormalVar">makeFormalVar</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a formal variable for a function.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmakeGlobalVar">makeGlobalVar</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a global variable.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmakeLocalVar">makeLocalVar</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a local variable and add it to a function's slocals (only if insert =
+ true, which is the default).
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmakeTempVar">makeTempVar</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a temporary variable and add it to a function's slocals.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmakeVarinfo">makeVarinfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a varinfo.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmakeZeroInit">makeZeroInit</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a initializer for zero-ing a data type
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALmap">map</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Map a function over a clist.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmapGlobals">mapGlobals</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Map over all globals, including the global initializer and change things
+ in place
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmapNoCopy">mapNoCopy</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like map but try not to make a copy of the list
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmapNoCopyList">mapNoCopyList</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like map but each call can return a list.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALmark">mark</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Mark the beginning of a markup section.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALmarkup">markup</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Prints a document as markup.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmissingFieldName">missingFieldName</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+This is a constant used as the name of an unnamed bitfield.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkAddrOf">mkAddrOf</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make an AddrOf.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkAddrOrStartOf">mkAddrOrStartOf</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like mkAddrOf except if the type of lval is an array then it uses
+ StartOf.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkBlock">mkBlock</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct a block with no attributes, given a list of statements
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkCast">mkCast</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Cil.html#VALmkCastT"><code class="code">Cil.mkCastT</code></a> but uses typeOf to get <code class="code">oldt</code>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkCastT">mkCastT</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct a cast when having the old type of the expression.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkCompInfo">mkCompInfo</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Creates a a (potentially recursive) composite type.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkEmptyStmt">mkEmptyStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Returns an empty statement (of kind <code class="code">Instr</code>)
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkFor">mkFor</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a for loop for(start; guard; next) { ...
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkForIncr">mkForIncr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a for loop for(i=start; i&lt;past; i += incr) { ...
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkMem">mkMem</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a Mem, while optimizing AddrOf.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkStmt">mkStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct a statement, given its kind.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkStmtOneInstr">mkStmtOneInstr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Construct a statement consisting of just one instruction
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkString">mkString</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make an expression that is a string constant (of pointer type)
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmkWhile">mkWhile</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Make a while loop.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmone">mone</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+-1
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmsvcBuiltins">msvcBuiltins</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A list of the MSVC built-in functions.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALmsvcMode">msvcMode</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether the pretty printer should print output for the MS VC compiler.
+</div>
+</td></tr>
+<tr><td align="left"><br>N</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALname">name</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+For debugging purposes, the name of the analysis
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALname">name</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+For debugging purposes, the name of the analysis
+</div>
+</td></tr>
+<tr><td><a href="Alpha.html#VALnewAlphaName">newAlphaName</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td><div class="info">
+Create a new name based on a given name.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALnewHline">newHline</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALnewVID">newVID</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Generate a new variable ID.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALnew_sid">new_sid</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Errormsg.html#VALnewline">newline</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALnil">nil</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Constructs an empty document
+</div>
+</td></tr>
+<tr><td><a href="Formatcil.html#VALnoMemoize">noMemoize</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+If set then will not memoize the parsed patterns
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALnodeList">nodeList</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+All of the nodes in a file.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALnull">null</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Do not actually print (i.e.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALnum">num</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A document that prints an integer in decimal form
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALnumNodes">numNodes</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+number of nodes in the CFG
+</div>
+</td></tr>
+<tr><td align="left"><br>O</td></tr>
+<tr><td><a href="Cil.html#VALone">one</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+1
+</div>
+</td></tr>
+<tr><td align="left"><br>P</td></tr>
+<tr><td><a href="Cil.html#VALparseInt">parseInt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Convert a string representing a C integer literal to an expression.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALparse_error">parse_error</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALpartitionAttributes">partitionAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Partition the attributes into classes:name attributes, function type,
+ and type attributes
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALpeepHole1">peepHole1</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Similar to <code class="code">peepHole2</code> except that the optimization window consists of
+ one statement, not two
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALpeepHole2">peepHole2</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A peephole optimizer that processes two adjacent statements and possibly
+ replaces them both.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALplainCilPrinter">plainCilPrinter</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Errormsg.html#VALpopContext">popContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Removes the last registered context printing function
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprepareCFG">prepareCFG</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Prepare a function for CFG information computation by
+ <a href="Cil.html#VALcomputeCFGInfo"><code class="code">Cil.computeCFGInfo</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALpretty">pretty</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+Pretty-print the state
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALpretty">pretty</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+Pretty-print the state
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALprint">print</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Print the current stats preceeded by a message
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintAttr">printAttr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print an attribute given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintAttrs">printAttrs</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print a set of attributes given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintBlock">printBlock</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print a block given a pretty printer.
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALprintCfgChannel">printCfgChannel</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+print control flow graph (in dot form) for fundec to channel
+</div>
+</td></tr>
+<tr><td><a href="Cfg.html#VALprintCfgFilename">printCfgFilename</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+Print control flow graph (in dot form) for fundec to file
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintCilAsIs">printCilAsIs</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether to print the CIL as they are, without trying to be smart and
+ print nicer code.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALprintDepth">printDepth</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Specifies the nesting depth of the <code class="code">align</code>/<code class="code">unalign</code> pairs at which
+ everything is replaced with ellipsis
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintExp">printExp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print an expression given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintGlobal">printGlobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print a global given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALprintIndent">printIndent</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+If false then does not indent
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintInit">printInit</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print an initializer given a pretty printer.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintInstr">printInstr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print an instruction given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintLval">printLval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print an lvalue given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintStmt">printStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print a statement given a pretty printer.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprintType">printType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Print a type given a pretty printer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprint_CIL_Input">print_CIL_Input</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether we print something that will only be used as input to our own
+ parser.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALprinterForMaincil">printerForMaincil</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALprintf">printf</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Like <a href="Pretty.html#VALfprintf"><code class="code">Pretty.fprintf</code></a> applied to <code class="code">stdout</code>
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALpushContext">pushContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Registers a context printing function
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALpushGlobal">pushGlobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+CIL keeps the types at the beginning of the file and the variables at the
+ end of the file.
+</div>
+</td></tr>
+<tr><td align="left"><br>R</td></tr>
+<tr><td><a href="Errormsg.html#VALreadingFromStdin">readingFromStdin</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Records whether the stdin is open for reading the goal *
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALreal">real</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A document that prints a real number
+</div>
+</td></tr>
+<tr><td><a href="Alpha.html#VALregisterAlphaName">registerAlphaName</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td><div class="info">
+Register a name with an alpha conversion table to ensure that when later
+ we call newAlphaName we do not end up generating this one
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALremoveOffset">removeOffset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Remove ONE offset from the end of an offset sequence.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALremoveOffsetLval">removeOffsetLval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Remove ONE offset from the end of an lvalue.
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALrepeattime">repeattime</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+repeattime is like time but runs the function several times until the total
+ running time is greater or equal to the first argument.
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALreset">reset</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Resets all the timings.
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALrev">rev</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Reverse a clist.
+</div>
+</td></tr>
+<tr><td align="left"><br>S</td></tr>
+<tr><td><a href="Errormsg.html#VALs">s</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Stop the execution by raising an Error.
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALsample_pentium_perfcount_10">sample_pentium_perfcount_10</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Sample the current cycle count, in kilocycles.
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALsample_pentium_perfcount_20">sample_pentium_perfcount_20</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Sample the current cycle count, in megacycles.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsaveBinaryFile">saveBinaryFile</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsaveBinaryFileChannel">saveBinaryFileChannel</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Write a <a href="Cil.html#TYPEfile"><code class="code">Cil.file</code></a> in binary form to the filesystem.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALseparateStorageModifiers">separateStorageModifiers</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Separate out the storage-modifier name attributes
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALseq">seq</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Formats a sequence.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALsetCurrentFile">setCurrentFile</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Errormsg.html#VALsetCurrentLine">setCurrentLine</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALsetFormals">setFormals</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Update the formals of a <code class="code">fundec</code> and make sure that the function type
+ has the same information.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsetFunctionType">setFunctionType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Set the types of arguments and results as given by the function type
+ passed as the second argument.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsetFunctionTypeMakeFormals">setFunctionTypeMakeFormals</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Set the type of the function and make formal arguments for them
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALsetHFile">setHFile</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Errormsg.html#VALsetHLine">setHLine</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALsetMaxId">setMaxId</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Update the smaxid after you have populated with locals and formals
+ (unless you constructed those using <a href="Cil.html#VALmakeLocalVar"><code class="code">Cil.makeLocalVar</code></a> or
+ <a href="Cil.html#VALmakeTempVar"><code class="code">Cil.makeTempVar</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsetTypeAttrs">setTypeAttrs</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALsetTypeSigAttrs">setTypeSigAttrs</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Replace the attributes of a signature (only at top level)
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALshowContext">showContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Show the context stack to stderr
+</div>
+</td></tr>
+<tr><td><a href="Clist.html#VALsingle">single</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Create a clist containing one element
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsizeOf">sizeOf</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALsplitFunctionType">splitFunctionType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Given a function type split it into return type,
+ arguments, is_vararg and attributes.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALsplitFunctionTypeVI">splitFunctionTypeVI</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Pretty.html#VALsprint">sprint</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Format the document to the given width and emit it as a string
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALstartParsing">startParsing</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Errormsg.html#VALstartParsingFromString">startParsingFromString</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cfg.html#VALstart_id">start_id</a> [<a href="Cfg.html">Cfg</a>]</td>
+<td><div class="info">
+Next statement id that will be assigned.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALstartsWith">startsWith</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+sm: return true if the first is a prefix of the second string
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.BackwardsTransfer.html#VALstmtStartData">stmtStartData</a> [<a href="Dataflow.BackwardsTransfer.html">Dataflow.BackwardsTransfer</a>]</td>
+<td><div class="info">
+For each block id, the data at the start.
+</div>
+</td></tr>
+<tr><td><a href="Dataflow.ForwardsTransfer.html#VALstmtStartData">stmtStartData</a> [<a href="Dataflow.ForwardsTransfer.html">Dataflow.ForwardsTransfer</a>]</td>
+<td><div class="info">
+For each statement id, the data at the start.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALstripCasts">stripCasts</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Removes casts from this expression, but ignores casts within
+ other expression constructs.
+</div>
+</td></tr>
+<tr><td align="left"><br>T</td></tr>
+<tr><td><a href="Formatcil.html#VALtest">test</a> [<a href="Formatcil.html">Formatcil</a>]</td>
+<td><div class="info">
+Just a testing function
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALtext">text</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+A document that prints the given string
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALtime">time</a> [<a href="Stats.html">Stats</a>]</td>
+<td><div class="info">
+Time a function and associate the time with the given string.
+</div>
+</td></tr>
+<tr><td><a href="Stats.html#VALtimethis">timethis</a> [<a href="Stats.html">Stats</a>]</td>
+<td></td></tr>
+<tr><td><a href="Clist.html#VALtoList">toList</a> [<a href="Clist.html">Clist</a>]</td>
+<td><div class="info">
+Convert a clist to an ordinary list
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeAddAttributes">typeAddAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Add some attributes to a type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeAttrs">typeAttrs</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Returns all the attributes contained in a type.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeOf">typeOf</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Compute the type of an expression
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeOfLval">typeOfLval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Compute the type of an lvalue
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeOfSizeOf">typeOfSizeOf</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALtypeOffset">typeOffset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Compute the type of an offset from a base type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeRemoveAttributes">typeRemoveAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Remove all attributes with the given names from a type.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeSig">typeSig</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Compute a type signature
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeSigAttrs">typeSigAttrs</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Get the top-level attributes of a signature
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALtypeSigWithAttrs">typeSigWithAttrs</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Cil.html#VALtypeSig"><code class="code">Cil.typeSig</code></a> but customize the incorporation of attributes.
+</div>
+</td></tr>
+<tr><td align="left"><br>U</td></tr>
+<tr><td><a href="Cil.html#VALuintPtrType">uintPtrType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+unsigned int *
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALuintType">uintType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+unsigned int
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALulongType">ulongType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+unsigned long
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALunalign">unalign</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Reverts to the last saved indentation level.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALunderscore_name">underscore_name</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether the compiler generates assembly labels by prepending "_" to the
+ identifier.
+</div>
+</td></tr>
+<tr><td><a href="Alpha.html#VALundoAlphaChanges">undoAlphaChanges</a> [<a href="Alpha.html">Alpha</a>]</td>
+<td><div class="info">
+Undo the changes to a table
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALunimp">unimp</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALunimp"><code class="code">Errormsg.unimp</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>is also printed
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALunimp">unimp</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Similar to <code class="code">error</code> except that its output has the form <code class="code">Unimplemented: ...</code>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALuniqueVarNames">uniqueVarNames</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Assign unique names to local variables.
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALunmark">unmark</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+The end of a markup section
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALunrollType">unrollType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Unroll a type until it exposes a non
+ <code class="code">TNamed</code>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALunrollTypeDeep">unrollTypeDeep</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Unroll all the TNamed in a type (even under type constructors such as
+ <code class="code">TPtr</code>, <code class="code">TFun</code> or <code class="code">TArray</code>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALupointType">upointType</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALuseLogicalOperators">useLogicalOperators</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Whether to use the logical operands LAnd and LOr.
+</div>
+</td></tr>
+<tr><td align="left"><br>V</td></tr>
+<tr><td><a href="Cil.html#VALvar">var</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Makes an lvalue out of a given variable
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALverboseFlag">verboseFlag</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALvisitCilAttributes">visitCilAttributes</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a list of attributes
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilBlock">visitCilBlock</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a block
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilExpr">visitCilExpr</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Cil.html#VALvisitCilFile">visitCilFile</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a file.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilFileSameGlobals">visitCilFileSameGlobals</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+A visitor for the whole file that does not change the globals (but maybe
+ changes things inside the globals).
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilFunction">visitCilFunction</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a function definition
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilGlobal">visitCilGlobal</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a global
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilInit">visitCilInit</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit an initializer
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilInitOffset">visitCilInitOffset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit an initializer offset
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilInstr">visitCilInstr</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit an instruction
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilLval">visitCilLval</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit an lvalue
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilOffset">visitCilOffset</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit an lvalue or recursive offset
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilStmt">visitCilStmt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a statement
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilType">visitCilType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a type
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvisitCilVarDecl">visitCilVarDecl</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Visit a variable declaration
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvoidPtrType">voidPtrType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+void *
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALvoidType">voidType</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+void
+</div>
+</td></tr>
+<tr><td align="left"><br>W</td></tr>
+<tr><td><a href="Cil.html#VALwarn">warn</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALwarn">warn</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALerror"><code class="code">Errormsg.error</code></a> but does not raise the <a href="Errormsg.html#EXCEPTIONError"><code class="code">Errormsg.Error</code></a>
+ exception.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALwarnContext">warnContext</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context
+ is also printed
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALwarnContextOpt">warnContextOpt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> and context is also
+ printed.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALwarnFlag">warnFlag</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Set to true if you want to see all warnings.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALwarnLoc">warnLoc</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Cil.html#VALwarn"><code class="code">Cil.warn</code></a> except that it explicitly takes a location argument,
+ instead of using the <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a>
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALwarnOpt">warnOpt</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALwarnOpt"><code class="code">Errormsg.warnOpt</code></a> except that <a href="Cil.html#VALcurrentLoc"><code class="code">Cil.currentLoc</code></a> is also printed.
+</div>
+</td></tr>
+<tr><td><a href="Errormsg.html#VALwarnOpt">warnOpt</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+Like <a href="Errormsg.html#VALwarn"><code class="code">Errormsg.warn</code></a> but optional.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALwcharKind">wcharKind</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+wchar_t (depends on architecture) and is set when you call
+ <a href="Cil.html#VALinitCIL"><code class="code">Cil.initCIL</code></a>.
+</div>
+</td></tr>
+<tr><td><a href="Cil.html#VALwcharType">wcharType</a> [<a href="Cil.html">Cil</a>]</td>
+<td></td></tr>
+<tr><td><a href="Errormsg.html#VALwithContext">withContext</a> [<a href="Errormsg.html">Errormsg</a>]</td>
+<td><div class="info">
+To ensure that the context is registered and removed properly, use the
+ function below
+</div>
+</td></tr>
+<tr><td><a href="Pretty.html#VALwithPrintDepth">withPrintDepth</a> [<a href="Pretty.html">Pretty</a>]</td>
+<td><div class="info">
+Invokes a thunk, with printDepth temporarily set to the specified value
+</div>
+</td></tr>
+<tr><td align="left"><br>Z</td></tr>
+<tr><td><a href="Cil.html#VALzero">zero</a> [<a href="Cil.html">Cil</a>]</td>
+<td><div class="info">
+0
+</div>
+</td></tr>
+</table><br>
+</body>
+</html> \ No newline at end of file
diff --git a/cil/doc/api/style.css b/cil/doc/api/style.css
new file mode 100644
index 0000000..11ed40c
--- /dev/null
+++ b/cil/doc/api/style.css
@@ -0,0 +1,32 @@
+a:visited {color : #416DFF; text-decoration : none; }
+a:link {color : #416DFF; text-decoration : none;}
+a:hover {color : Red; text-decoration : none; background-color: #5FFF88}
+a:active {color : Red; text-decoration : underline; }
+.keyword { font-weight : bold ; color : Red }
+.keywordsign { color : #C04600 }
+.superscript { font-size : 4 }
+.subscript { font-size : 4 }
+.comment { color : Green }
+.constructor { color : Blue }
+.type { color : #5C6585 }
+.string { color : Maroon }
+.warning { color : Red ; font-weight : bold }
+.info { margin-left : 3em; margin-right : 3em }
+.code { color : #465F91 ; }
+h1 { font-size : 20pt ; text-align: center; }
+h2 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90BDFF ;padding: 2px; }
+h3 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90DDFF ;padding: 2px; }
+h4 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90EDFF ;padding: 2px; }
+h5 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #90FDFF ;padding: 2px; }
+h6 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #C0FFFF ; padding: 2px; }
+div.h7 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #E0FFFF ; padding: 2px; }
+div.h8 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #F0FFFF ; padding: 2px; }
+div.h9 { font-size : 20pt ; border: 1px solid #000000; margin-top: 5px; margin-bottom: 2px;text-align: center; background-color: #FFFFFF ; padding: 2px; }
+.typetable { border-style : hidden }
+.indextable { border-style : hidden }
+.paramstable { border-style : hidden ; padding: 5pt 5pt}
+body { background-color : White }
+tr { background-color : White }
+td.typefieldcomment { background-color : #FFFFFF }
+pre { margin-bottom: 4px }
+div.sig_block {margin-left: 2em} \ No newline at end of file
diff --git a/cil/doc/api/type_Alpha.html b/cil/doc/api/type_Alpha.html
new file mode 100644
index 0000000..b97c835
--- /dev/null
+++ b/cil/doc/api/type_Alpha.html
@@ -0,0 +1,43 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Alpha</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;undoAlphaElement<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;alphaTableData<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;newAlphaName&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;alphaTable:(string,&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.alphaTableData&nbsp;<span class="constructor">Pervasives</span>.ref)&nbsp;<span class="constructor">Hashtbl</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;undolist:<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.undoAlphaElement&nbsp;list&nbsp;<span class="constructor">Pervasives</span>.ref&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;lookupname:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;data:<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;*&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;registerAlphaName&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;alphaTable:(string,&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.alphaTableData&nbsp;<span class="constructor">Pervasives</span>.ref)&nbsp;<span class="constructor">Hashtbl</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;undolist:<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.undoAlphaElement&nbsp;list&nbsp;<span class="constructor">Pervasives</span>.ref&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;lookupname:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;data:<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docAlphaTable&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(string,&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.alphaTableData&nbsp;<span class="constructor">Pervasives</span>.ref)&nbsp;<span class="constructor">Hashtbl</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getAlphaPrefix&nbsp;:&nbsp;lookupname:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;undoAlphaChanges&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;alphaTable:(string,&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.alphaTableData&nbsp;<span class="constructor">Pervasives</span>.ref)&nbsp;<span class="constructor">Hashtbl</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;undolist:<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Alpha</span>.undoAlphaElement&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cfg.html b/cil/doc/api/type_Cfg.html
new file mode 100644
index 0000000..996d773
--- /dev/null
+++ b/cil/doc/api/type_Cfg.html
@@ -0,0 +1,35 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cfg</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;computeFileCFG&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;clearFileCFG&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cfgFun&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;clearCFGinfo&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printCfgChannel&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printCfgFilename&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;start_id&nbsp;:&nbsp;int&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;nodeList&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;numNodes&nbsp;:&nbsp;int&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cil.cilPrinter.html b/cil/doc/api/type_Cil.cilPrinter.html
new file mode 100644
index 0000000..ff117f5
--- /dev/null
+++ b/cil/doc/api/type_Cil.cilPrinter.html
@@ -0,0 +1,48 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilPrinter</title>
+</head>
+<body>
+<code class="code"><span class="keyword">object</span><br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dBlock&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dGlobal&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dInit&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dStmt&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pAttr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;*&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pAttrParam&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pAttrs&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pBlock&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pExp&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pFieldDecl&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fieldinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pGlobal&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pInit&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pInstr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pLabel&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.label&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pLineDirective&nbsp;:&nbsp;?forcefile:bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pLval&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pOffset&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pStmt&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pStmtKind&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmtkind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pType&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pVDecl&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pVar&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cil.cilVisitor.html b/cil/doc/api/type_Cil.cilVisitor.html
new file mode 100644
index 0000000..efe3d13
--- /dev/null
+++ b/cil/doc/api/type_Cil.cilVisitor.html
@@ -0,0 +1,43 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.cilVisitor</title>
+</head>
+<body>
+<code class="code"><span class="keyword">object</span><br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;queueInstr&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;unqueueInstr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vattr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vattrparam&nbsp;:&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vblock&nbsp;:&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vexpr&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vfunc&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vglob&nbsp;:&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;list&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vinit&nbsp;:&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vinitoffs&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vinst&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vlval&nbsp;:&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;voffs&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vstmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vtype&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vvdec&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vvrbl&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cil.defaultCilPrinterClass.html b/cil/doc/api/type_Cil.defaultCilPrinterClass.html
new file mode 100644
index 0000000..75a36eb
--- /dev/null
+++ b/cil/doc/api/type_Cil.defaultCilPrinterClass.html
@@ -0,0 +1,25 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.defaultCilPrinterClass</title>
+</head>
+<body>
+<code class="code"><span class="constructor">Cil</span>.cilPrinter</code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cil.html b/cil/doc/api/type_Cil.html
new file mode 100644
index 0000000..da6f9e9
--- /dev/null
+++ b/cil/doc/api/type_Cil.html
@@ -0,0 +1,622 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;initCIL&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cilVersion&nbsp;:&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cilVersionMajor&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cilVersionMinor&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cilVersionRevision&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;file&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;fileName&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;globals&nbsp;:&nbsp;<span class="constructor">Cil</span>.global&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;globinit&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;option;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;globinitcalled&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;comment&nbsp;=&nbsp;<span class="constructor">Cil</span>.location&nbsp;*&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;global&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">GType</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typeinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GCompTag</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.compinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GCompTagDecl</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.compinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GEnumTag</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.enuminfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GEnumTagDecl</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.enuminfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GVarDecl</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GVar</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.initinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GFun</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GAsm</span>&nbsp;<span class="keyword">of</span>&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GPragma</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GText</span>&nbsp;<span class="keyword">of</span>&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;typ&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">TVoid</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TInt</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TFloat</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.fkind&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TPtr</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TArray</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;option&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TFun</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;list&nbsp;option&nbsp;*<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;bool&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TNamed</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typeinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TComp</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.compinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TEnum</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.enuminfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TBuiltin_va_list</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;ikind&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">IChar</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ISChar</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IUChar</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IInt</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IUInt</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IShort</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IUShort</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ILong</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IULong</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ILongLong</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IULongLong</span><br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;fkind&nbsp;=&nbsp;<span class="constructor">FFloat</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FDouble</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FLongDouble</span><br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;attribute&nbsp;=&nbsp;<span class="constructor">Attr</span>&nbsp;<span class="keyword">of</span>&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;attributes&nbsp;=&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;attrparam&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">AInt</span>&nbsp;<span class="keyword">of</span>&nbsp;int<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AStr</span>&nbsp;<span class="keyword">of</span>&nbsp;string<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ACons</span>&nbsp;<span class="keyword">of</span>&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ASizeOf</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ASizeOfE</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attrparam<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ASizeOfS</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typsig<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AAlignOf</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AAlignOfE</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attrparam<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AAlignOfS</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typsig<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AUnOp</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.unop&nbsp;*&nbsp;<span class="constructor">Cil</span>.attrparam<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ABinOp</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.binop&nbsp;*&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;*&nbsp;<span class="constructor">Cil</span>.attrparam<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ADot</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;*&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;compinfo&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;cstruct&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;cname&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;ckey&nbsp;:&nbsp;int;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;cfields&nbsp;:&nbsp;<span class="constructor">Cil</span>.fieldinfo&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;cattr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attributes;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;cdefined&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;creferenced&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;fieldinfo&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;fcomp&nbsp;:&nbsp;<span class="constructor">Cil</span>.compinfo;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;fname&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;ftype&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;fbitfield&nbsp;:&nbsp;int&nbsp;option;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;fattr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attributes;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;floc&nbsp;:&nbsp;<span class="constructor">Cil</span>.location;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;enuminfo&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;ename&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;eitems&nbsp;:&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.location)&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;eattr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attributes;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;ereferenced&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;typeinfo&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;tname&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;ttype&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;treferenced&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;varinfo&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vname&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vtype&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vattr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attributes;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vstorage&nbsp;:&nbsp;<span class="constructor">Cil</span>.storage;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vglob&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vinline&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vdecl&nbsp;:&nbsp;<span class="constructor">Cil</span>.location;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vid&nbsp;:&nbsp;int;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vaddrof&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;vreferenced&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;storage&nbsp;=&nbsp;<span class="constructor">NoStorage</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Static</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Register</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Extern</span><br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;exp&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Const</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.constant<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Lval</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">SizeOf</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">SizeOfE</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">SizeOfStr</span>&nbsp;<span class="keyword">of</span>&nbsp;string<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AlignOf</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AlignOfE</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">UnOp</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.unop&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">BinOp</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.binop&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CastE</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AddrOf</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">StartOf</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;constant&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">CInt64</span>&nbsp;<span class="keyword">of</span>&nbsp;int64&nbsp;*&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;*&nbsp;string&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CStr</span>&nbsp;<span class="keyword">of</span>&nbsp;string<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CWStr</span>&nbsp;<span class="keyword">of</span>&nbsp;int64&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CChr</span>&nbsp;<span class="keyword">of</span>&nbsp;char<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CReal</span>&nbsp;<span class="keyword">of</span>&nbsp;float&nbsp;*&nbsp;<span class="constructor">Cil</span>.fkind&nbsp;*&nbsp;string&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CEnum</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.enuminfo<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;unop&nbsp;=&nbsp;<span class="constructor">Neg</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">BNot</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">LNot</span><br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;binop&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">PlusA</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">PlusPI</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">IndexPI</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">MinusA</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">MinusPI</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">MinusPP</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Mult</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Div</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Mod</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Shiftlt</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Shiftrt</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Lt</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Gt</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Le</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Ge</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Eq</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Ne</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">BAnd</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">BXor</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">BOr</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">LAnd</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">LOr</span><br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;lval&nbsp;=&nbsp;<span class="constructor">Cil</span>.lhost&nbsp;*&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;lhost&nbsp;=&nbsp;<span class="constructor">Var</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Mem</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;offset&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">NoOffset</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Field</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.fieldinfo&nbsp;*&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Index</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;init&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">SingleInit</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CompoundInit</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;(<span class="constructor">Cil</span>.offset&nbsp;*&nbsp;<span class="constructor">Cil</span>.init)&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;initinfo&nbsp;=&nbsp;{&nbsp;<span class="keyword">mutable</span>&nbsp;init&nbsp;:&nbsp;<span class="constructor">Cil</span>.init&nbsp;option;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;fundec&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;svar&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;sformals&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;slocals&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;smaxid&nbsp;:&nbsp;int;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;sbody&nbsp;:&nbsp;<span class="constructor">Cil</span>.block;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;smaxstmtid&nbsp;:&nbsp;int&nbsp;option;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;sallstmts&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;block&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;battrs&nbsp;:&nbsp;<span class="constructor">Cil</span>.attributes;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;bstmts&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;stmt&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;labels&nbsp;:&nbsp;<span class="constructor">Cil</span>.label&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;skind&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmtkind;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;sid&nbsp;:&nbsp;int;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;succs&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">mutable</span>&nbsp;preds&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;label&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Label</span>&nbsp;<span class="keyword">of</span>&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.location&nbsp;*&nbsp;bool<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Case</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Default</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;stmtkind&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Instr</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Return</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;option&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Goto</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="constructor">Pervasives</span>.ref&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Break</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Continue</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">If</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Switch</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Loop</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;<span class="constructor">Cil</span>.location&nbsp;*&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option&nbsp;*&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Block</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.block<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TryFinally</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TryExcept</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;*&nbsp;(<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp)&nbsp;*&nbsp;<span class="constructor">Cil</span>.block&nbsp;*<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;instr&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Set</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Call</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;option&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Asm</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;*&nbsp;string&nbsp;list&nbsp;*&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.lval)&nbsp;list&nbsp;*<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.exp)&nbsp;list&nbsp;*&nbsp;string&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;location&nbsp;=&nbsp;{&nbsp;line&nbsp;:&nbsp;int;&nbsp;file&nbsp;:&nbsp;string;&nbsp;byte&nbsp;:&nbsp;int;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">and</span>&nbsp;typsig&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">TSArray</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;*&nbsp;int64&nbsp;option&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TSPtr</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TSComp</span>&nbsp;<span class="keyword">of</span>&nbsp;bool&nbsp;*&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TSFun</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;*&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;list&nbsp;*&nbsp;bool&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TSEnum</span>&nbsp;<span class="keyword">of</span>&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">TSBase</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;lowerConstants&nbsp;:&nbsp;bool&nbsp;ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;insertImplicitCasts&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;featureDescr&nbsp;=&nbsp;{<br>
+&nbsp;&nbsp;&nbsp;&nbsp;fd_enabled&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;fd_name&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;fd_description&nbsp;:&nbsp;string;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;fd_extraopt&nbsp;:&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Arg</span>.spec&nbsp;*&nbsp;string)&nbsp;list;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;fd_doit&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit;<br>
+&nbsp;&nbsp;&nbsp;&nbsp;fd_post_check&nbsp;:&nbsp;bool;<br>
+&nbsp;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;compareLoc&nbsp;:&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;emptyFunction&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setFormals&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setFunctionType&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setFunctionTypeMakeFormals&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setMaxId&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dummyFunDec&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dummyFile&nbsp;:&nbsp;<span class="constructor">Cil</span>.file<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;saveBinaryFile&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;saveBinaryFileChannel&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;loadBinaryFile&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.file<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getGlobInit&nbsp;:&nbsp;?main_name:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;iterGlobals&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;foldGlobals&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mapGlobals&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;new_sid&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;prepareCFG&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;computeCFGInfo&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;copyFunction&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;pushGlobal&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;types:<span class="constructor">Cil</span>.global&nbsp;list&nbsp;<span class="constructor">Pervasives</span>.ref&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;variables:<span class="constructor">Cil</span>.global&nbsp;list&nbsp;<span class="constructor">Pervasives</span>.ref&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;invalidStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;gccBuiltins&nbsp;:&nbsp;(string,&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;list&nbsp;*&nbsp;bool)&nbsp;<span class="constructor">Hashtbl</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;msvcBuiltins&nbsp;:&nbsp;(string,&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;list&nbsp;*&nbsp;bool)&nbsp;<span class="constructor">Hashtbl</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;makeZeroInit&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;foldLeftCompound&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;doinit:(<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;ct:<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;initl:(<span class="constructor">Cil</span>.offset&nbsp;*&nbsp;<span class="constructor">Cil</span>.init)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;acc:<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;foldLeftCompoundAll&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;doinit:(<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;ct:<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;initl:(<span class="constructor">Cil</span>.offset&nbsp;*&nbsp;<span class="constructor">Cil</span>.init)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;acc:<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;voidType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isVoidType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isVoidPtrType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;intType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;uintType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;longType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;ulongType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;charType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;charPtrType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;wcharKind&nbsp;:&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;wcharType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;charConstPtrType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;voidPtrType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;intPtrType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;uintPtrType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doubleType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;upointType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeOfSizeOf&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isSigned&nbsp;:&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkCompInfo&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Cil</span>.compinfo&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;int&nbsp;option&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;*&nbsp;<span class="constructor">Cil</span>.location)&nbsp;list)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.compinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;copyCompInfo&nbsp;:&nbsp;<span class="constructor">Cil</span>.compinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.compinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;missingFieldName&nbsp;:&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;compFullName&nbsp;:&nbsp;<span class="constructor">Cil</span>.compinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isCompleteType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;unrollType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;unrollTypeDeep&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;separateStorageModifiers&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isIntegralType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isArithmeticType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isPointerType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isFunctionType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;argsToList&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;list&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isArrayType&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">exception</span>&nbsp;<span class="constructor">LenOfArray</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;lenOfArray&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getCompField&nbsp;:&nbsp;<span class="constructor">Cil</span>.compinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fieldinfo<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;existsAction&nbsp;=&nbsp;<span class="constructor">ExistsTrue</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ExistsFalse</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ExistsMaybe</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;existsType&nbsp;:&nbsp;(<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.existsAction)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;splitFunctionType&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;list&nbsp;option&nbsp;*&nbsp;bool&nbsp;*<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;splitFunctionTypeVI&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;list&nbsp;option&nbsp;*&nbsp;bool&nbsp;*<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_typsig&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeSig&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typsig<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeSigWithAttrs&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;?ignoreSign:bool&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typsig<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setTypeSigAttrs&nbsp;:&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typsig<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeSigAttrs&nbsp;:&nbsp;<span class="constructor">Cil</span>.typsig&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;makeVarinfo&nbsp;:&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;makeFormalVar&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;?where:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;makeLocalVar&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;?insert:bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;makeTempVar&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;?name:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;makeGlobalVar&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;copyVarinfo&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;newVID&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;addOffsetLval&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;addOffset&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;removeOffsetLval&nbsp;:&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;*&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;removeOffset&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;*&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeOfLval&nbsp;:&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeOffset&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;zero&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;one&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mone&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;kinteger64&nbsp;:&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int64&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;kinteger&nbsp;:&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;integer&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isInteger&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int64&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isConstant&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;isZero&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;charConstToInt&nbsp;:&nbsp;char&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.constant<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;constFold&nbsp;:&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;constFoldBinOp&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.binop&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;increm&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;var&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkAddrOf&nbsp;:&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkAddrOrStartOf&nbsp;:&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkMem&nbsp;:&nbsp;addr:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;off:<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkString&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkCastT&nbsp;:&nbsp;e:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;oldt:<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;newt:<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkCast&nbsp;:&nbsp;e:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;newt:<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stripCasts&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeOf&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;parseInt&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmtkind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkBlock&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkStmtOneInstr&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;compactStmts&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkEmptyStmt&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dummyInstr&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dummyStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkWhile&nbsp;:&nbsp;guard:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;body:<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkForIncr&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;iter:<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;first:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;stopat:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;incr:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;body:<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mkFor&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;start:<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;guard:<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;next:<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;body:<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;attributeClass&nbsp;=&nbsp;<span class="constructor">AttrName</span>&nbsp;<span class="keyword">of</span>&nbsp;bool&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AttrFunType</span>&nbsp;<span class="keyword">of</span>&nbsp;bool&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">AttrType</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;attributeHash&nbsp;:&nbsp;(string,&nbsp;<span class="constructor">Cil</span>.attributeClass)&nbsp;<span class="constructor">Hashtbl</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;partitionAttributes&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;default:<span class="constructor">Cil</span>.attributeClass&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;*&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;addAttribute&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;addAttributes&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dropAttribute&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dropAttributes&nbsp;:&nbsp;string&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;filterAttributes&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;hasAttribute&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeAttrs&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setTypeAttrs&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeAddAttributes&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;typeRemoveAttributes&nbsp;:&nbsp;string&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;visitAction&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">SkipChildren</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">DoChildren</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ChangeTo</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">ChangeDoChildrenPost</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;*&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)<br>
+&nbsp;&nbsp;<span class="keyword">class</span>&nbsp;<span class="keyword">type</span>&nbsp;cilVisitor&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">object</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;queueInstr&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;unqueueInstr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vattr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vattrparam&nbsp;:&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vblock&nbsp;:&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vexpr&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vfunc&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vglob&nbsp;:&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;list&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vinit&nbsp;:&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vinitoffs&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vinst&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vlval&nbsp;:&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;voffs&nbsp;:&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vstmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vtype&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vvdec&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;vvrbl&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="constructor">Cil</span>.visitAction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">class</span>&nbsp;nopCilVisitor&nbsp;:&nbsp;cilVisitor<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilFile&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilFileSameGlobals&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilGlobal&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilFunction&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fundec<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilExpr&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilLval&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilOffset&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilInitOffset&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilInstr&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilBlock&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilType&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilVarDecl&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilInit&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;visitCilAttributes&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;msvcMode&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;useLogicalOperators&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;constFoldVisitor&nbsp;:&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.cilVisitor<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;lineDirectiveStyle&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">LineComment</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">LinePreprocessorInput</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">LinePreprocessorOutput</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;lineDirectiveStyle&nbsp;:&nbsp;<span class="constructor">Cil</span>.lineDirectiveStyle&nbsp;option&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;print_CIL_Input&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printCilAsIs&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;lineLength&nbsp;:&nbsp;int&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;forgcc&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;currentLoc&nbsp;:&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;currentGlobal&nbsp;:&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_loc&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_thisloc&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_ikind&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.ikind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_fkind&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fkind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_storage&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.storage&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_const&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.constant&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;derefStarLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;indexLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;arrowLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;addrOfLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;additiveLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;comparativeLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;bitwiseLevel&nbsp;:&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getParenthLevel&nbsp;:&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">class</span>&nbsp;<span class="keyword">type</span>&nbsp;cilPrinter&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">object</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dBlock&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dGlobal&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dInit&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;dStmt&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pAttr&nbsp;:&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;*&nbsp;bool<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pAttrParam&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pAttrs&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pBlock&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pExp&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pFieldDecl&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.fieldinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pGlobal&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pInit&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pInstr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pLabel&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.label&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pLineDirective&nbsp;:&nbsp;?forcefile:bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pLval&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pOffset&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pStmt&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pStmtKind&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmtkind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pType&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pVDecl&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">method</span>&nbsp;pVar&nbsp;:&nbsp;<span class="constructor">Cil</span>.varinfo&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">class</span>&nbsp;defaultCilPrinterClass&nbsp;:&nbsp;cilPrinter<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;defaultCilPrinter&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter<br>
+&nbsp;&nbsp;<span class="keyword">class</span>&nbsp;plainCilPrinterClass&nbsp;:&nbsp;cilPrinter<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;plainCilPrinter&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printerForMaincil&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printType&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printExp&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printLval&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printGlobal&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printAttr&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printAttrs&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printInstr&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printBlock&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dumpStmt&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dumpBlock&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printInit&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dumpInit&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_type&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_exp&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_lval&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_offset&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_init&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_binop&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.binop&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_unop&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.unop&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_attr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_attrparam&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_attrlist&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_instr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_label&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.label&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_stmt&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_block&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.block&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_global&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_exp&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_lval&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_init&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_type&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_global&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_attrlist&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attributes&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_attr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attribute&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_attrparam&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_stmt&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dn_instr&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_shortglobal&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dumpGlobal&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dumpFile&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.cilPrinter&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;bug&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;unimp&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;error&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;errorLoc&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warn&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warnOpt&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warnContext&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warnContextOpt&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warnLoc&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_plainexp&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_plaininit&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.init&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_plainlval&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_plaintype&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;uniqueVarNames&nbsp;:&nbsp;<span class="constructor">Cil</span>.file&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;peepHole2&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Cil</span>.instr&nbsp;*&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;option)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;peepHole1&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list&nbsp;option)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">exception</span>&nbsp;<span class="constructor">SizeOfError</span>&nbsp;<span class="keyword">of</span>&nbsp;string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;bitsSizeOf&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;sizeOf&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;alignOf_int&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;bitsOffset&nbsp;:&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.offset&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;*&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;char_is_unsigned&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;little_endian&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;underscore_name&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;locUnknown&nbsp;:&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;get_instrLoc&nbsp;:&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;get_globalLoc&nbsp;:&nbsp;<span class="constructor">Cil</span>.global&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;get_stmtLoc&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmtkind&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dExp&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dInstr&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dGlobal&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.global<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mapNoCopy&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mapNoCopyList&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;startsWith&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;formatArg&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Fe</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Feo</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fu</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.unop<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fb</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.binop<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fk</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.ikind<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FE</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Ff</span>&nbsp;<span class="keyword">of</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FF</span>&nbsp;<span class="keyword">of</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.typ&nbsp;*&nbsp;<span class="constructor">Cil</span>.attributes)&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fva</span>&nbsp;<span class="keyword">of</span>&nbsp;bool<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fv</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.varinfo<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fl</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Flo</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fo</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.offset<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fc</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.compinfo<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fi</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.instr<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FI</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Ft</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fd</span>&nbsp;<span class="keyword">of</span>&nbsp;int<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fg</span>&nbsp;<span class="keyword">of</span>&nbsp;string<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fs</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FS</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FA</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attributes<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Fp</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attrparam<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FP</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="constructor">Cil</span>.attrparam&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">FX</span>&nbsp;<span class="keyword">of</span>&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_formatarg&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.formatArg&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;lowerConstants&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cil.nopCilVisitor.html b/cil/doc/api/type_Cil.nopCilVisitor.html
new file mode 100644
index 0000000..0ac6c96
--- /dev/null
+++ b/cil/doc/api/type_Cil.nopCilVisitor.html
@@ -0,0 +1,25 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.nopCilVisitor</title>
+</head>
+<body>
+<code class="code"><span class="constructor">Cil</span>.cilVisitor</code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cil.plainCilPrinterClass.html b/cil/doc/api/type_Cil.plainCilPrinterClass.html
new file mode 100644
index 0000000..ecd6317
--- /dev/null
+++ b/cil/doc/api/type_Cil.plainCilPrinterClass.html
@@ -0,0 +1,25 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cil.plainCilPrinterClass</title>
+</head>
+<body>
+<code class="code"><span class="constructor">Cil</span>.cilPrinter</code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Cillower.html b/cil/doc/api/type_Cillower.html
new file mode 100644
index 0000000..a8924ed
--- /dev/null
+++ b/cil/doc/api/type_Cillower.html
@@ -0,0 +1,25 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Cillower</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span>&nbsp;<span class="keyword">val</span>&nbsp;lowerEnumVisitor&nbsp;:&nbsp;<span class="constructor">Cil</span>.cilVisitor&nbsp;<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Clist.html b/cil/doc/api/type_Clist.html
new file mode 100644
index 0000000..c7dbd02
--- /dev/null
+++ b/cil/doc/api/type_Clist.html
@@ -0,0 +1,44 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Clist</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;clist&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">CList</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CConsL</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;*&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CConsR</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;*&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">CSeq</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;*&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;toList&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fromList&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;single&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;empty&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;append&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;checkBeforeAppend&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;length&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;map&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fold_left&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;iter&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;rev&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docCList&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Clist</span>.clist&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.BackwardsDataFlow.html b/cil/doc/api/type_Dataflow.BackwardsDataFlow.html
new file mode 100644
index 0000000..78ffeba
--- /dev/null
+++ b/cil/doc/api/type_Dataflow.BackwardsDataFlow.html
@@ -0,0 +1,26 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsDataFlow</title>
+</head>
+<body>
+<code class="code"><span class="keyword">functor</span>&nbsp;(<span class="constructor">T</span>&nbsp;:&nbsp;<span class="constructor">BackwardsTransfer</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;<span class="keyword">sig</span>&nbsp;<span class="keyword">val</span>&nbsp;compute&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.BackwardsTransfer.html b/cil/doc/api/type_Dataflow.BackwardsTransfer.html
new file mode 100644
index 0000000..763df74
--- /dev/null
+++ b/cil/doc/api/type_Dataflow.BackwardsTransfer.html
@@ -0,0 +1,44 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.BackwardsTransfer</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;name&nbsp;:&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;debug&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;pretty&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stmtStartData&nbsp;:&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="constructor">Inthash</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;combineStmtStartData&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;old:<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;combineSuccessors&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.action<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doInstr&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.action<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;filterStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.ForwardsDataFlow.html b/cil/doc/api/type_Dataflow.ForwardsDataFlow.html
new file mode 100644
index 0000000..a042cfc
--- /dev/null
+++ b/cil/doc/api/type_Dataflow.ForwardsDataFlow.html
@@ -0,0 +1,25 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsDataFlow</title>
+</head>
+<body>
+<code class="code"><span class="keyword">functor</span>&nbsp;(<span class="constructor">T</span>&nbsp;:&nbsp;<span class="constructor">ForwardsTransfer</span>)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keyword">sig</span>&nbsp;<span class="keyword">val</span>&nbsp;compute&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.ForwardsTransfer.html b/cil/doc/api/type_Dataflow.ForwardsTransfer.html
new file mode 100644
index 0000000..1e4d48b
--- /dev/null
+++ b/cil/doc/api/type_Dataflow.ForwardsTransfer.html
@@ -0,0 +1,51 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow.ForwardsTransfer</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;name&nbsp;:&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;debug&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;copy&nbsp;:&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stmtStartData&nbsp;:&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Inthash</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;pretty&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;computeFirstPredecessor&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;combinePredecessors&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;old:<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doInstr&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.action<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doStmt&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.stmtaction<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doGuard&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.guardaction<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;filterStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Dataflow.html b/cil/doc/api/type_Dataflow.html
new file mode 100644
index 0000000..fa03476
--- /dev/null
+++ b/cil/doc/api/type_Dataflow.html
@@ -0,0 +1,85 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dataflow</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;action&nbsp;=&nbsp;<span class="constructor">Default</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Done</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">Post</span>&nbsp;<span class="keyword">of</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;stmtaction&nbsp;=&nbsp;<span class="constructor">SDefault</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">SDone</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">SUse</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;guardaction&nbsp;=&nbsp;<span class="constructor">GDefault</span>&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GUse</span>&nbsp;<span class="keyword">of</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">|</span>&nbsp;<span class="constructor">GUnreachable</span><br>
+&nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="keyword">type</span>&nbsp;<span class="constructor">ForwardsTransfer</span>&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;name&nbsp;:&nbsp;string<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;debug&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;copy&nbsp;:&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stmtStartData&nbsp;:&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Inthash</span>.t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;pretty&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;computeFirstPredecessor&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;combinePredecessors&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;old:<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doInstr&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.action<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doStmt&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.stmtaction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doGuard&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">ForwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.guardaction<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;filterStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="constructor">ForwardsDataFlow</span>&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">functor</span>&nbsp;(<span class="constructor">T</span>&nbsp;:&nbsp;<span class="constructor">ForwardsTransfer</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">sig</span>&nbsp;<span class="keyword">val</span>&nbsp;compute&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="keyword">type</span>&nbsp;<span class="constructor">BackwardsTransfer</span>&nbsp;=<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;name&nbsp;:&nbsp;string<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;debug&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;pretty&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;stmtStartData&nbsp;:&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="constructor">Inthash</span>.t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;combineStmtStartData&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;old:<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;option<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;combineSuccessors&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.action<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;doInstr&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Dataflow</span>.<span class="constructor">BackwardsTransfer</span>.t&nbsp;<span class="constructor">Dataflow</span>.action<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;filterStmt&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="constructor">BackwardsDataFlow</span>&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">functor</span>&nbsp;(<span class="constructor">T</span>&nbsp;:&nbsp;<span class="constructor">BackwardsTransfer</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">sig</span>&nbsp;<span class="keyword">val</span>&nbsp;compute&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keyword">end</span><br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Dominators.html b/cil/doc/api/type_Dominators.html
new file mode 100644
index 0000000..a9fef53
--- /dev/null
+++ b/cil/doc/api/type_Dominators.html
@@ -0,0 +1,32 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Dominators</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;computeIDom&nbsp;:&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option&nbsp;<span class="constructor">Inthash</span>.t<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getIdom&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option&nbsp;<span class="constructor">Inthash</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dominates&nbsp;:&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option&nbsp;<span class="constructor">Inthash</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;findNaturalLoops&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.fundec&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;option&nbsp;<span class="constructor">Inthash</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="constructor">Cil</span>.stmt&nbsp;*&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list)&nbsp;list<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Errormsg.html b/cil/doc/api/type_Errormsg.html
new file mode 100644
index 0000000..3ad0a86
--- /dev/null
+++ b/cil/doc/api/type_Errormsg.html
@@ -0,0 +1,64 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Errormsg</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;logChannel&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;debugFlag&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;verboseFlag&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warnFlag&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">exception</span>&nbsp;<span class="constructor">Error</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;error&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;bug&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;unimp&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;s&nbsp;:&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;hadErrors&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warn&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;warnOpt&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;log&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;logg&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;null&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;unit)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;pushContext&nbsp;:&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;popContext&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;showContext&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;withContext&nbsp;:&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;newline&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;newHline&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getPosition&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;*&nbsp;string&nbsp;*&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getHPosition&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int&nbsp;*&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setHLine&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setHFile&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setCurrentLine&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;setCurrentFile&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;location&nbsp;=&nbsp;{&nbsp;file&nbsp;:&nbsp;string;&nbsp;line&nbsp;:&nbsp;int;&nbsp;hfile&nbsp;:&nbsp;string;&nbsp;hline&nbsp;:&nbsp;int;&nbsp;}<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_loc&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Errormsg</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_hloc&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Errormsg</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;getLocation&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Errormsg</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;parse_error&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;locUnknown&nbsp;:&nbsp;<span class="constructor">Errormsg</span>.location<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;readingFromStdin&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;startParsing&nbsp;:&nbsp;?useBasename:bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Lexing</span>.lexbuf<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;startParsingFromString&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;?file:string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;?line:int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Lexing</span>.lexbuf<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;finishParsing&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Formatcil.html b/cil/doc/api/type_Formatcil.html
new file mode 100644
index 0000000..7c5139b
--- /dev/null
+++ b/cil/doc/api/type_Formatcil.html
@@ -0,0 +1,45 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Formatcil</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cExp&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.formatArg)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cLval&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.formatArg)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cType&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.formatArg)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cInstr&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.formatArg)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cStmt&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.formatArg)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;cStmts&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.varinfo)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Cil</span>.location&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(string&nbsp;*&nbsp;<span class="constructor">Cil</span>.formatArg)&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.stmt&nbsp;list<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dExp&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.exp&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.formatArg&nbsp;list&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dLval&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.lval&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.formatArg&nbsp;list&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dType&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.typ&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.formatArg&nbsp;list&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dInstr&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.instr&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Cil</span>.formatArg&nbsp;list&nbsp;option<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;noMemoize&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;test&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Pretty.MakeMapPrinter.html b/cil/doc/api/type_Pretty.MakeMapPrinter.html
new file mode 100644
index 0000000..0b9d35e
--- /dev/null
+++ b/cil/doc/api/type_Pretty.MakeMapPrinter.html
@@ -0,0 +1,42 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeMapPrinter</title>
+</head>
+<body>
+<code class="code"><span class="keyword">functor</span><br>
+&nbsp;&nbsp;(<span class="constructor">Map</span>&nbsp;:&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;key<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fold&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.key&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docMap&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;?sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Map</span>.key&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Map</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_map&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;?dmaplet:(<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Map</span>.key&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Map</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Pretty.MakeSetPrinter.html b/cil/doc/api/type_Pretty.MakeSetPrinter.html
new file mode 100644
index 0000000..c5e0466
--- /dev/null
+++ b/cil/doc/api/type_Pretty.MakeSetPrinter.html
@@ -0,0 +1,40 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty.MakeSetPrinter</title>
+</head>
+<body>
+<code class="code"><span class="keyword">functor</span><br>
+&nbsp;&nbsp;(<span class="constructor">Set</span>&nbsp;:&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;elt<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fold&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.elt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docSet&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;?sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Set</span>.elt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Set</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_set&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Set</span>.elt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Set</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Pretty.html b/cil/doc/api/type_Pretty.html
new file mode 100644
index 0000000..fc70f65
--- /dev/null
+++ b/cil/doc/api/type_Pretty.html
@@ -0,0 +1,111 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Pretty</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;nil&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;(&nbsp;++&nbsp;)&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;concat&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;text&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;num&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;real&nbsp;:&nbsp;float&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;chr&nbsp;:&nbsp;char&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;line&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;leftflush&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;break&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;align&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;unalign&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;mark&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;unmark&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;indent&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;markup&nbsp;:&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;seq&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;doit:(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;elements:<span class="keywordsign">'</span>a&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docList&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;?sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_list&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;list&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docArray&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;?sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;(int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;array&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docOpt&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;option&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_int32&nbsp;:&nbsp;int32&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;f_int32&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int32&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_int64&nbsp;:&nbsp;int64&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;f_int64&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int64&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="constructor">MakeMapPrinter</span>&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">functor</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Map</span>&nbsp;:&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;key<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fold&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.key&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Pretty</span>.<span class="constructor">MakeMapPrinter</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docMap&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;?sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Map</span>.key&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Map</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_map&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;?dmaplet:(<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Map</span>.key&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="constructor">Map</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">module</span>&nbsp;<span class="constructor">MakeSetPrinter</span>&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">functor</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Set</span>&nbsp;:&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;elt<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">type</span>&nbsp;t<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fold&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.elt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Pretty</span>.<span class="constructor">MakeSetPrinter</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span>)&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">sig</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;docSet&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;?sep:<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Set</span>.elt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Set</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;d_set&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span><br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Set</span>.elt&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Set</span>.t&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span class="keyword">end</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;insert&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;dprintf&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;gprintf&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;(<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>b,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc,&nbsp;<span class="keywordsign">'</span>a)&nbsp;format4&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fprint&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;width:int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;sprint&nbsp;:&nbsp;width:int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="constructor">Pretty</span>.doc&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fprintf&nbsp;:<br>
+&nbsp;&nbsp;&nbsp;&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printf&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;eprintf&nbsp;:&nbsp;(<span class="keywordsign">'</span>a,&nbsp;unit,&nbsp;<span class="constructor">Pretty</span>.doc)&nbsp;<span class="constructor">Pervasives</span>.format&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;withPrintDepth&nbsp;:&nbsp;int&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printDepth&nbsp;:&nbsp;int&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;printIndent&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;fastMode&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;flushOften&nbsp;:&nbsp;bool&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;countNewLines&nbsp;:&nbsp;int&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;auto_printer&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/api/type_Stats.html b/cil/doc/api/type_Stats.html
new file mode 100644
index 0000000..77cd218
--- /dev/null
+++ b/cil/doc/api/type_Stats.html
@@ -0,0 +1,36 @@
+<html><head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<link rel="Start" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of exceptions" rel=Appendix href="index_exceptions.html">
+<link title="Index of values" rel=Appendix href="index_values.html">
+<link title="Index of class methods" rel=Appendix href="index_methods.html">
+<link title="Index of classes" rel=Appendix href="index_classes.html">
+<link title="Index of class types" rel=Appendix href="index_class_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Index of module types" rel=Appendix href="index_module_types.html">
+<link title="Pretty" rel="Chapter" href="Pretty.html">
+<link title="Errormsg" rel="Chapter" href="Errormsg.html">
+<link title="Clist" rel="Chapter" href="Clist.html">
+<link title="Stats" rel="Chapter" href="Stats.html">
+<link title="Cil" rel="Chapter" href="Cil.html">
+<link title="Formatcil" rel="Chapter" href="Formatcil.html">
+<link title="Alpha" rel="Chapter" href="Alpha.html">
+<link title="Cillower" rel="Chapter" href="Cillower.html">
+<link title="Cfg" rel="Chapter" href="Cfg.html">
+<link title="Dataflow" rel="Chapter" href="Dataflow.html">
+<link title="Dominators" rel="Chapter" href="Dominators.html"><title>CIL API Documentation (version 1.3.5) : Stats</title>
+</head>
+<body>
+<code class="code"><span class="keyword">sig</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;reset&nbsp;:&nbsp;bool&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">exception</span>&nbsp;<span class="constructor">NoPerfCount</span><br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;has_performance_counters&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;bool<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;sample_pentium_perfcount_20&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;sample_pentium_perfcount_10&nbsp;:&nbsp;unit&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;int<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;time&nbsp;:&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;repeattime&nbsp;:&nbsp;float&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;print&nbsp;:&nbsp;<span class="constructor">Pervasives</span>.out_channel&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;string&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;unit<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;lastTime&nbsp;:&nbsp;float&nbsp;<span class="constructor">Pervasives</span>.ref<br>
+&nbsp;&nbsp;<span class="keyword">val</span>&nbsp;timethis&nbsp;:&nbsp;(<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b)&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>a&nbsp;<span class="keywordsign">-&gt;</span>&nbsp;<span class="keywordsign">'</span>b<br>
+<span class="keyword">end</span></code></body></html> \ No newline at end of file
diff --git a/cil/doc/changes.html b/cil/doc/changes.html
new file mode 100644
index 0000000..17ffdf7
--- /dev/null
+++ b/cil/doc/changes.html
@@ -0,0 +1,486 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Changes
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil019.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc49">20</A>&nbsp;&nbsp;Changes</H2><A NAME="sec-changes"></A>
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<B>May 20, 2006</B>: <B>Released version 1.3.5</B>
+<LI CLASS="li-itemize"><B>May 19, 2006</B>: <TT>Makefile.cil.in</TT>/<TT>Makefile.cil</TT> have
+ been renamed <TT>Makefile.in</TT>/<TT>Makefile</TT>. And <TT>maincil.ml</TT> has
+ been renamed <TT>main.ml</TT>.
+<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added a new module <A HREF="api/Cfg.html">Cfg</A> to compute the
+ control-flow graph. Unlike the older <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>,
+ the new version does not modify the code.
+<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added several new analyses: reaching
+ definitions, available expressions, liveness analysis, and dead code
+ elimination. See Section&nbsp;<A HREF="ext.html#sec-Extension">8</A>.
+<LI CLASS="li-itemize"><B>May 2, 2006</B>: Added a flag <TT>--noInsertImplicitCasts</TT>.
+ When this flag is used, CIL code will only include casts inserted by
+ the programmer. Implicit coercions are not changed to explicit casts.
+<LI CLASS="li-itemize"><B>April 16, 2006</B>: Minor improvements to the <TT>--stats</TT>
+ flag (Section&nbsp;<A HREF="cil007.html#sec-cilly-asm-options">7.2</A>). We now use Pentium performance
+ counters by default, if your processor supports them.
+<LI CLASS="li-itemize"><B>April 10, 2006</B>: Extended <TT>machdep.c</TT> to support
+ microcontroller compilers where the struct alignment of integer
+ types does not match the size of the type. Thanks to Nathan
+ Cooprider for the patch.
+<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for global initializers of unions when
+ the union field being initialized is not the first one, and for
+ missing initializers of unions when the first field is not the
+ largest field.
+<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for bitfields in the SFI module.
+<LI CLASS="li-itemize"><B>April 6, 2006</B>: Various fixes for gcc attributes.
+ <TT>packed</TT>, <TT>section</TT>, and <TT>always_inline</TT> attributes are now
+ parsed correctly. Also fixed printing of attributes on enum types.
+<LI CLASS="li-itemize"><B>March 30, 2006</B>: Fix for <TT>rmtemps.ml</TT>, which deletes
+ unused inline functions. When in <TT>gcc</TT> mode CIL now leaves all
+ inline functions in place, since <TT>gcc</TT> treats these as externally
+ visible.
+<LI CLASS="li-itemize"><B>March 15, 2006</B>: Fix for <TT>typeof(<I>e</I>)</TT> when <I>e</I> has type
+ <TT>void</TT>.
+<LI CLASS="li-itemize"><B>March 3, 2006</B>: Assume inline assembly instructions can
+ fall through for the purposes of adding return statements. Thanks to
+ Nathan Cooprider for the patch.
+<LI CLASS="li-itemize"><B>February 27, 2006</B>: Fix for extern inline functions when
+ the output of CIL is fed back into CIL.
+<LI CLASS="li-itemize"><B>January 30, 2006</B>: Fix parsing of <TT>switch</TT> without braces.
+<LI CLASS="li-itemize"><B>January 30, 2006</B>: Allow `$' to appear in identifiers.
+<LI CLASS="li-itemize"><B>January 13, 2006</B>: Added support for gcc's alias attribute
+ on functions. See Section&nbsp;<A HREF="cil016.html#sec-ugly-gcc">16.2</A>, item 8.
+<LI CLASS="li-itemize"><B>December 9, 2005</B>: Christoph Spiel fixed the Golf and
+ Olf modules so that Golf can be used with the points-to analysis.
+ He also added performance fixes and cleaned up the documentation.
+<LI CLASS="li-itemize"><B>December 1, 2005</B>: Major rewrite of the ext/callgraph module.
+<LI CLASS="li-itemize"><B>December 1, 2005</B>: Preserve enumeration constants in CIL. Default
+is the old behavior to replace them with integers.
+<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added support for many GCC <TT>__builtin</TT>
+ functions.
+<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added the EXTRAFEATURES configure
+ option, making it easier to add Features to the build process.
+<LI CLASS="li-itemize"><B>November 23, 2005</B>: In MSVC mode do not remove any locals whose name
+ appears as a substring in an inline assembly.
+<LI CLASS="li-itemize"><B>November 23, 2005</B>: Do not add a return to functions that have the
+ noreturn attribute.
+<LI CLASS="li-itemize"><B>November 22, 2005</B>: <B>Released version 1.3.4</B>
+<LI CLASS="li-itemize"><B>November 21, 2005</B>: Performance and correctness fixes for
+ the Points-to Analysis module. Thanks to Christoph Spiel for the
+ patches.
+<LI CLASS="li-itemize"><B>October 5, 2005</B>: CIL now builds on SPARC/Solaris. Thanks
+ to Nick Petroni and Remco van Engelen for the patches.
+<LI CLASS="li-itemize"><B>September 26, 2005</B>: CIL no longer uses the `<TT>-I-</TT>' flag
+ by default when preprocessing with gcc.
+<LI CLASS="li-itemize"><B>August 24, 2005</B>: Added a command-line option
+ &#8220;--forceRLArgEval&#8221; that forces function arguments to be evaluated
+ right-to-left. This is the default behavior in unoptimized gcc and
+ MSVC, but the order of evaluation is undefined when using
+ optimizations, unless you apply this CIL transformation. This flag
+ does not affect the order of evaluation of e.g. binary operators,
+ which remains undefined. Thanks to Nathan Cooprider for the patch.
+<LI CLASS="li-itemize"><B>August 9, 2005</B>: Fixed merging when there are more than 20
+ input files.
+<LI CLASS="li-itemize"><B>August 3, 2005</B>: When merging, it is now an error to
+ declare the same global variable twice with different initializers.
+<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in transparent unions.
+<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in collectInitializer. Thanks to
+ Benjamin Monate for the patch.
+<LI CLASS="li-itemize"><B>July 26, 2005</B>: Better support for extended inline assembly
+ in gcc.
+<LI CLASS="li-itemize"><B>July 26, 2005</B>: Added many more gcc __builtin* functions
+ to CIL. Most are treated as Call instructions, but a few are
+ translated into expressions so that they can be used in global
+ initializers. For example, &#8220;<TT>__builtin_offsetof(t, field)</TT>&#8221; is
+ rewritten as &#8220;<TT>&amp;((t*)0)-&gt;field</TT>&#8221;, the traditional way of calculating
+ an offset.
+<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug in the constant folding of shifts
+ when the second argument was negative or too large.
+<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug where casts were not always
+ inserted in function calls.
+<LI CLASS="li-itemize"><B>June 10, 2005</B>: Fixed bug in the code that makes implicit
+ returns explicit. We weren't handling switch blocks correctly.
+<LI CLASS="li-itemize"><B>June 1, 2005</B>: <B>Released version 1.3.3</B>
+<LI CLASS="li-itemize"><B>May 31, 2005</B>: Fixed handling of noreturn attribute for function
+ pointers.
+<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the handling of constructors in gcc.
+<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the generation of global variable IDs.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Reimplemented the translation of function calls so
+ that we can intercept some builtins. This is important for the uses of
+ __builtin_constant_p in constants.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Export the plainCilPrinter, for debugging.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug with printing of const attribute for
+ arrays.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in generation of type signatures. Now they
+ should not contain expressions anymore, so you can use structural equality.
+ This used to lead to Out_of_Memory exceptions.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in type comparisons using
+ TBuiltin_va_list.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Improved the constant folding in array lengths and
+ case expressions.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the <TT>__builtin_frame_address</TT> to the set
+ of gcc builtins.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the CIL project to SourceForge.
+<LI CLASS="li-itemize"><B>April 23, 2005</B>: The cattr field was not visited.
+<LI CLASS="li-itemize"><B>March 6, 2005</B>: Debian packaging support
+<LI CLASS="li-itemize"><B>February 16, 2005</B>: Merger fixes.
+<LI CLASS="li-itemize"><B>February 11, 2005</B>: Fixed a bug in <TT>--dopartial</TT>. Thanks to
+Nathan Cooprider for this fix.
+<LI CLASS="li-itemize"><B>January 31, 2005</B>: Make sure the input file is closed even if a
+ parsing error is encountered.
+<LI CLASS="li-itemize"><B>January 11, 2005</B>: <B>Released version 1.3.2</B>
+<LI CLASS="li-itemize"><B>January 11, 2005</B>: Fixed printing of integer constants whose
+ integer kind is shorter than an int.
+<LI CLASS="li-itemize"><B>January 11, 2005</B>: Added checks for negative size arrays and arrays
+ too big.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Added support for GCC attribute &#8220;volatile&#8221; for
+ tunctions (as a synonim for noreturn).
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Improved the comparison of array sizes when
+ comparing array types.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed handling of shell metacharacters in the
+ cilly command lione.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed dropping of cast in initialization of
+ local variable with the result of a function call.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed some structural comparisons that were
+ broken in the Ocaml 3.08.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed the <TT>unrollType</TT> function to not forget
+ attributes.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Better keeping track of locations of function
+ prototypes and definitions.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed bug with the expansion of enumeration
+ constants in attributes.
+<LI CLASS="li-itemize"><B>October 18, 2004</B>: Fixed a bug in cabsvisit.ml. CIl would wrap a
+ BLOCK around a single atom unnecessarily.
+<LI CLASS="li-itemize"><B>August 7, 2004</B>: <B>Released version 1.3.1</B>
+<LI CLASS="li-itemize"><B>August 4, 2004</B>: Fixed a bug in splitting of structs using
+ <TT>--dosimplify</TT>
+<LI CLASS="li-itemize"><B>July 29, 2004</B>: Minor changes to the type typeSig (type signatures)
+ to ensure that they do not contain types, so that you can do structural
+ comparison without danger of nontermination.
+<LI CLASS="li-itemize"><B>July 28, 2004</B>: Ocaml version 3.08 is required. Numerous small
+ changes while porting to Ocaml 3.08.
+<LI CLASS="li-itemize"><B>July 7, 2004</B>: <B>Released version 1.2.6</B>
+<LI CLASS="li-itemize"><B>July 2, 2004</B>: Character constants such as <TT>'c'</TT> should
+ have type <TT>int</TT>, not <TT>char</TT>. Added a utility function
+ <TT>Cil.charConstToInt</TT> that sign-extends chars greater than 128, if needed.
+<LI CLASS="li-itemize"><B>July 2, 2004</B>: Fixed a bug that was casting values to int
+ before applying the logical negation operator !. This caused
+ problems for floats, and for integer types bigger than <TT>int</TT>.
+<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added the field <TT>sallstmts</TT> to a function
+ description, to hold all statements in the function.
+<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added new extensions for data flow analyses, and
+ for computing dominators.
+<LI CLASS="li-itemize"><B>June 10, 2004</B>: Force initialization of CIL at the start of
+Cabs2cil.
+<LI CLASS="li-itemize"><B>June 9, 2004</B>: Added support for GCC <TT>__attribute_used__</TT>
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: <B>Released version 1.2.5</B>
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Allow now to run ./configure CC=cl and set the MSVC
+compiler to be the default. The MSVC driver will now select the default name
+of the .exe file like the CL compiler.
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed a bug in the driver. The temporary files are
+deleted by the Perl script before the CL compiler gets to them?
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added the - form of arguments to the MSVC driver.
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added a few more GCC-specific string escapes, (, [,
+{, %, E.
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed bug with continuation lines in MSVC.
+<LI CLASS="li-itemize"><B>April 6, 2004</B>: Fixed embarassing bug in the parser: the precedence
+ of casts and unary operators was switched.
+<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug involving statements mixed between
+declarations containing initializers. Now we make sure that the initializers
+are run in the proper order with respect to the statements.
+<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug in the merger. The merger was keeping
+separate alpha renaming talbes (namespaces) for variables and types. This
+means that it might end up with a type and a variable named the same way, if
+they come from different files, which breaks an important CIL invariant.
+<LI CLASS="li-itemize"><B>March 11, 2004</B> : Fixed a bug in the Cil.copyFunction function. The
+new local variables were not getting fresh IDs.
+<LI CLASS="li-itemize"><B>March 5, 2004</B>: Fixed a bug in the handling of static function
+ prototypes in a block scope. They used to be renamed. Now we just consider
+ them global.
+<LI CLASS="li-itemize"><B>February 20, 2004</B>: <B>Released version 1.2.4</B>
+<LI CLASS="li-itemize"><B>February 15, 2004</B>: Changed the parser to allow extra semicolons
+ after field declarations.
+<LI CLASS="li-itemize"><B>February 14, 2004</B>: Changed the Errormsg functions: error, unimp,
+bug to not raise an exception. Instead they just set Errormsg.hadErrors.
+<LI CLASS="li-itemize"><B>February 13, 2004</B>: Change the parsing of attributes to recognize
+ enumeration constants.
+<LI CLASS="li-itemize"><B>February 10, 2004</B>: In some versions of <TT>gcc</TT> the identifier
+ _{thread is an identifier and in others it is a keyword. Added code
+ during configuration to detect which is the case.
+<LI CLASS="li-itemize"><B>January 7, 2004</B>: <B>Released version 1.2.3</B>
+<LI CLASS="li-itemize"><B>January 7, 2004</B>: Changed the alpha renamer to be less
+conservative. It will remember all versions of a name that were seen and will
+only create a new name if we have not seen one.
+<LI CLASS="li-itemize"><B>December 30, 2003</B> : Extended the <TT>cilly</TT> command to understand
+ better linker command options <TT>-lfoo</TT>.
+<LI CLASS="li-itemize"><B>December 5, 2003</B>: Added markup commands to the pretty-printer
+module. Also, changed the &#8220;@&lt;&#8221; left-flush command into &#8220;@''.
+<LI CLASS="li-itemize"><B>December 4, 2003</B>: Wide string literals are now handled
+directly by Cil (rather than being exploded into arrays). This is
+apparently handy for Microsoft Device Driver APIs that use intrinsic
+functions that require literal constant wide-string arguments.
+<LI CLASS="li-itemize"><B>December 3, 2003</B>: Added support for structured exception handling
+ extensions for the Microsoft compilers.
+<LI CLASS="li-itemize"><B>December 1, 2003</B>: Fixed a Makefile bug in the generation of the
+Cil library (e.g., <TT>cil.cma</TT>) that was causing it to be unusable. Thanks
+to KEvin Millikin for pointing out this bug.
+<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added support for linkage specifications
+ (extern &#8220;C&#8221;).
+<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added the ocamlutil directory to contain some
+utilities shared with other projects.
+<LI CLASS="li-itemize"><B>November 25, 2003</B>: <B>Released version 1.2.2</B>
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that allowed a static local to
+ conflict with a global with the same name that is declared later in the
+ file.
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Removed the <TT>--keep</TT> option of the <TT>cilly</TT>
+ driver and replaced it with <TT>--save-temps</TT>.
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Added printing of what CIL features are being
+ run.
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that resulted in attributes being
+ dropped for integer types.
+<LI CLASS="li-itemize"><B>November 11, 2003</B>: Fixed a bug in the visitor for enumeration
+ definitions.
+<LI CLASS="li-itemize"><B>October 24, 2003</B>: Fixed a problem in the configuration script. It
+ was not recognizing the Ocaml version number for beta versions.
+<LI CLASS="li-itemize"><B>October 15, 2003</B>: Fixed a problem in version 1.2.1 that was
+ preventing compilation on OCaml 3.04.
+<LI CLASS="li-itemize"><B>September 17, 2003: Released version 1.2.1.</B>
+<LI CLASS="li-itemize"><B>September 7, 2003</B>: Redesigned the interface for choosing
+ <TT>#line</TT> directive printing styles. Cil.printLn and
+ Cil.printLnComment have been merged into Cil.lineDirectiveStyle.
+<LI CLASS="li-itemize"><B>August 8, 2003</B>: Do not silently pad out functions calls with
+arguments to match the prototype.
+<LI CLASS="li-itemize"><B>August 1, 2003</B>: A variety of fixes suggested by Steve Chamberlain:
+initializers for externs, prohibit float literals in enum, initializers for
+unsized arrays were not working always, an overflow problem in Ocaml, changed
+the processing of attributes before struct specifiers<BR>
+<BR>
+<LI CLASS="li-itemize"><B>July 14, 2003</B>: Add basic support for GCC's "__thread" storage
+qualifier. If given, it will appear as a "thread" attribute at the top of the
+type of the declared object. Treatment is very similar to "__declspec(...)"
+in MSVC<BR>
+<BR>
+<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed some of the __alignof computations. Fixed
+ bug in the designated initializers for arrays (Array.get error).
+<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed infinite loop bug (Stack Overflow) in the
+ visitor for __alignof.
+<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed bug in the conversion to CIL. A function or
+ array argument of
+ the GCC __typeof() was being converted to pointer type. Instead, it should
+ be left alone, just like for sizeof.
+<LI CLASS="li-itemize"><B>July 7, 2003</B>: New Escape module provides utility functions
+ for escaping characters and strings in accordance with C lexical
+ rules.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>July 2, 2003</B>: Relax CIL's rules for when two enumeration types are
+considered compatible. Previously CIL considered two enums to be compatible if
+they were the same enum. Now we follow the C99 standard.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 28, 2003</B>: In the Formatparse module, Eric Haugh found and
+ fixed a bug in the handling of lvalues of the form &#8220;lv-&gt;field.more&#8221;.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 28, 2003</B>: Extended the handling of gcc command lines
+arguments in the Perl scripts. <BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 23, 2003</B>: In Rmtmps module, simplified the API for
+ customizing the root set. Clients may supply a predicate that
+ returns true for each root global. Modifying various
+ &#8220;<TT>referenced</TT>&#8221; fields directly is no longer supported.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 17, 2003</B>: Reimplement internal utility routine
+ <TT>Cil.escape_char</TT>. Faster and better. <BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 14, 2003</B>: Implemented support for <TT>__attribute__s</TT>
+appearing between "struct" and the struct tag name (also for unions and
+enums), since gcc supports this as documented in section 4.30 of the gcc
+(2.95.3) manual<BR>
+<BR>
+<LI CLASS="li-itemize"><B>May 30, 2003</B>: Released the regression tests.
+<LI CLASS="li-itemize"><B>May 28, 2003</B>: <B>Released version 1.1.2</B>
+<LI CLASS="li-itemize"><B>May 26, 2003</B>: Add the <TT>simplify</TT> module that compiles CIL
+expressions into simpler expressions, similar to those that appear in a
+3-address intermediate language.
+<LI CLASS="li-itemize"><B>May 26, 2003</B>: Various fixes and improvements to the pointer
+analysis modules.
+<LI CLASS="li-itemize"><B>May 26, 2003</B>: Added optional consistency checking for
+transformations.
+<LI CLASS="li-itemize"><B>May 25, 2003</B>: Added configuration support for big endian machines.
+Now <A HREF="api/Cil.html#VALlittle_endian">Cil.little_endian</A> can be used to test whether the machine is
+little endian or not.
+<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed a bug in the handling of inline functions. The
+CIL merger used to turn these functions into &#8220;static&#8221;, which is incorrect.
+<LI CLASS="li-itemize"><B>May 22, 2003</B>: Expanded the CIL consistency checker to verify
+undesired sharing relationships between data structures.
+<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed bug in the <TT>oneret</TT> CIL module: it was
+mishandling certain labeled return statements.
+<LI CLASS="li-itemize"><B>May 5, 2003</B>: <B>Released version 1.0.11</B>
+<LI CLASS="li-itemize"><B>May 5, 2003</B>: OS X (powerpc/darwin) support for CIL. Special
+thanks to Jeff Foster, Andy Begel and Tim Leek.
+<LI CLASS="li-itemize"><B>April 30, 2003</B>: Better description of how to use CIL for your
+analysis.
+<LI CLASS="li-itemize"><B>April 28, 2003</B>: Fixed a bug with <TT>--dooneRet</TT> and
+<TT>--doheapify</TT>. Thanks, Manos Renieris.
+<LI CLASS="li-itemize"><B>April 16, 2003</B>: Reworked management of
+ temporary/intermediate output files in Perl driver scripts. Default
+ behavior is now to remove all such files. To keep intermediate
+ files, use one of the following existing flags:
+ <UL CLASS="itemize"><LI CLASS="li-itemize">
+ <TT>--keepmerged</TT> for the single-file merge of all sources
+ <LI CLASS="li-itemize"><TT>--keep=&lt;<I>dir</I></TT><TT>&gt;</TT> for various other CIL and
+ CCured output files
+ <LI CLASS="li-itemize"><TT>--save-temps</TT> for various gcc intermediate files; MSVC
+ has no equivalent option
+ </UL>
+ As part of this change, some intermediate files have changed their
+ names slightly so that new suffixes are always preceded by a
+ period. For example, CCured output that used to appear in
+ &#8220;<TT>foocured.c</TT>&#8221; now appears in &#8220;<TT>foo.cured.c</TT>&#8221;.
+<LI CLASS="li-itemize"><B>April 7, 2003</B>: Changed the representation of the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
+global constructor. Now it is possible to update the initializer without
+reconstructing the global (which in turn it would require reconstructing the
+list of globals that make up a program). We did this because it is often
+tempting to use <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
+was the only global that could not be updated in place.
+<LI CLASS="li-itemize"><B>April 6, 2003</B>: Reimplemented parts of the cilly.pl script to make
+it more robust in the presence of complex compiler arguments.
+<LI CLASS="li-itemize"><B>March 10, 2003</B>: <B>Released version 1.0.9</B>
+<LI CLASS="li-itemize"><B>March 10, 2003</B>: Unified and documented a large number of CIL
+Library Modules: oneret, simplemem, makecfg, heapify, stackguard, partial.
+Also documented the main client interface for the pointer analysis.
+<LI CLASS="li-itemize"><B>February 18, 2003</B>: Fixed a bug in logwrites that was causing it
+to produce invalid C code on writes to bitfields. Thanks, David Park.
+<LI CLASS="li-itemize"><B>February 15, 2003</B>: <B>Released version 1.0.8</B>
+<LI CLASS="li-itemize"><B>February 15, 2003</B>: PDF versions of the manual and API are
+available for those who would like to print them out.
+<LI CLASS="li-itemize"><B>February 14, 2003</B>: CIL now comes bundled with alias analyses.
+<LI CLASS="li-itemize"><B>February 11, 2003</B>: Added support for adding/removing options from
+ <TT>./configure</TT>.
+<LI CLASS="li-itemize"><B>February 3, 2003</B>: <B>Released version 1.0.7</B>
+<LI CLASS="li-itemize"><B>February 1, 2003</B>: Some bug fixes in the handling of variable
+argument functions in new versions of <TT>gcc</TT> And <TT>glibc</TT>.
+<LI CLASS="li-itemize"><B>January 29, 2003</B>: Added the logical AND and OR operators.
+Exapanded the translation to CIL to handle more complicated initializers
+(including those that contain logical operators).
+<LI CLASS="li-itemize"><B>January 28, 2003</B>: <B>Released version 1.0.6</B>
+<LI CLASS="li-itemize"><B>January 28, 2003</B>: Added support for the new handling of
+variable-argument functions in new versions of <TT>glibc</TT>.
+<LI CLASS="li-itemize"><B>January 19, 2003</B>: Added support for declarations in interpreted
+ constructors. Relaxed the semantics of the patterns for variables.
+<LI CLASS="li-itemize"><B>January 17, 2003</B>: Added built-in prototypes for the gcc built-in
+ functions. Changed the <TT>pGlobal</TT> method in the printers to print the
+ carriage return as well.
+<LI CLASS="li-itemize"><B>January 9, 2003</B>: Reworked lexer and parser's strategy for
+ tracking source file names and line numbers to more closely match
+ typical native compiler behavior. The visible CIL interface is
+ unchanged.
+<LI CLASS="li-itemize"><B>January 9, 2003</B>: Changed the interface to the alpha convertor. Now
+you can pass a list where it will record undo information that you can use to
+revert the changes that it makes to the scope tables.
+<LI CLASS="li-itemize"><B>January 6, 2003</B>: <B>Released version 1.0.5</B>
+<LI CLASS="li-itemize"><B>January 4, 2003</B>: Changed the interface for the Formatcil module.
+ Now the placeholders in the pattern have names. Also expanded the
+ documentation of the Formatcil module.
+ Now the placeholders in the pattern have names.
+<LI CLASS="li-itemize"><B>January 3, 2003</B>: Extended the <TT>rmtmps</TT> module to also remove
+ unused labels that are generated in the conversion to CIL. This reduces the
+ number of warnings that you get from <TT>cgcc</TT> afterwards.
+<LI CLASS="li-itemize"><B>December 17, 2002</B>: Fixed a few bugs in CIL related to the
+ representation of string literals. The standard says that a string literal
+ is an array. In CIL, a string literal has type pointer to character. This is
+ Ok, except as an argument of sizeof. To support this exception, we have
+ added to CIL the expression constructor SizeOfStr. This allowed us to fix
+ bugs with computing <TT>sizeof("foo bar")</TT> and <TT>sizeof((char*)"foo bar")</TT>
+ (the former is 8 and the latter is 4).<BR>
+<BR>
+<LI CLASS="li-itemize"><B>December 8, 2002</B>: Fixed a few bugs in the lexer and parser
+ relating to hex and octal escapes in string literals. Also fixed
+ the dependencies between the lexer and parser.
+<LI CLASS="li-itemize"><B>December 5, 2002</B>: Fixed visitor bugs that were causing
+ some attributes not to be visited and some queued instructions to be
+ dropped.
+<LI CLASS="li-itemize"><B>December 3, 2002</B>: Added a transformation to catch stack
+ overflows. Fixed the heapify transformation.
+<LI CLASS="li-itemize"><B>October 14, 2002</B>: CIL is now available under the BSD license
+(see the License section or the file LICENSE). <B>Released version 1.0.4</B>
+<LI CLASS="li-itemize"><B>October 9, 2002</B>: More FreeBSD configuration changes, support
+for the GCC-ims <TT>__signed</TT> and <TT>__volatile</TT>. Thanks to Axel
+Simon for pointing out these problems. <B>Released version 1.0.3</B>
+<LI CLASS="li-itemize"><B>October 8, 2002</B>: FreeBSD configuration and porting fixes.
+Thanks to Axel Simon for pointing out these problems.
+<LI CLASS="li-itemize"><B>September 10, 2002</B>: Fixed bug in conversion to CIL. Now we drop
+all &#8220;const&#8221; qualifiers from the types of locals, even from the fields of
+local structures or elements of arrays.
+<LI CLASS="li-itemize"><B>September 7, 2002</B>: Extended visitor interface to distinguish visitng
+ offsets inside lvalues from offsets inside initializer lists.
+<LI CLASS="li-itemize"><B>September 7, 2002</B>: <B>Released version 1.0.1</B>
+<LI CLASS="li-itemize"><B>September 6, 2002</B>: Extended the patcher with the <TT>ateof</TT> flag.
+<LI CLASS="li-itemize"><B>September 4, 2002</B>: Fixed bug in the elaboration to CIL. In some
+cases constant folding of <TT>||</TT> and <TT>&amp;&amp;</TT> was computed wrong.
+<LI CLASS="li-itemize"><B>September 3, 2002</B>: Fixed the merger documentation.
+<LI CLASS="li-itemize"><B>August 29, 2002</B>: <B>Released version 1.0.0.</B>
+<LI CLASS="li-itemize"><B>August 29, 2002</B>: Started numbering versions with a major nubmer,
+minor and revisions. Released version 1.0.0.
+<LI CLASS="li-itemize"><B>August 25, 2002</B>: Fixed the implementation of the unique
+identifiers for global variables and composites. Now those identifiers are
+globally unique.
+<LI CLASS="li-itemize"><B>August 24, 2002</B>: Added to the machine-dependent configuration the
+<TT>sizeofvoid</TT>. It is 1 on gcc and 0 on MSVC. Extended the implementation of
+<TT>Cil.bitsSizeOf</TT> to handle this (it was previously returning an error when
+trying to compute the size of <TT>void</TT>).
+<LI CLASS="li-itemize"><B>August 24, 2002</B>: Changed the representation of structure and
+unions to distinguish between undefined structures and those that are defined
+to be empty (allowed on gcc). The sizeof operator is undefined for the former
+and returns 0 for the latter.
+<LI CLASS="li-itemize"><B>August 22, 2002</B>: Apply a patch from Richard H. Y. to support
+FreeBSD installations. Thanks, Richard!
+<LI CLASS="li-itemize"><B>August 12, 2002</B>: Fixed a bug in the translation of wide-character
+strings. Now this translation matches that of the underlying compiler. Changed
+the implementation of the compiler dependencies.
+<LI CLASS="li-itemize"><B>May 25, 2002</B>: Added interpreted constructors and destructors.
+<LI CLASS="li-itemize"><B>May 17, 2002</B>: Changed the representation of functions to move the
+&#8220;inline&#8221; information to the varinfo. This way we can print the &#8220;inline&#8221;
+even in declarations which is what gcc does.
+<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the visitor for initializers to make two
+tail-recursive passes (the second is a <TT>List.rev</TT> and only done if one of
+the initializers change). This prevents <TT>Stack_Overflow</TT> for large
+initializers. Also improved the processing of initializers when converting to
+CIL.
+<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the front-end to allow the use of <TT>MSVC</TT>
+mode even on machines that do not have MSVC. The machine-dependent parameters
+for GCC will be used in that case.
+<LI CLASS="li-itemize"><B>May 11, 2002</B>: Changed the representation of formals in function
+types. Now the function type is purely functional.
+<LI CLASS="li-itemize"><B>May 4, 2002</B>: Added the function
+<A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and changed <A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> to be
+tail recursive. This prevents stack overflow on huge files.
+<LI CLASS="li-itemize"><B>February 28, 2002</B>: Changed the significance of the
+<TT>CompoundInit</TT> in <A HREF="api/Cil.html#TYPEinit">Cil.init</A> to allow for missing initializers at the
+end of an array initializer. Added the API function
+<A HREF="api/Cil.html#VALfoldLeftCompoundAll">Cil.foldLeftCompoundAll</A>.
+</UL>
+<HR>
+<A HREF="cil019.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil.css b/cil/doc/cil.css
new file mode 100644
index 0000000..7466cf4
--- /dev/null
+++ b/cil/doc/cil.css
@@ -0,0 +1,10 @@
+
+.toc{list-style:none;}
+.title{margin:auto;text-align:center}
+.center{text-align:center;margin-left:auto;margin-right:auto;}
+.flushleft{text-align:left;margin-left:0ex;margin-right:auto;}
+.flushright{text-align:right;margin-left:auto;margin-right:0ex;}
+DIV TABLE{margin-left:inherit;margin-right:inherit;}
+PRE{text-align:left;margin-left:0ex;margin-right:auto;}
+BLOCKQUOTE{margin-left:4ex;margin-right:4ex;text-align:left;}
+.part{margin:auto;text-align:center}
diff --git a/cil/doc/cil.html b/cil/doc/cil.html
new file mode 100644
index 0000000..4d912d3
--- /dev/null
+++ b/cil/doc/cil.html
@@ -0,0 +1,3532 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+
+<HEAD>
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+<STYLE type="text/css">
+.toc{list-style:none;}
+.title{margin:auto;text-align:center}
+.center{text-align:center;margin-left:auto;margin-right:auto;}
+.flushleft{text-align:left;margin-left:0ex;margin-right:auto;}
+.flushright{text-align:right;margin-left:auto;margin-right:0ex;}
+DIV TABLE{margin-left:inherit;margin-right:inherit;}
+PRE{text-align:left;margin-left:0ex;margin-right:auto;}
+BLOCKQUOTE{margin-left:4ex;margin-right:4ex;text-align:left;}
+.part{margin:auto;text-align:center}
+</STYLE>
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+</HEAD>
+
+<BODY >
+<!--HEVEA command line is: /usr/bin/hevea -exec xxdate.exe ../../cilpp -->
+<!--HTMLHEAD-->
+<!--ENDHTML-->
+<!--PREFIX <ARG ></ARG>-->
+<!--CUT DEF section 1 -->
+
+
+
+<TABLE CLASS="title">
+<TR><TD></TD>
+</TR></TABLE><BR>
+<!--TOC section Introduction-->
+
+<H2 CLASS="section"><A NAME="htoc1">1</A>&nbsp;&nbsp;Introduction</H2><!--SEC END -->
+
+New: CIL now has a Source Forge page:
+ <A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
+<BR>
+CIL (<B>C</B> <B>I</B>ntermediate <B>L</B>anguage) is a high-level representation
+along with a set of tools that permit easy analysis and source-to-source
+transformation of C programs.<BR>
+<BR>
+CIL is both lower-level than abstract-syntax trees, by clarifying ambiguous
+constructs and removing redundant ones, and also higher-level than typical
+intermediate languages designed for compilation, by maintaining types and a
+close relationship with the source program. The main advantage of CIL is that
+it compiles all valid C programs into a few core constructs with a very clean
+semantics. Also CIL has a syntax-directed type system that makes it easy to
+analyze and manipulate C programs. Furthermore, the CIL front-end is able to
+process not only ANSI-C programs but also those using Microsoft C or GNU C
+extensions. If you do not use CIL and want instead to use just a C parser and
+analyze programs expressed as abstract-syntax trees then your analysis will
+have to handle a lot of ugly corners of the language (let alone the fact that
+parsing C itself is not a trivial task). See Section&nbsp;<A HREF="#sec-simplec">16</A> for some
+examples of such extreme programs that CIL simplifies for you.<BR>
+<BR>
+In essence, CIL is a highly-structured, &#8220;clean&#8221; subset of C. CIL features a
+reduced number of syntactic and conceptual forms. For example, all looping
+constructs are reduced to a single form, all function bodies are given
+explicit <TT>return</TT> statements, syntactic sugar like <TT>"-&gt;"</TT> is
+eliminated and function arguments with array types become pointers. (For an
+extensive list of how CIL simplifies C programs, see Section&nbsp;<A HREF="#sec-cabs2cil">4</A>.)
+This reduces the number of cases that must be considered when manipulating a C
+program. CIL also separates type declarations from code and flattens scopes
+within function bodies. This structures the program in a manner more amenable
+to rapid analysis and transformation. CIL computes the types of all program
+expressions, and makes all type promotions and casts explicit. CIL supports
+all GCC and MSVC extensions except for nested functions and complex numbers.
+Finally, CIL organizes C's imperative features into expressions, instructions
+and statements based on the presence and absence of side-effects and
+control-flow. Every statement can be annotated with successor and predecessor
+information. Thus CIL provides an integrated program representation that can
+be used with routines that require an AST (e.g. type-based analyses and
+pretty-printers), as well as with routines that require a CFG (e.g., dataflow
+analyses). CIL also supports even lower-level representations (e.g.,
+three-address code), see Section&nbsp;<A HREF="#sec-Extension">8</A>. <BR>
+<BR>
+CIL comes accompanied by a number of Perl scripts that perform generally
+useful operations on code:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+A <A HREF="#sec-driver">driver</A> which behaves as either the <TT>gcc</TT> or
+Microsoft VC compiler and can invoke the preprocessor followed by the CIL
+application. The advantage of this script is that you can easily use CIL and
+the analyses written for CIL with existing make files.
+<LI CLASS="li-itemize">A <A HREF="#sec-merger">whole-program merger</A> that you can use as a
+replacement for your compiler and it learns all the files you compile when you
+make a project and merges all of the preprocessed source files into a single
+one. This makes it easy to do whole-program analysis.
+<LI CLASS="li-itemize">A <A HREF="#sec-patcher">patcher</A> makes it easy to create modified
+copies of the system include files. The CIL driver can then be told to use
+these patched copies instead of the standard ones.
+</UL>
+CIL has been tested very extensively. It is able to process the SPECINT95
+benchmarks, the Linux kernel, GIMP and other open-source projects. All of
+these programs are compiled to the simple CIL and then passed to <TT>gcc</TT> and
+they still run! We consider the compilation of Linux a major feat especially
+since Linux contains many of the ugly GCC extensions (see Section&nbsp;<A HREF="#sec-ugly-gcc">16.2</A>).
+This adds to about 1,000,000 lines of code that we tested it on. It is also
+able to process the few Microsoft NT device drivers that we have had access
+to. CIL was tested against GCC's c-torture testsuite and (except for the tests
+involving complex numbers and inner functions, which CIL does not currently
+implement) CIL passes most of the tests. Specifically CIL fails 23 tests out
+of the 904 c-torture tests that it should pass. GCC itself fails 19 tests. A
+total of 1400 regression test cases are run automatically on each change to
+the CIL sources.<BR>
+<BR>
+CIL is relatively independent on the underlying machine and compiler. When
+you build it CIL will configure itself according to the underlying compiler.
+However, CIL has only been tested on Intel x86 using the gcc compiler on Linux
+and cygwin and using the MS Visual C compiler. (See below for specific
+versions of these compilers that we have used CIL for.)<BR>
+<BR>
+The largest application we have used CIL for is
+<A HREF="javascript:loadTop('../ccured/index.html')">CCured</A>, a compiler that compiles C code into
+type-safe code by analyzing your pointer usage and inserting runtime checks in
+the places that cannot be guaranteed statically to be type safe. <BR>
+<BR>
+You can also use CIL to &#8220;compile&#8221; code that uses GCC extensions (e.g. the
+Linux kernel) into standard C code.<BR>
+<BR>
+CIL also comes accompanies by a growing library of extensions (see
+Section&nbsp;<A HREF="#sec-Extension">8</A>). You can use these for your projects or as examples of
+using CIL. <BR>
+<BR>
+<TT>PDF</TT> versions of <A HREF="CIL.pdf">this manual</A> and the
+<A HREF="CIL-API.pdf">CIL API</A> are available. However, we recommend the
+<TT>HTML</TT> versions because the postprocessed code examples are easier to
+view. <BR>
+<BR>
+If you use CIL in your project, we would appreciate letting us know. If you
+want to cite CIL in your research writings, please refer to the paper &#8220;CIL:
+Intermediate Language and Tools for Analysis and Transformation of C
+Programs&#8221; by George C. Necula, Scott McPeak, S.P. Rahul and Westley Weimer,
+in &#8220;Proceedings of Conference on Compilier Construction&#8221;, 2002.<BR>
+<BR>
+<!--TOC section Installation-->
+
+<H2 CLASS="section"><A NAME="htoc2">2</A>&nbsp;&nbsp;Installation</H2><!--SEC END -->
+
+You will need OCaml release 3.08 or higher to build CIL. CIL has been tested
+on Linux and on Windows (where it can behave at either Microsoft Visual C or
+gcc).<BR>
+<BR>
+If you want to use CIL on Windows then you must get a complete installation
+of <TT>cygwin</TT> and the source-code OCaml distribution and compile it yourself
+using the cygwin tools (as opposed to getting the Win32 native-code version of
+OCaml). If you have not done this before then take a look
+<A HREF="../ccured/setup.html">here</A>. (Don't need to worry about <TT>cvs</TT> and
+<TT>ssh</TT> unless you will need to use the master CVS repository for CIL.)
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Download the CIL <A HREF="distrib">distribution</A> (latest version is
+<A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>). See the Section&nbsp;<A HREF="#sec-changes">20</A> for recent changes to the CIL distribution.
+<LI CLASS="li-enumerate">Unzip and untar the source distribution. This will create a directory
+ called <TT>cil</TT> whose structure is explained below.<BR>
+<TT>tar xvfz cil-1.3.5.tar.gz</TT>
+<LI CLASS="li-enumerate">Enter the <TT>cil</TT> directory and run the <TT>configure</TT> script and then
+ GNU make to build the distribution. If you are on Windows, at least the
+ <TT>configure</TT> step must be run from within <TT>bash</TT>.<BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>cd cil</CODE><BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>./configure</CODE><BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>make</CODE><BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>make quicktest</CODE><BR>
+<LI CLASS="li-enumerate">You should now find <TT>cilly.asm.exe</TT> in a
+subdirectory of <TT>obj</TT>. The name of the subdirectory is either <TT>x86_WIN32</TT>
+if you are using <TT>cygwin</TT> on Windows or <TT>x86_LINUX</TT> if you are using
+Linux (although you should be using instead the Perl wrapper <TT>bin/cilly</TT>).
+Note that we do not have an <TT>install</TT> make target and you should use Cil
+from the development directory.
+<LI CLASS="li-enumerate">If you decide to use CIL, <B>please</B>
+<A HREF="mailto:necula@cs.berkeley.edu">send us a note</A>. This will help recharge
+our batteries after more than a year of development. And of course, do send us
+your bug reports as well.</OL>
+The <TT>configure</TT> script tries to find appropriate defaults for your system.
+You can control its actions by passing the following arguments:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>CC=foo</TT> Specifies the path for the <TT>gcc</TT> executable. By default
+whichever version is in the PATH is used. If <TT>CC</TT> specifies the Microsoft
+<TT>cl</TT> compiler, then that compiler will be set as the default one. Otherwise,
+the <TT>gcc</TT> compiler will be the default.
+</UL>
+CIL requires an underlying C compiler and preprocessor. CIL depends on the
+underlying compiler and machine for the sizes and alignment of types.The
+installation procedure for CIL queries the underlying compiler for
+architecture and compiler dependent configuration parameters, such as the size
+of a pointer or the particular alignment rules for structure fields. (This
+means, of course, that you should re-run <TT>./configure</TT> when you move CIL to
+another machine.)<BR>
+<BR>
+We have tested CIL on the following compilers:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+On Windows, <TT>cl</TT> compiler version 12.00.8168 (MSVC 6),
+ 13.00.9466 (MSVC .Net), and 13.10.3077 (MSVC .Net 2003). Run <TT>cl</TT>
+ with no arguments to get the compiler version.
+<LI CLASS="li-itemize">On Windows, using <TT>cygwin</TT> and <TT>gcc</TT> version 2.95.3, 3.0,
+ 3.2, 3.3, and 3.4.
+<LI CLASS="li-itemize">On Linux, using <TT>gcc</TT> version 2.95.3, 3.0, 3.2, 3.3, and 4.0.
+</UL>
+Others have successfully used CIL with Mac OS X (on both PowerPC and
+x86), Solaris, and *BSD. If you make any changes to the build
+system in order to run CIL on your platform, please send us a patch.<BR>
+<BR>
+ <!--TOC section Distribution Contents-->
+
+<H2 CLASS="section"><A NAME="htoc3">3</A>&nbsp;&nbsp;Distribution Contents</H2><!--SEC END -->
+
+The file <A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>
+contains the complete source CIL distribution,
+consisting of the following files:<BR>
+<TABLE CELLSPACING=2 CELLPADDING=0>
+<TR><TD ALIGN=left NOWRAP>Filename</TD>
+<TD ALIGN=left NOWRAP>Description</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>Makefile.in</TT></TD>
+<TD ALIGN=left NOWRAP><TT>configure</TT> source for the
+ Makefile that builds CIL</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>configure</TT></TD>
+<TD ALIGN=left NOWRAP>The configure script</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>configure.in</TT></TD>
+<TD ALIGN=left NOWRAP>The <TT>autoconf</TT> source for <TT>configure</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>config.guess</TT>, <TT>config.sub</TT>, <TT>install-sh</TT></TD>
+<TD ALIGN=left NOWRAP>stuff required by
+ <TT>configure</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>doc/</TT></TD>
+<TD ALIGN=left NOWRAP>HTML documentation of the CIL API</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>obj/</TT></TD>
+<TD ALIGN=left NOWRAP>Directory that will contain the compiled
+ CIL modules and executables</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>bin/cilly.in</TT></TD>
+<TD ALIGN=left NOWRAP>The <TT>configure</TT> source for a Perl script
+ that can be invoked with the
+ same arguments as either <TT>gcc</TT> or
+ Microsoft Visual C and will convert the
+ program to CIL, perform some simple
+ transformations, emit it and compile it as
+ usual.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>lib/CompilerStub.pm</TT></TD>
+<TD ALIGN=left NOWRAP>A Perl class that can be used to write code
+ that impersonates a compiler. <TT>cilly</TT>
+ uses it.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>lib/Merger.pm</TT></TD>
+<TD ALIGN=left NOWRAP>A subclass of <TT>CompilerStub.pm</TT> that can
+ be used to merge source files into a single
+ source file.<TT>cilly</TT>
+ uses it.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>bin/patcher.in</TT></TD>
+<TD ALIGN=left NOWRAP>A Perl script that applies specified patches
+ to standard include files.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/check.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Checks the well-formedness of a CIL file</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/cil.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Definition of CIL abstract syntax and
+ utilities for manipulating it</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/clist.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for efficiently managing lists
+ that need to be concatenated often</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/errormsg.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for error reporting</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/ext/heapify.ml</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL transformation that moves array local
+ variables from the stack to the heap</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/ext/logcalls.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL transformation that logs every
+ function call</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/ext/sfi.ml</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL transformation that can log every
+ memory read and write</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/clexer.mll</TT></TD>
+<TD ALIGN=left NOWRAP>The lexer</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cparser.mly</TT></TD>
+<TD ALIGN=left NOWRAP>The parser</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The abstract syntax</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cprint.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The pretty printer for CABS</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs2cil.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The elaborator to CIL</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/main.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The <TT>cilly</TT> application</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/pretty.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for pretty printing</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/rmtmps.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL tranformation that removes unused
+ types, variables and inlined functions</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/stats.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for maintaining timing statistics</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/testcil.ml</TT></TD>
+<TD ALIGN=left NOWRAP>A random test of CIL (against the resident
+ C compiler)</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/trace.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities useful for printing debugging
+ information</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/</TT></TD>
+<TD ALIGN=left NOWRAP>Miscellaneous libraries that are not
+ specific to CIL.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml</TT></TD>
+<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml.build</TT></TD>
+<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/perfcount.c</TT></TD>
+<TD ALIGN=left NOWRAP>C code that links with src/stats.ml
+ and reads Intel performance
+ counters.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/feature_config.ml</TT></TD>
+<TD ALIGN=left NOWRAP>File generated by the Makefile
+ describing which extra &#8220;features&#8221;
+ to compile. See Section&nbsp;<A HREF="#sec-cil">5</A></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/machdep.ml</TT></TD>
+<TD ALIGN=left NOWRAP>File generated by the Makefile containing
+ information about your architecture,
+ such as the size of a pointer</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/machdep.c</TT></TD>
+<TD ALIGN=left NOWRAP>C program that generates
+ <TT>machdep.ml</TT> files</TD>
+</TR></TABLE><BR>
+<!--TOC section Compiling C to CIL-->
+
+<H2 CLASS="section"><A NAME="htoc4">4</A>&nbsp;&nbsp;Compiling C to CIL</H2><!--SEC END -->
+<A NAME="sec-cabs2cil"></A>
+In this section we try to describe a few of the many transformations that are
+applied to a C program to convert it to CIL. The module that implements this
+conversion is about 5000 lines of OCaml code. In contrast a simple program
+transformation that instruments all functions to keep a shadow stack of the
+true return address (thus preventing stack smashing) is only 70 lines of code.
+This example shows that the analysis is so much simpler because it has to
+handle only a few simple C constructs and also because it can leverage on CIL
+infrastructure such as visitors and pretty-printers.<BR>
+<BR>
+In no particular order these are a few of the most significant ways in which
+C programs are compiled into CIL:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+CIL will eliminate all declarations for unused entities. This means that
+just because your hello world program includes <TT>stdio.h</TT> it does not mean
+that your analysis has to handle all the ugly stuff from <TT>stdio.h</TT>.<BR>
+<BR>
+<LI CLASS="li-enumerate">Type specifiers are interpreted and normalized:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int long signed x;
+signed long extern x;
+long static int long y;
+
+// Some code that uses these declaration, so that CIL does not remove them
+int main() { return x + y; }
+</FONT></PRE>
+See the <A HREF="examples/ex1.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Anonymous structure and union declarations are given a name.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ struct { int x; } s;
+</FONT></PRE>
+See the <A HREF="examples/ex2.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Nested structure tag definitions are pulled apart. This means that all
+structure tag definitions can be found by a simple scan of the globals.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct foo {
+ struct bar {
+ union baz {
+ int x1;
+ double x2;
+ } u1;
+ int y;
+ } s1;
+ int z;
+} f;
+</FONT></PRE>
+See the <A HREF="examples/ex3.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">All structure, union, enumeration definitions and the type definitions
+from inners scopes are moved to global scope (with appropriate renaming). This
+facilitates moving around of the references to these entities.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int main() {
+ struct foo {
+ int x; } foo;
+ {
+ struct foo {
+ double d;
+ };
+ return foo.x;
+ }
+}
+</FONT></PRE>
+See the <A HREF="examples/ex4.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Prototypes are added for those functions that are called before being
+defined. Furthermore, if a prototype exists but does not specify the type of
+parameters that is fixed. But CIL will not be able to add prototypes for those
+functions that are neither declared nor defined (but are used!).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int f(); // Prototype without arguments
+ int f(double x) {
+ return g(x);
+ }
+ int g(double x) {
+ return x;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex5.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Array lengths are computed based on the initializers or by constant
+folding.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int a1[] = {1,2,3};
+ int a2[sizeof(int) &gt;= 4 ? 8 : 16];
+</FONT></PRE>
+See the <A HREF="examples/ex6.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Enumeration tags are computed using constant folding:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int main() {
+ enum {
+ FIVE = 5,
+ SIX, SEVEN,
+ FOUR = FIVE - 1,
+ EIGHT = sizeof(double)
+ } x = FIVE;
+ return x;
+}
+
+</FONT></PRE>
+See the <A HREF="examples/ex7.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializers are normalized to include specific initialization for the
+missing elements:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int a1[5] = {1,2,3};
+ struct foo { int x, y; } s1 = { 4 };
+</FONT></PRE>
+See the <A HREF="examples/ex8.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializer designators are interpreted and eliminated. Subobjects are
+properly marked with braces. CIL implements
+the whole ISO C99 specification for initializer (neither GCC nor MSVC do) and
+a few GCC extensions.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ struct foo {
+ int x, y;
+ int a[5];
+ struct inner {
+ int z;
+ } inner;
+ } s = { 0, .inner.z = 3, .a[1 ... 2] = 5, 4, y : 8 };
+</FONT></PRE>
+See the <A HREF="examples/ex9.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">String initializers for arrays of characters are processed
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+char foo[] = "foo plus bar";
+</FONT></PRE>
+See the <A HREF="examples/ex10.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">String constants are concatenated
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+char *foo = "foo " " plus " " bar ";
+</FONT></PRE>
+See the <A HREF="examples/ex11.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializers for local variables are turned into assignments. This is in
+order to separate completely the declarative part of a function body from the
+statements. This has the unfortunate effect that we have to drop the <TT>const</TT>
+qualifier from local variables !
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5;
+ struct foo { int f1, f2; } a [] = {1, 2, 3, 4, 5 };
+</FONT></PRE>
+See the <A HREF="examples/ex12.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Local variables in inner scopes are pulled to function scope (with
+appropriate renaming). Local scopes thus disappear. This makes it easy to find
+and operate on all local variables in a function.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5;
+ int main() {
+ int x = 6;
+ {
+ int x = 7;
+ return x;
+ }
+ return x;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex13.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Global declarations in local scopes are moved to global scope:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5;
+ int main() {
+ int x = 6;
+ {
+ static int x = 7;
+ return x;
+ }
+ return x;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex14.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Return statements are added for functions that are missing them. If the
+return type is not a base type then a <TT>return</TT> without a value is added.
+The guaranteed presence of return statements makes it easy to implement a
+transformation that inserts some code to be executed immediately before
+returning from a function.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo() {
+ int x = 5;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex15.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">One of the most significant transformations is that expressions that
+contain side-effects are separated into statements.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, f(int);
+ return (x ++ + f(x));
+</FONT></PRE>
+See the <A HREF="examples/ex16.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+Internally, the <TT>x ++</TT> statement is turned into an assignment which the
+pretty-printer prints like the original. CIL has only three forms of basic
+statements: assignments, function calls and inline assembly.<BR>
+<BR>
+<LI CLASS="li-enumerate">Shortcut evaluation of boolean expressions and the <TT>?:</TT> operator are
+compiled into explicit conditionals:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x;
+ int y = x ? 2 : 4;
+ int z = x || y;
+ // Here we duplicate the return statement
+ if(x &amp;&amp; y) { return 0; } else { return 1; }
+ // To avoid excessive duplication, CIL uses goto's for
+ // statement that have more than 5 instructions
+ if(x &amp;&amp; y || z) { x ++; y ++; z ++; x ++; y ++; return z; }
+</FONT></PRE>
+See the <A HREF="examples/ex17.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC's conditional expression with missing operands are also compiled
+into conditionals:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int f();;
+ return f() ? : 4;
+</FONT></PRE>
+See the <A HREF="examples/ex18.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">All forms of loops (<TT>while</TT>, <TT>for</TT> and <TT>do</TT>) are compiled
+internally as a single <TT>while(1)</TT> looping construct with explicit <TT>break</TT>
+statement for termination. For simple <TT>while</TT> loops the pretty printer is
+able to print back the original:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, y;
+ for(int i = 0; i&lt;5; i++) {
+ if(i == 5) continue;
+ if(i == 4) break;
+ i += 2;
+ }
+ while(x &lt; 5) {
+ if(x == 3) continue;
+ x ++;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex19.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC's block expressions are compiled away. (That's right there is an
+infinite loop in this code.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5, y = x;
+ int z = ({ x++; L: y -= x; y;});
+ return ({ goto L; 0; });
+</FONT></PRE>
+See the <A HREF="examples/ex20.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL contains support for both MSVC and GCC inline assembly (both in one
+internal construct)<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL compiles away the GCC extension that allows many kinds of constructs
+to be used as lvalues:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, y, z;
+ return &amp;(x ? y : z) - &amp; (x ++, x);
+</FONT></PRE>
+See the <A HREF="examples/ex21.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">All types are computed and explicit casts are inserted for all
+promotions and conversions that a compiler must insert:<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL will turn old-style function definition (without prototype) into
+new-style definitions. This will make the compiler less forgiving when
+checking function calls, and will catch for example cases when a function is
+called with too few arguments. This happens in old-style code for the purpose
+of implementing variable argument functions.<BR>
+<BR>
+<LI CLASS="li-enumerate">Since CIL sees the source after preprocessing the code after CIL does
+not contain the comments and the preprocessing directives.<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL will remove from the source file those type declarations, local
+variables and inline functions that are not used in the file. This means that
+your analysis does not have to see all the ugly stuff that comes from the
+header files:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+#include &lt;stdio.h&gt;
+
+typedef int unused_type;
+
+static char unused_static (void) { return 0; }
+
+int main() {
+ int unused_local;
+ printf("Hello world\n"); // Only printf will be kept from stdio.h
+}
+</FONT></PRE>
+See the <A HREF="examples/ex22.txt">CIL output</A> for this
+code fragment</OL>
+<!--TOC section How to Use CIL-->
+
+<H2 CLASS="section"><A NAME="htoc5">5</A>&nbsp;&nbsp;How to Use CIL</H2><!--SEC END -->
+<A NAME="sec-cil"></A><!--NAME cilly.html-->
+<BR>
+<BR>
+There are two predominant ways to use CIL to write a program analysis or
+transformation. The first is to phrase your analysis as a module that is
+called by our existing driver. The second is to use CIL as a stand-alone
+library. We highly recommend that you use <TT>cilly</TT>, our driver. <BR>
+<BR>
+<!--TOC subsection Using <TT>cilly</TT>, the CIL driver-->
+
+<H3 CLASS="subsection"><A NAME="htoc6">5.1</A>&nbsp;&nbsp;Using <TT>cilly</TT>, the CIL driver</H3><!--SEC END -->
+
+The most common way to use CIL is to write an Ocaml module containing your
+analysis and transformation, which you then link into our boilerplate
+driver application called <TT>cilly</TT>. <TT>cilly</TT> is a Perl script that
+processes and mimics <TT>GCC</TT> and <TT>MSVC</TT> command-line arguments and then
+calls <TT>cilly.byte.exe</TT> or <TT>cilly.asm.exe</TT> (CIL's Ocaml executable). <BR>
+<BR>
+An example of such module is <TT>logwrites.ml</TT>, a transformation that is
+distributed with CIL and whose purpose is to instrument code to print the
+addresses of memory locations being written. (We plan to release a
+C-language interface to CIL so that you can write your analyses in C
+instead of Ocaml.) See Section&nbsp;<A HREF="#sec-Extension">8</A> for a survey of other example
+modules. <BR>
+<BR>
+Assuming that you have written <TT>/home/necula/logwrites.ml</TT>,
+here is how you use it:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Modify <TT>logwrites.ml</TT> so that it includes a CIL &#8220;feature
+ descriptor&#8221; like this:
+<PRE CLASS="verbatim">
+let feature : featureDescr =
+ { fd_name = "logwrites";
+ fd_enabled = ref false;
+ fd_description = "generation of code to log memory writes";
+ fd_extraopt = [];
+ fd_doit =
+ (function (f: file) -&gt;
+ let lwVisitor = new logWriteVisitor in
+ visitCilFileSameGlobals lwVisitor f)
+ }
+</PRE>The <TT>fd_name</TT> field names the feature and its associated
+ command-line arguments. The <TT>fd_enabled</TT> field is a <TT>bool ref</TT>.
+ &#8220;<TT>fd_doit</TT>&#8221; will be invoked if <TT>!fd_enabled</TT> is true after
+ argument parsing, so initialize the ref cell to true if you want
+ this feature to be enabled by default.<BR>
+<BR>
+When the user passes the <TT>--dologwrites</TT>
+ command-line option to <TT>cilly</TT>, the variable associated with the
+ <TT>fd_enabled</TT> flag is set and the <TT>fd_doit</TT> function is called
+ on the <TT>Cil.file</TT> that represents the merger (see Section&nbsp;<A HREF="#sec-merger">13</A>) of
+ all C files listed as arguments. <BR>
+<BR>
+<LI CLASS="li-enumerate">Invoke <TT>configure</TT> with the arguments
+<PRE CLASS="verbatim">
+./configure EXTRASRCDIRS=/home/necula EXTRAFEATURES=logwrites
+</PRE>
+ This step works if each feature is packaged into its own ML file, and the
+name of the entry point in the file is <TT>feature</TT>.<BR>
+<BR>
+An alternative way to specify the new features is to change the build files
+yourself, as explained below. You'll need to use this method if a single
+feature is split across multiple files.
+<OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
+ Put <TT>logwrites.ml</TT> in the <TT>src</TT> or <TT>src/ext</TT> directory. This
+ will make sure that <TT>make</TT> can find it. If you want to put it in some
+ other directory, modify <TT>Makefile.in</TT> and add to <TT>SOURCEDIRS</TT> your
+ directory. Alternately, you can create a symlink from <TT>src</TT> or
+ <TT>src/ext</TT> to your file.<BR>
+<BR>
+<LI CLASS="li-enumerate">Modify the <TT>Makefile.in</TT> and add your module to the
+ <TT>CILLY_MODULES</TT> or
+ <TT>CILLY_LIBRARY_MODULES</TT> variables. The order of the modules matters. Add
+ your modules somewhere after <TT>cil</TT> and before <TT>main</TT>.<BR>
+<BR>
+<LI CLASS="li-enumerate">If you have any helper files for your module, add those to
+ the makefile in the same way. e.g.:
+<PRE CLASS="verbatim">
+CILLY_MODULES = $(CILLY_LIBRARY_MODULES) \
+ myutilities1 myutilities2 logwrites \
+ main
+</PRE>
+ Again, order is important: <TT>myutilities2.ml</TT> will be able to refer
+ to Myutilities1 but not Logwrites. If you have any ocamllex or ocamlyacc
+ files, add them to both <TT>CILLY_MODULES</TT> and either <TT>MLLS</TT> or
+ <TT>MLYS</TT>.<BR>
+<BR>
+<LI CLASS="li-enumerate">Modify <TT>main.ml</TT> so that your new feature descriptor appears in
+ the global list of CIL features.
+<PRE CLASS="verbatim">
+let features : C.featureDescr list =
+ [ Logcalls.feature;
+ Oneret.feature;
+ Heapify.feature1;
+ Heapify.feature2;
+ makeCFGFeature;
+ Partial.feature;
+ Simplemem.feature;
+ Logwrites.feature; (* add this line to include the logwrites feature! *)
+ ]
+ @ Feature_config.features
+</PRE>
+ Features are processed in the order they appear on this list. Put
+ your feature last on the list if you plan to run any of CIL's
+ built-in features (such as makeCFGfeature) before your own.</OL><BR>
+Standard code in <TT>cilly</TT> takes care of adding command-line arguments,
+ printing the description, and calling your function automatically.
+ Note: do not worry about introducing new bugs into CIL by adding a single
+ line to the feature list. <BR>
+<BR>
+<LI CLASS="li-enumerate">Now you can invoke the <TT>cilly</TT> application on a preprocessed file, or
+ instead use the <TT>cilly</TT> driver which provides a convenient compiler-like
+ interface to <TT>cilly</TT>. See Section&nbsp;<A HREF="#sec-driver">7</A> for details using <TT>cilly</TT>.
+ Remember to enable your analysis by passing the right argument (e.g.,
+ <TT>--dologwrites</TT>). </OL>
+<!--TOC subsection Using CIL as a library-->
+
+<H3 CLASS="subsection"><A NAME="htoc7">5.2</A>&nbsp;&nbsp;Using CIL as a library</H3><!--SEC END -->
+
+CIL can also be built as a library that is called from your stand-alone
+application. Add <TT>cil/src</TT>, <TT>cil/src/frontc</TT>, <TT>cil/obj/x86_LINUX</TT>
+(or <TT>cil/obj/x86_WIN32</TT>) to your Ocaml project <TT>-I</TT> include paths.
+Building CIL will also build the library <TT>cil/obj/*/cil.cma</TT> (or
+<TT>cil/obj/*/cil.cmxa</TT>). You can then link your application against that
+library. <BR>
+<BR>
+You can call the <TT>Frontc.parse: string -&gt; unit -&gt; Cil.file</TT> function with
+the name of a file containing the output of the C preprocessor.
+The <TT>Mergecil.merge: Cil.file list -&gt; string -&gt; Cil.file</TT> function merges
+multiple files. You can then invoke your analysis function on the resulting
+<TT>Cil.file</TT> data structure. You might want to call
+<TT>Rmtmps.removeUnusedTemps</TT> first to clean up the prototypes and variables
+that are not used. Then you can call the function <TT>Cil.dumpFile:
+cilPrinter -&gt; out_channel -&gt; Cil.file -&gt; unit</TT> to print the file to a
+given output channel. A good <TT>cilPrinter</TT> to use is
+<TT>defaultCilPrinter</TT>. <BR>
+<BR>
+Check out <TT>src/main.ml</TT> and <TT>bin/cilly</TT> for other good ideas
+about high-level file processing. Again, we highly recommend that you just
+our <TT>cilly</TT> driver so that you can avoid spending time re-inventing the
+wheel to provide drop-in support for standard <TT>makefile</TT>s. <BR>
+<BR>
+Here is a concrete example of compiling and linking your project against
+CIL. Imagine that your program analysis or transformation is contained in
+the single file <TT>main.ml</TT>.
+<PRE CLASS="verbatim">
+$ ocamlopt -c -I $(CIL)/obj/x86_LINUX/ main.ml
+$ ocamlopt -ccopt -L$(CIL)/obj/x86_LINUX/ -o main unix.cmxa str.cmxa \
+ $(CIL)/obj/x86_LINUX/cil.cmxa main.cmx
+</PRE>
+The first line compiles your analysis, the second line links it against CIL
+(as a library) and the Ocaml Unix library. For more information about
+compiling and linking Ocaml programs, see the Ocaml home page
+at <A HREF="javascript:loadTop('http://caml.inria.fr/ocaml/')">http://caml.inria.fr/ocaml/</A>. <BR>
+<BR>
+In the next section we give an overview of the API that you can use
+to write your analysis and transformation. <BR>
+<BR>
+<!--TOC section CIL API Documentation-->
+
+<H2 CLASS="section"><A NAME="htoc8">6</A>&nbsp;&nbsp;CIL API Documentation</H2><!--SEC END -->
+<A NAME="sec-api"></A>
+The CIL API is documented in the file <TT>src/cil.mli</TT>. We also have an
+<A HREF="api/index.html">online documentation</A> extracted from <TT>cil.mli</TT>. We
+index below the main types that are used to represent C programs in CIL:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/index_types.html">An index of all types</A>
+<LI CLASS="li-itemize"><A HREF="api/index_values.html">An index of all values</A>
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfile">Cil.file</A> is the representation of a file.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEglobal">Cil.global</A> is the representation of a global declaration or
+definitions. Values for <A HREF="api/Cil.html#VALemptyFunction">operating on globals</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEtyp">Cil.typ</A> is the representation of a type.
+Values for <A HREF="api/Cil.html#VALvoidType">operating on types</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEcompinfo">Cil.compinfo</A> is the representation of a structure or a union
+type
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfieldinfo">Cil.fieldinfo</A> is the representation of a field in a structure
+or a union
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEenuminfo">Cil.enuminfo</A> is the representation of an enumeration type.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEvarinfo">Cil.varinfo</A> is the representation of a variable
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfundec">Cil.fundec</A> is the representation of a function
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPElval">Cil.lval</A> is the representation of an lvalue.
+Values for <A HREF="api/Cil.html#VALmakeVarInfo">operating on lvalues</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEexp">Cil.exp</A> is the representation of an expression without
+side-effects.
+Values for <A HREF="api/Cil.html#VALzero">operating on expressions</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEinstr">Cil.instr</A> is the representation of an instruction (with
+side-effects but without control-flow)
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> is the representation of a control-flow statements.
+Values for <A HREF="api/Cil.html#VALmkStmt">operating on statements</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A> is the representation of attributes.
+Values for <A HREF="api/Cil.html#TYPEattributeClass">operating on attributes</A>.
+</UL>
+<!--TOC subsection Using the visitor-->
+
+<H3 CLASS="subsection"><A NAME="htoc9">6.1</A>&nbsp;&nbsp;Using the visitor</H3><!--SEC END -->
+<A NAME="sec-visitor"></A>
+One of the most useful tools exported by the CIL API is an implementation of
+the visitor pattern for CIL programs. The visiting engine scans depth-first
+the structure of a CIL program and at each node is queries a user-provided
+visitor structure whether it should do one of the following operations:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+Ignore this node and all its descendants
+<LI CLASS="li-itemize">Descend into all of the children and when done rebuild the node if any
+of the children have changed.
+<LI CLASS="li-itemize">Replace the subtree rooted at the node with another tree.
+<LI CLASS="li-itemize">Replace the subtree with another tree, then descend into the children
+and rebuild the node if necessary and then invoke a user-specified function.
+<LI CLASS="li-itemize">In addition to all of the above actions then visitor can specify that
+some instructions should be queued to be inserted before the current
+instruction or statement being visited.
+</UL>
+By writing visitors you can customize the program traversal and
+transformation. One major limitation of the visiting engine is that it does
+not propagate information from one node to another. Each visitor must use its
+own private data to achieve this effect if necessary. <BR>
+<BR>
+Each visitor is an object that is an instance of a class of type <A HREF="api/Cil.cilVisitor.html#.">Cil.cilVisitor..</A>
+The most convenient way to obtain such classes is to specialize the
+<A HREF="api/Cil.nopCilVisitor.html#c">Cil.nopCilVisitor.c</A>lass (which just traverses the tree doing
+nothing). Any given specialization typically overrides only a few of the
+methods. Take a look for example at the visitor defined in the module
+<TT>logwrites.ml</TT>. Another, more elaborate example of a visitor is the
+[copyFunctionVisitor] defined in <TT>cil.ml</TT>.<BR>
+<BR>
+Once you have defined a visitor you can invoke it with one of the functions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> or <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> - visit a file
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilGlobal">Cil.visitCilGlobal</A> - visit a global
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilFunction">Cil.visitCilFunction</A> - visit a function definition
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilExp">Cil.visitCilExp</A> - visit an expression
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilLval">Cil.visitCilLval</A> - visit an lvalue
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilInstr">Cil.visitCilInstr</A> - visit an instruction
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilStmt">Cil.visitCilStmt</A> - visit a statement
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilType">Cil.visitCilType</A> - visit a type. Note that this does not visit
+the files of a composite type. use visitGlobal to visit the [GCompTag] that
+defines the fields.
+</UL>
+Some transformations may want to use visitors to insert additional
+instructions before statements and instructions. To do so, pass a list of
+instructions to the <A HREF="api/Cil.html#VALqueueInstr">Cil.queueInstr</A> method of the specialized
+object. The instructions will automatically be inserted before that
+instruction in the transformed code. The <A HREF="api/Cil.html#VALunqueueInstr">Cil.unqueueInstr</A> method
+should not normally be called by the user. <BR>
+<BR>
+<!--TOC subsection Interpreted Constructors and Deconstructors-->
+
+<H3 CLASS="subsection"><A NAME="htoc10">6.2</A>&nbsp;&nbsp;Interpreted Constructors and Deconstructors</H3><!--SEC END -->
+
+Interpreted constructors and deconstructors are a facility for constructing
+and deconstructing CIL constructs using a pattern with holes that can be
+filled with a variety of kinds of elements. The pattern is a string that uses
+the C syntax to represent C language elements. For example, the following
+code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.cType "void * const (*)(int x)"
+</FONT></PRE>
+is an alternative way to construct the internal representation of the type of pointer to function
+with an integer argument and a void * const as result:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+TPtr(TFun(TVoid [Attr("const", [])],
+ [ ("x", TInt(IInt, []), []) ], false, []), [])
+</FONT></PRE>
+The advantage of the interpreted constructors is that you can use familiar C
+syntax to construct CIL abstract-syntax trees. <BR>
+<BR>
+You can construct this way types, lvalues, expressions, instructions and
+statements. The pattern string can also contain a number of placeholders that
+are replaced during construction with CIL items passed as additional argument
+to the construction function. For example, the <TT>%e:id</TT> placeholder means
+that the argument labeled &#8220;id&#8221; (expected to be of form <TT>Fe exp</TT>) will
+supply the expression to replace the placeholder. For example, the following
+code constructs an increment instruction at location <TT>loc</TT>:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.cInstr "%v:x = %v:x + %e:something"
+ loc
+ [ ("something", Fe some_exp);
+ ("x", Fv some_varinfo) ]
+</FONT></PRE>
+An alternative way to construct the same CIL instruction is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Set((Var some_varinfo, NoOffset),
+ BinOp(PlusA, Lval (Var some_varinfo, NoOffset),
+ some_exp, intType),
+ loc)
+</FONT></PRE>
+See <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> for a definition of the placeholders that are
+understood.<BR>
+<BR>
+A dual feature is the interpreted deconstructors. This can be used to test
+whether a CIL construct has a certain form:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.dType "void * const (*)(int x)" t
+</FONT></PRE>
+will test whether the actual argument <TT>t</TT> is indeed a function pointer of
+the required type. If it is then the result is <TT>Some []</TT> otherwise it is
+<TT>None</TT>. Furthermore, for the purpose of the interpreted deconstructors
+placeholders in patterns match anything of the right type. For example,
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.dType "void * (*)(%F:t)" t
+</FONT></PRE>
+will match any function pointer type, independent of the type and number of
+the formals. If the match succeeds the result is <TT>Some [ FF forms ]</TT> where
+<TT>forms</TT> is a list of names and types of the formals. Note that each member
+in the resulting list corresponds positionally to a placeholder in the
+pattern.<BR>
+<BR>
+The interpreted constructors and deconstructors do not support the complete C
+syntax, but only a substantial fragment chosen to simplify the parsing. The
+following is the syntax that is supported:
+<PRE CLASS="verbatim">
+Expressions:
+ E ::= %e:ID | %d:ID | %g:ID | n | L | ( E ) | Unop E | E Binop E
+ | sizeof E | sizeof ( T ) | alignof E | alignof ( T )
+ | &amp; L | ( T ) E
+
+Unary operators:
+ Unop ::= + | - | ~ | %u:ID
+
+Binary operators:
+ Binop ::= + | - | * | / | &lt;&lt; | &gt;&gt; | &amp; | ``|'' | ^
+ | == | != | &lt; | &gt; | &lt;= | &gt;= | %b:ID
+
+Lvalues:
+ L ::= %l:ID | %v:ID Offset | * E | (* E) Offset | E -&gt; ident Offset
+
+Offsets:
+ Offset ::= empty | %o:ID | . ident Offset | [ E ] Offset
+
+Types:
+ T ::= Type_spec Attrs Decl
+
+Type specifiers:
+ Type_spec ::= void | char | unsigned char | short | unsigned short
+ | int | unsigned int | long | unsigned long | %k:ID | float
+ | double | struct %c:ID | union %c:ID
+
+
+Declarators:
+ Decl ::= * Attrs Decl | Direct_decl
+
+
+Direct declarators:
+ Direct_decl ::= empty | ident | ( Attrs Decl )
+ | Direct_decl [ Exp_opt ]
+ | ( Attrs Decl )( Parameters )
+
+Optional expressions
+ Exp_opt ::= empty | E | %eo:ID
+
+Formal parameters
+ Parameters ::= empty | ... | %va:ID | %f:ID | T | T , Parameters
+
+List of attributes
+ Attrs ::= empty | %A:ID | Attrib Attrs
+
+Attributes
+ Attrib ::= const | restrict | volatile | __attribute__ ( ( GAttr ) )
+
+GCC Attributes
+ GAttr ::= ident | ident ( AttrArg_List )
+
+Lists of GCC Attribute arguments:
+ AttrArg_List ::= AttrArg | %P:ID | AttrArg , AttrArg_List
+
+GCC Attribute arguments
+ AttrArg ::= %p:ID | ident | ident ( AttrArg_List )
+
+Instructions
+ Instr ::= %i:ID ; | L = E ; | L Binop= E | Callres L ( Args )
+
+Actual arguments
+ Args ::= empty | %E:ID | E | E , Args
+
+Call destination
+ Callres ::= empty | L = | %lo:ID
+
+Statements
+ Stmt ::= %s:ID | if ( E ) then Stmt ; | if ( E ) then Stmt else Stmt ;
+ | return Exp_opt | break ; | continue ; | { Stmt_list }
+ | while (E ) Stmt | Instr_list
+
+Lists of statements
+ Stmt_list ::= empty | %S:ID | Stmt Stmt_list
+ | Type_spec Attrs Decl ; Stmt_list
+ | Type_spec Attrs Decl = E ; Stmt_list
+ | Type_spec Attrs Decl = L (Args) ; Stmt_list
+
+List of instructions
+ Instr_list ::= Instr | %I:ID | Instr Instr_list
+</PRE>
+Notes regarding the syntax:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+In the grammar description above non-terminals are written with
+uppercase initial<BR>
+<BR>
+<LI CLASS="li-itemize">All of the patterns consist of the <TT>%</TT> character followed by one or
+two letters, followed by &#8220;:&#8221; and an indentifier. For each such
+pattern there is a corresponding constructor of the <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A>
+type, whose name is the letter 'F' followed by the same one or two letters as
+in the pattern. That constructor is used by the user code to pass a
+<A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> actual argument to the interpreted constructor and by
+the interpreted deconstructor to return what was matched for a pattern.<BR>
+<BR>
+<LI CLASS="li-itemize">If the pattern name is uppercase, it designates a list of the elements
+designated by the corresponding lowercase pattern. E.g. %E designated lists
+of expressions (as in the actual arguments of a call).<BR>
+<BR>
+<LI CLASS="li-itemize">The two-letter patterns whose second letter is &#8220;o&#8221; designate an
+optional element. E.g. %eo designates an optional expression (as in the
+length of an array). <BR>
+<BR>
+<LI CLASS="li-itemize">Unlike in calls to <TT>printf</TT>, the pattern %g is used for strings. <BR>
+<BR>
+<LI CLASS="li-itemize">The usual precedence and associativity rules as in C apply <BR>
+<BR>
+<LI CLASS="li-itemize">The pattern string can contain newlines and comments, using both the
+<TT>/* ... */</TT> style as well as the <TT>//</TT> one. <BR>
+<BR>
+<LI CLASS="li-itemize">When matching a &#8220;cast&#8221; pattern of the form <TT>( T ) E</TT>, the
+deconstructor will match even expressions that do not have the actual cast but
+in that case the type is matched against the type of the expression. E.g. the
+patters <TT>"(int)%e"</TT> will match any expression of type <TT>int</TT> whether it
+has an explicit cast or not. <BR>
+<BR>
+<LI CLASS="li-itemize">The %k pattern is used to construct and deconstruct an integer type of
+any kind. <BR>
+<BR>
+<LI CLASS="li-itemize">Notice that the syntax of types and declaration are the same (in order
+to simplify the parser). This means that technically you can write a whole
+declaration instead of a type in the cast. In this case the name that you
+declare is ignored.<BR>
+<BR>
+<LI CLASS="li-itemize">In lists of formal parameters and lists of attributes, an empty list in
+the pattern matches any formal parameters or attributes. <BR>
+<BR>
+<LI CLASS="li-itemize">When matching types, uses of named types are unrolled to expose a real
+type before matching. <BR>
+<BR>
+<LI CLASS="li-itemize">The order of the attributes is ignored during matching. The the pattern
+for a list of attributes contains %A then the resulting <TT>formatArg</TT> will be
+bound to <B>all</B> attributes in the list. For example, the pattern <TT>"const
+%A"</TT> matches any list of attributes that contains <TT>const</TT> and binds the
+corresponding placeholder to the entire list of attributes, including
+<TT>const</TT>. <BR>
+<BR>
+<LI CLASS="li-itemize">All instruction-patterns must be terminated by semicolon<BR>
+<BR>
+<LI CLASS="li-itemize">The autoincrement and autodecrement instructions are not supported. Also
+not supported are complex expressions, the <TT>&amp;&amp;</TT> and <TT>||</TT> shortcut
+operators, and a number of other more complex instructions or statements. In
+general, the patterns support only constructs that can be represented directly
+in CIL.<BR>
+<BR>
+<LI CLASS="li-itemize">The pattern argument identifiers are not used during deconstruction.
+Instead, the result contains a sequence of values in the same order as the
+appearance of pattern arguments in the pattern.<BR>
+<BR>
+<LI CLASS="li-itemize">You can mix statements with declarations. For each declaration a new
+ temporary will be constructed (using a function you provive). You can then
+ refer to that temporary by name in the rest of the pattern.<BR>
+<BR>
+<LI CLASS="li-itemize">The <TT>%v:</TT> pattern specifier is optional.
+</UL>
+The following function are defined in the <TT>Formatcil</TT> module for
+constructing and deconstructing:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Formatcil.html#VALcExp">Formatcil.cExp</A> constructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcType">Formatcil.cType</A> constructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcLval">Formatcil.cLval</A> constructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcInstr">Formatcil.cInstr</A> constructs <A HREF="api/Cil.html#TYPEinstr">Cil.instr</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcStmt">Formatcil.cStmt</A> and <A HREF="api/Formatcil.html#VALcStmts">Formatcil.cStmts</A> construct <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdExp">Formatcil.dExp</A> deconstructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdType">Formatcil.dType</A> deconstructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdLval">Formatcil.dLval</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdInstr">Formatcil.dInstr</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
+</UL>
+Below is an example using interpreted constructors. This example generates
+the CIL representation of code that scans an array backwards and initializes
+every even-index element with an expression:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.cStmts
+ loc
+ "int idx = sizeof(array) / sizeof(array[0]) - 1;
+ while(idx &gt;= 0) {
+ // Some statements to be run for all the elements of the array
+ %S:init
+ if(! (idx &amp; 1))
+ array[idx] = %e:init_even;
+ /* Do not forget to decrement the index variable */
+ idx = idx - 1;
+ }"
+ (fun n t -&gt; makeTempVar myfunc ~name:n t)
+ [ ("array", Fv myarray);
+ ("init", FS [stmt1; stmt2; stmt3]);
+ ("init_even", Fe init_expr_for_even_elements) ]
+</FONT></PRE>
+To write the same CIL statement directly in CIL would take much more effort.
+Note that the pattern is parsed only once and the result (a function that
+takes the arguments and constructs the statement) is memoized. <BR>
+<BR>
+<!--TOC subsubsection Performance considerations for interpreted constructors-->
+
+<H4 CLASS="subsubsection"><A NAME="htoc11">6.2.1</A>&nbsp;&nbsp;Performance considerations for interpreted constructors</H4><!--SEC END -->
+
+Parsing the patterns is done with a LALR parser and it takes some time. To
+improve performance the constructors and deconstructors memoize the parsed
+patterns and will only compile a pattern once. Also all construction and
+deconstruction functions can be applied partially to the pattern string to
+produce a function that can be later used directly to construct or
+deconstruct. This function appears to be about two times slower than if the
+construction is done using the CIL constructors (without memoization the
+process would be one order of magnitude slower.) However, the convenience of
+interpreted constructor might make them a viable choice in many situations
+when performance is not paramount (e.g. prototyping).<BR>
+<BR>
+<!--TOC subsection Printing and Debugging support-->
+
+<H3 CLASS="subsection"><A NAME="htoc12">6.3</A>&nbsp;&nbsp;Printing and Debugging support</H3><!--SEC END -->
+
+The Modules <A HREF="api/Pretty.html">Pretty</A> and <A HREF="api/Errormsg.html">Errormsg</A> contain respectively
+utilities for pretty printing and reporting errors and provide a convenient
+<TT>printf</TT>-like interface. <BR>
+<BR>
+Additionally, CIL defines for each major type a pretty-printing function that
+you can use in conjunction with the <A HREF="api/Pretty.html">Pretty</A> interface. The
+following are some of the pretty-printing functions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Cil.html#VALd_exp">Cil.d_exp</A> - print an expression
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_type">Cil.d_type</A> - print a type
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_lval">Cil.d_lval</A> - print an lvalue
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_global">Cil.d_global</A> - print a global
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_stmt">Cil.d_stmt</A> - print a statment
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_instr">Cil.d_instr</A> - print an instruction
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_init">Cil.d_init</A> - print an initializer
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attr">Cil.d_attr</A> - print an attribute
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attrlist">Cil.d_attrlist</A> - print a set of attributes
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_loc">Cil.d_loc</A> - print a location
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_ikind">Cil.d_ikind</A> - print an integer kind
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_fkind">Cil.d_fkind</A> - print a floating point kind
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_const">Cil.d_const</A> - print a constant
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_storage">Cil.d_storage</A> - print a storage specifier
+</UL>
+You can even customize the pretty-printer by creating instances of
+<A HREF="api/Cil.cilPrinter.html#.">Cil.cilPrinter..</A> Typically such an instance extends
+<A HREF="api/Cil.html#VALdefaultCilPrinter">Cil.defaultCilPrinter</A>. Once you have a customized pretty-printer you
+can use the following printing functions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Cil.html#VALprintExp">Cil.printExp</A> - print an expression
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintType">Cil.printType</A> - print a type
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintLval">Cil.printLval</A> - print an lvalue
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintGlobal">Cil.printGlobal</A> - print a global
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintStmt">Cil.printStmt</A> - print a statment
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInstr">Cil.printInstr</A> - print an instruction
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInit">Cil.printInit</A> - print an initializer
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttr">Cil.printAttr</A> - print an attribute
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttrs">Cil.printAttrs</A> - print a set of attributes
+</UL>
+CIL has certain internal consistency invariants. For example, all references
+to a global variable must point to the same <TT>varinfo</TT> structure. This
+ensures that one can rename the variable by changing the name in the
+<TT>varinfo</TT>. These constraints are mentioned in the API documentation. There
+is also a consistency checker in file <TT>src/check.ml</TT>. If you suspect that
+your transformation is breaking these constraints then you can pass the
+<TT>--check</TT> option to cilly and this will ensure that the consistency checker
+is run after each transformation. <BR>
+<BR>
+<!--TOC subsection Attributes-->
+
+<H3 CLASS="subsection"><A NAME="htoc13">6.4</A>&nbsp;&nbsp;Attributes</H3><!--SEC END -->
+<A NAME="sec-attrib"></A>
+In CIL you can attach attributes to types and to names (variables, functions
+and fields). Attributes are represented using the type <A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A>.
+An attribute consists of a name and a number of arguments (represented using
+the type <A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). Almost any expression can be used as an
+attribute argument. Attributes are stored in lists sorted by the name of the
+attribute. To maintain list ordering, use the functions
+<A HREF="api/Cil.html#VALtypeAttrs">Cil.typeAttrs</A> to retrieve the attributes of a type and the functions
+<A HREF="api/Cil.html#VALaddAttribute">Cil.addAttribute</A> and <A HREF="api/Cil.html#VALaddAttributes">Cil.addAttributes</A> to add attributes.
+Alternatively you can use <A HREF="api/Cil.html#VALtypeAddAttributes">Cil.typeAddAttributes</A> to add an attribute to
+a type (and return the new type).<BR>
+<BR>
+GCC already has extensive support for attributes, and CIL extends this
+support to user-defined attributes. A GCC attribute has the syntax:
+<PRE CLASS="verbatim">
+ gccattribute ::= __attribute__((attribute)) (Note the double parentheses)
+</PRE>
+ Since GCC and MSVC both support various flavors of each attribute (with or
+without leading or trailing _) we first strip ALL leading and trailing _
+from the attribute name (but not the identified in [ACons] parameters in
+<A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). When we print attributes, for GCC we add two leading
+and two trailing _; for MSVC we add just two leading _.<BR>
+<BR>
+There is support in CIL so that you can control the printing of attributes
+(see <A HREF="api/Cil.html#VALsetCustomPrintAttribute">Cil.setCustomPrintAttribute</A> and
+<A HREF="api/Cil.html#VALsetCustomPrintAttributeScope">Cil.setCustomPrintAttributeScope</A>). This custom-printing support is now
+used to print the "const" qualifier as "<TT>const</TT>" and not as
+"<TT>__attribute__((const))</TT>".<BR>
+<BR>
+The attributes are specified in declarations. This is unfortunate since the C
+syntax for declarations is already quite complicated and after writing the
+parser and elaborator for declarations I am convinced that few C programmers
+understand it completely. Anyway, this seems to be the easiest way to support
+attributes. <BR>
+<BR>
+Name attributes must be specified at the very end of the declaration, just
+before the <TT>=</TT> for the initializer or before the <TT>,</TT> the separates a
+declaration in a group of declarations or just before the <TT>;</TT> that
+terminates the declaration. A name attribute for a function being defined can
+be specified just before the brace that starts the function body.<BR>
+<BR>
+For example (in the following examples <TT>A1</TT>,...,<TT>An</TT> are type attributes
+and <TT>N</TT> is a name attribute (each of these uses the <TT>__attribute__</TT> syntax):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x N;
+ int x N, * y N = 0, z[] N;
+ extern void exit() N;
+ int fact(int x) N { ... }
+</FONT></PRE>
+Type attributes can be specified along with the type using the following
+ rules:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+ The type attributes for a base type (int, float, named type, reference
+ to struct or union or enum) must be specified immediately following the
+ type (actually it is Ok to mix attributes with the specification of the
+ type, in between unsigned and int for example).<BR>
+<BR>
+For example:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int A1 x N; /* A1 applies to the type int. An example is an attribute
+ "even" restricting the type int to even values. */
+ struct foo A1 A2 x; // Both A1 and A2 apply to the struct foo type
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-enumerate">The type attributes for a pointer type must be specified immediately
+ after the * symbol.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ /* A pointer (A1) to an int (A2) */
+ int A2 * A1 x;
+ /* A pointer (A1) to a pointer (A2) to a float (A3) */
+ float A3 * A2 * A1 x;
+</FONT></PRE>
+Note: The attributes for base types and for pointer types are a strict
+ extension of the ANSI C type qualifiers (const, volatile and restrict). In
+ fact CIL treats these qualifiers as attributes. <BR>
+<BR>
+<LI CLASS="li-enumerate">The attributes for a function type or for an array type can be
+ specified using parenthesized declarators.<BR>
+<BR>
+For example:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ /* A function (A1) from int (A2) to float (A3) */
+ float A3 (A1 f)(int A2);
+
+ /* A pointer (A1) to a function (A2) that returns an int (A3) */
+ int A3 (A2 * A1 pfun)(void);
+
+ /* An array (A1) of int (A2) */
+ int A2 (A1 x0)[]
+
+ /* Array (A1) of pointers (A2) to functions (A3) that take an int (A4) and
+ * return a pointer (A5) to int (A6) */
+ int A6 * A5 (A3 * A2 (A1 x1)[5])(int A4);
+
+
+ /* A function (A4) that takes a float (A5) and returns a pointer (A6) to an
+ * int (A7) */
+ extern int A7 * A6 (A4 x2)(float A5 x);
+
+ /* A function (A1) that takes a int (A2) and that returns a pointer (A3) to
+ * a function (A4) that takes a float (A5) and returns a pointer (A6) to an
+ * int (A7) */
+ int A7 * A6 (A4 * A3 (A1 x3)(int A2 x))(float A5) {
+ return &amp; x2;
+ }
+</FONT></PRE></OL>
+Note: ANSI C does not allow the specification of type qualifiers for function
+and array types, although it allows for the parenthesized declarator. With
+just a bit of thought (looking at the first few examples above) I hope that
+the placement of attributes for function and array types will seem intuitive.<BR>
+<BR>
+This extension is not without problems however. If you want to refer just to
+a type (in a cast for example) then you leave the name out. But this leads to
+strange conflicts due to the parentheses that we introduce to scope the
+attributes. Take for example the type of x0 from above. It should be written
+as:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int A2 (A1 )[]
+</FONT></PRE>
+But this will lead most C parsers into deep confusion because the parentheses
+around A1 will be confused for parentheses of a function designator. To push
+this problem around (I don't know a solution) whenever we are about to print a
+parenthesized declarator with no name but with attributes, we comment out the
+attributes so you can see them (for whatever is worth) without confusing the
+compiler. For example, here is how we would print the above type:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int A2 /*(A1 )*/[]
+</FONT></PRE>
+<!--TOC paragraph Handling of predefined GCC attributes-->
+
+<H5 CLASS="paragraph">Handling of predefined GCC attributes</H5><!--SEC END -->
+
+GCC already supports attributes in a lot of places in declarations. The only
+place where we support attributes and GCC does not is right before the { that
+starts a function body. <BR>
+<BR>
+GCC classifies its attributes in attributes for functions, for variables and
+for types, although the latter category is only usable in definition of struct
+or union types and is not nearly as powerful as the CIL type attributes. We
+have made an effort to reclassify GCC attributes as name and type attributes
+(they only apply for function types). Here is what we came up with:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+ GCC name attributes:<BR>
+<BR>
+section, constructor, destructor, unused, weak, no_instrument_function,
+ noreturn, alias, no_check_memory_usage, dllinport, dllexport, exception,
+ model<BR>
+<BR>
+Note: the "noreturn" attribute would be more appropriately qualified as a
+ function type attribute. But we classify it as a name attribute to make
+ it easier to support a similarly named MSVC attribute. <BR>
+<BR>
+<LI CLASS="li-itemize">GCC function type attributes:<BR>
+<BR>
+fconst (printed as "const"), format, regparm, stdcall,
+ cdecl, longcall<BR>
+<BR>
+I was not able to completely decipher the position in which these attributes
+ must go. So, the CIL elaborator knows these names and applies the following
+ rules:
+ <UL CLASS="itemize"><LI CLASS="li-itemize">
+ All of the name attributes that appear in the specifier part (i.e. at
+ the beginning) of a declaration are associated with all declared names. <BR>
+<BR>
+<LI CLASS="li-itemize">All of the name attributes that appear at the end of a declarator are
+ associated with the particular name being declared.<BR>
+<BR>
+<LI CLASS="li-itemize">More complicated is the handling of the function type attributes, since
+ there can be more than one function in a single declaration (a function
+ returning a pointer to a function). Lacking any real understanding of how
+ GCC handles this, I attach the function type attribute to the "nearest"
+ function. This means that if a pointer to a function is "nearby" the
+ attribute will be correctly associated with the function. In truth I pray
+ that nobody uses declarations as that of x3 above.
+ </UL>
+</UL>
+<!--TOC paragraph Handling of predefined MSVC attributes-->
+
+<H5 CLASS="paragraph">Handling of predefined MSVC attributes</H5><!--SEC END -->
+
+MSVC has two kinds of attributes, declaration modifiers to be printed before
+ the storage specifier using the notation "<TT>__declspec(...)</TT>" and a few
+ function type attributes, printed almost as our CIL function type
+ attributes. <BR>
+<BR>
+The following are the name attributes that are printed using
+ <TT>__declspec</TT> right before the storage designator of the declaration:
+ thread, naked, dllimport, dllexport, noreturn<BR>
+<BR>
+The following are the function type attributes supported by MSVC:
+ fastcall, cdecl, stdcall<BR>
+<BR>
+It is not worth going into the obscure details of where MSVC accepts these
+ type attributes. The parser thinks it knows these details and it pulls
+ these attributes from wherever they might be placed. The important thing
+ is that MSVC will accept if we print them according to the rules of the CIL
+ attributes ! <BR>
+<BR>
+<!--TOC section The CIL Driver-->
+
+<H2 CLASS="section"><A NAME="htoc14">7</A>&nbsp;&nbsp;The CIL Driver</H2><!--SEC END -->
+<A NAME="sec-driver"></A>
+We have packaged CIL as an application <TT>cilly</TT> that contains certain
+example modules, such as <TT>logwrites.ml</TT> (a module
+that instruments code to print the addresses of memory locations being
+written). Normally, you write another module like that, add command-line
+options and an invocation of your module in <TT>src/main.ml</TT>. Once you compile
+CIL you will obtain the file <TT>obj/cilly.asm.exe</TT>. <BR>
+<BR>
+We wrote a driver for this executable that makes it easy to invoke your
+analysis on existing C code with very little manual intervention. This driver
+is <TT>bin/cilly</TT> and is quite powerful. Note that the <TT>cilly</TT> script
+is configured during installation with the path where CIL resides. This means
+that you can move it to any place you want. <BR>
+<BR>
+A simple use of the driver is:
+<PRE CLASS="verbatim">
+bin/cilly --save-temps -D HAPPY_MOOD -I myincludes hello.c -o hello
+</PRE>
+<FONT COLOR=blue>--save-temps</FONT> tells CIL to save the resulting output files in the
+current directory. Otherwise, they'll be put in <TT>/tmp</TT> and deleted
+automatically. Not that this is the only CIL-specific flag in the
+list &ndash; the other flags use <TT>gcc</TT>'s syntax.<BR>
+<BR>
+This performs the following actions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+preprocessing using the -D and -I arguments with the resulting
+ file left in <TT>hello.i</TT>,
+<LI CLASS="li-itemize">the invocation of the <TT>cilly.asm</TT> application which parses <TT>hello.i</TT>
+ converts it to CIL and the pretty-prints it to <TT>hello.cil.c</TT>
+<LI CLASS="li-itemize">another round of preprocessing with the result placed in <TT>hello.cil.i</TT>
+<LI CLASS="li-itemize">the true compilation with the result in <TT>hello.cil.o</TT>
+<LI CLASS="li-itemize">a linking phase with the result in <TT>hello</TT>
+</UL>
+Note that <TT>cilly</TT> behaves like the <TT>gcc</TT> compiler. This makes it
+easy to use it with existing <TT>Makefiles</TT>:
+<PRE CLASS="verbatim">
+make CC="bin/cilly" LD="bin/cilly"
+</PRE>
+ <TT>cilly</TT> can also behave as the Microsoft Visual C compiler, if the first
+ argument is <TT>--mode=MSVC</TT>:
+<PRE CLASS="verbatim">
+bin/cilly --mode=MSVC /D HAPPY_MOOD /I myincludes hello.c /Fe hello.exe
+</PRE>
+ (This in turn will pass a <TT>--MSVC</TT> flag to the underlying <TT>cilly.asm</TT>
+ process which will make it understand the Microsoft Visual C extensions)<BR>
+<BR>
+<TT>cilly</TT> can also behave as the archiver <TT>ar</TT>, if it is passed an
+argument <TT>--mode=AR</TT>. Note that only the <TT>cr</TT> mode is supported (create a
+new archive and replace all files in there). Therefore the previous version of
+the archive is lost. <BR>
+<BR>
+Furthermore, <TT>cilly</TT> allows you to pass some arguments on to the
+underlying <TT>cilly.asm</TT> process. As a general rule all arguments that start
+with <TT>--</TT> and that <TT>cilly</TT> itself does not process, are passed on. For
+example,
+<PRE CLASS="verbatim">
+bin/cilly --dologwrites -D HAPPY_MOOD -I myincludes hello.c -o hello.exe
+</PRE>
+ will produce a file <TT>hello.cil.c</TT> that prints all the memory addresses
+written by the application. <BR>
+<BR>
+The most powerful feature of <TT>cilly</TT> is that it can collect all the
+sources in your project, merge them into one file and then apply CIL. This
+makes it a breeze to do whole-program analysis and transformation. All you
+have to do is to pass the <TT>--merge</TT> flag to <TT>cilly</TT>:
+<PRE CLASS="verbatim">
+make CC="bin/cilly --save-temps --dologwrites --merge"
+</PRE>
+ You can even leave some files untouched:
+<PRE CLASS="verbatim">
+make CC="bin/cilly --save-temps --dologwrites --merge --leavealone=foo --leavealone=bar"
+</PRE>
+ This will merge all the files except those with the basename <TT>foo</TT> and
+<TT>bar</TT>. Those files will be compiled as usual and then linked in at the very
+end. <BR>
+<BR>
+The sequence of actions performed by <TT>cilly</TT> depends on whether merging
+is turned on or not:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+If merging is off
+ <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+ For every file <TT>file.c</TT> to compile
+ <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
+ Preprocess the file with the given arguments to
+ produce <TT>file.i</TT>
+ <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>file.cil.c</TT>
+ <LI CLASS="li-enumerate">Preprocess to <TT>file.cil.i</TT>
+ <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>file.cil.o</TT>
+ </OL>
+ <LI CLASS="li-enumerate">Link the resulting objects
+ </OL>
+<LI CLASS="li-itemize">If merging is on
+ <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+ For every file <TT>file.c</TT> to compile
+ <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
+ Preprocess the file with the given arguments to
+ produce <TT>file.i</TT>
+ <LI CLASS="li-enumerate">Save the preprocessed source as <TT>file.o</TT>
+ </OL>
+ <LI CLASS="li-enumerate">When linking executable <TT>hello.exe</TT>, look at every object
+ file that must be linked and see if it actually
+ contains preprocessed source. Pass all those files to a
+ special merging application (described in
+ Section&nbsp;<A HREF="#sec-merger">13</A>) to produce <TT>hello.exe_comb.c</TT>
+ <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>hello.exe_comb.cil.c</TT>
+ <LI CLASS="li-enumerate">Preprocess to <TT>hello.exe_comb.cil.i</TT>
+ <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>hello.exe_comb.cil.o</TT>
+ <LI CLASS="li-enumerate">Invoke the actual linker to produce <TT>hello.exe</TT>
+ </OL>
+</UL>
+Note that files that you specify with <TT>--leavealone</TT> are not merged and
+never presented to CIL. They are compiled as usual and then are linked in at
+the end. <BR>
+<BR>
+And a final feature of <TT>cilly</TT> is that it can substitute copies of the
+system's include files:
+<PRE CLASS="verbatim">
+make CC="bin/cilly --includedir=myinclude"
+</PRE>
+ This will force the preprocessor to use the file <TT>myinclude/xxx/stdio.h</TT>
+(if it exists) whenever it encounters <TT>#include &lt;stdio.h&gt;</TT>. The <TT>xxx</TT> is
+a string that identifies the compiler version you are using. This modified
+include files should be produced with the patcher script (see
+Section&nbsp;<A HREF="#sec-patcher">14</A>).<BR>
+<BR>
+<!--TOC subsection <TT>cilly</TT> Options-->
+
+<H3 CLASS="subsection"><A NAME="htoc15">7.1</A>&nbsp;&nbsp;<TT>cilly</TT> Options</H3><!--SEC END -->
+
+Among the options for the <TT>cilly</TT> you can put anything that can normally
+go in the command line of the compiler that <TT>cilly</TT> is impersonating.
+<TT>cilly</TT> will do its best to pass those options along to the appropriate
+subprocess. In addition, the following options are supported (a complete and
+up-to-date list can always be obtained by running <TT>cilly --help</TT>):
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>--mode=mode</TT> This must be the first argument if present. It makes
+<TT>cilly</TT> behave as a given compiled. The following modes are recognized:
+ <UL CLASS="itemize"><LI CLASS="li-itemize">
+ GNUCC - the GNU C Compiler. This is the default.
+ <LI CLASS="li-itemize">MSVC - the Microsoft Visual C compiler. Of course, you should
+ pass only MSVC valid options in this case.
+ <LI CLASS="li-itemize">AR - the archiver <TT>ar</TT>. Only the mode <TT>cr</TT> is supported and
+ the original version of the archive is lost.
+ </UL>
+<LI CLASS="li-itemize"><TT>--help</TT> Prints a list of the options supported.
+<LI CLASS="li-itemize"><TT>--verbose</TT> Prints lots of messages about what is going on.
+<LI CLASS="li-itemize"><TT>--stages</TT> Less than <TT>--verbose</TT> but lets you see what <TT>cilly</TT>
+ is doing.
+<LI CLASS="li-itemize"><TT>--merge</TT> This tells <TT>cilly</TT> to first attempt to collect into one
+source file all of the sources that make your application, and then to apply
+<TT>cilly.asm</TT> on the resulting source. The sequence of actions in this case is
+described above and the merger itself is described in Section&nbsp;<A HREF="#sec-merger">13</A>.<BR>
+<BR>
+<LI CLASS="li-itemize"><TT>--leavealone=xxx</TT>. Do not merge and do not present to CIL the files
+whose basename is "xxx". These files are compiled as usual and linked in at
+the end.
+<LI CLASS="li-itemize"><TT>--includedir=xxx</TT>. Override the include files with those in the given
+directory. The given directory is the same name that was given an an argument
+to the patcher (see Section&nbsp;<A HREF="#sec-patcher">14</A>). In particular this means that
+that directory contains subdirectories named based on the current compiler
+version. The patcher creates those directories.
+<LI CLASS="li-itemize"><TT>--usecabs</TT>. Do not CIL, but instead just parse the source and print
+its AST out. This should looked like the preprocessed file. This is useful
+when you suspect that the conversion to CIL phase changes the meaning of the
+program.
+<LI CLASS="li-itemize"><TT>--save-temps=xxx</TT>. Temporary files are preserved in the xxx
+ directory. For example, the output of CIL will be put in a file
+ named <TT>*.cil.c</TT>.
+<LI CLASS="li-itemize"><TT>--save-temps</TT>. Temporay files are preserved in the current directory.
+</UL>
+<!--TOC subsection <TT>cilly.asm</TT> Options-->
+
+<H3 CLASS="subsection"><A NAME="htoc16">7.2</A>&nbsp;&nbsp;<TT>cilly.asm</TT> Options</H3><!--SEC END -->
+
+ <A NAME="sec-cilly-asm-options"></A>
+All of the options that start with <TT>--</TT> and are not understood by
+<TT>cilly</TT> are passed on to <TT>cilly.asm</TT>. <TT>cilly</TT> also passes along to
+<TT>cilly.asm</TT> flags such as <TT>--MSVC</TT> that both need to know
+about. The following options are supported:<BR>
+<BR>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <B>General Options:</B>
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+ <TT>--version</TT> output version information and exit
+ <LI CLASS="li-itemize"><TT>--verbose</TT> Print lots of random stuff. This is passed on from cilly
+ <LI CLASS="li-itemize"><TT>--warnall</TT> Show all warnings.
+ <LI CLASS="li-itemize"><TT>--debug=xxx</TT> turns on debugging flag xxx
+ <LI CLASS="li-itemize"><TT>--nodebug=xxx</TT> turns off debugging flag xxx
+ <LI CLASS="li-itemize"><TT>--flush</TT> Flush the output streams often (aids debugging).
+ <LI CLASS="li-itemize"><TT>--check</TT> Run a consistency check over the CIL after every operation.
+ <LI CLASS="li-itemize"><TT>--nocheck</TT> turns off consistency checking of CIL.
+ <LI CLASS="li-itemize"><TT>--noPrintLn</TT> Don't output #line directives in the output.
+ <LI CLASS="li-itemize"><TT>--commPrintLn</TT> Print #line directives in the output, but
+ put them in comments.
+ <LI CLASS="li-itemize"><TT>--log=xxx</TT> Set the name of the log file. By default stderr is used
+ <LI CLASS="li-itemize"><TT>--MSVC</TT> Enable MSVC compatibility. Default is GNU.
+ <LI CLASS="li-itemize"><TT>--ignore-merge-conflicts</TT> ignore merging conflicts.
+ <LI CLASS="li-itemize"><TT>--extrafiles=filename</TT>: the name of a file that contains
+ a list of additional files to process, separated by whitespace.
+ <LI CLASS="li-itemize"><TT>--stats</TT> Print statistics about the running time of the
+ parser, conversion to CIL, etc. Also prints memory-usage
+ statistics. You can time parts of your own code as well. Calling
+ (<TT>Stats.time &#8220;label&#8221; func arg</TT>) will evaluate <TT>(func arg)</TT>
+ and remember how long this takes. If you call <TT>Stats.time</TT>
+ repeatedly with the same label, CIL will report the aggregate
+ time.<BR>
+<BR>
+If available, CIL uses the x86 performance counters for these
+ stats. This is very precise, but results in &#8220;wall-clock time.&#8221;
+ To report only user-mode time, find the call to <TT>Stats.reset</TT> in
+ <TT>main.ml</TT>, and change it to <TT>Stats.reset false</TT>.<BR>
+<BR>
+<B>Lowering Options</B>
+ <LI CLASS="li-itemize"><TT>--noLowerConstants</TT> do not lower constant expressions.
+ <LI CLASS="li-itemize"><TT>--noInsertImplicitCasts</TT> do not insert implicit casts.
+ <LI CLASS="li-itemize"><TT>--forceRLArgEval</TT> Forces right to left evaluation of function arguments.
+ <LI CLASS="li-itemize"><TT>--disallowDuplication</TT> Prevent small chunks of code from being duplicated.
+ <LI CLASS="li-itemize"><TT>--keepunused</TT> Do not remove the unused variables and types.
+ <LI CLASS="li-itemize"><TT>--rmUnusedInlines</TT> Delete any unused inline functions. This is the default in MSVC mode.<BR>
+<BR>
+<B>Output Options:</B>
+ <LI CLASS="li-itemize"><TT>--printCilAsIs</TT> Do not try to simplify the CIL when
+ printing. Without this flag, CIL will attempt to produce prettier
+ output by e.g. changing <TT>while(1)</TT> into more meaningful loops.
+ <LI CLASS="li-itemize"><TT>--noWrap</TT> do not wrap long lines when printing
+ <LI CLASS="li-itemize"><TT>--out=xxx</TT> the name of the output CIL file. <TT>cilly</TT>
+ sets this for you.
+ <LI CLASS="li-itemize"><TT>--mergedout=xxx</TT> specify the name of the merged file
+ <LI CLASS="li-itemize"><TT>--cabsonly=xxx</TT> CABS output file name
+<BR>
+<BR>
+ <B>Selected features.</B> See Section&nbsp;<A HREF="#sec-Extension">8</A> for more information.
+<LI CLASS="li-itemize"><TT>--dologcalls</TT>. Insert code in the processed source to print the name of
+functions as are called. Implemented in <TT>src/ext/logcalls.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dologwrites</TT>. Insert code in the processed source to print the
+address of all memory writes. Implemented in <TT>src/ext/logwrites.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dooneRet</TT>. Make each function have at most one 'return'.
+Implemented in <TT>src/ext/oneret.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dostackGuard</TT>. Instrument function calls and returns to
+maintain a separate stack for return addresses. Implemeted in
+<TT>src/ext/heapify.ml</TT>.
+<LI CLASS="li-itemize"><TT>--domakeCFG</TT>. Make the program look more like a CFG. Implemented
+in <TT>src/cil.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dopartial</TT>. Do interprocedural partial evaluation and
+constant folding. Implemented in <TT>src/ext/partial.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dosimpleMem</TT>. Simplify all memory expressions. Implemented in
+<TT>src/ext/simplemem.ml</TT>. <BR>
+<BR>
+For an up-to-date list of available options, run <TT>cilly.asm --help</TT>. </UL>
+<!--TOC section Library of CIL Modules-->
+
+<H2 CLASS="section"><A NAME="htoc17">8</A>&nbsp;&nbsp;Library of CIL Modules</H2><!--SEC END -->
+ <A NAME="sec-Extension"></A><!--NAME ext.html-->
+<BR>
+<BR>
+We are developing a suite of modules that use CIL for program analyses and
+transformations that we have found useful. You can use these modules directly
+on your code, or generally as inspiration for writing similar modules. A
+particularly big and complex application written on top of CIL is CCured
+(<A HREF="../ccured/index.html"><TT>../ccured/index.html</TT></A>).<BR>
+<BR>
+<!--TOC subsection Control-Flow Graphs-->
+
+<H3 CLASS="subsection"><A NAME="htoc18">8.1</A>&nbsp;&nbsp;Control-Flow Graphs</H3><!--SEC END -->
+ <A NAME="sec-cfg"></A>
+The <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> datatype includes fields for intraprocedural
+control-flow information: the predecessor and successor statements of
+the current statement. This information is not computed by default.
+If you want to use the control-flow graph, or any of the extensions in
+this section that require it, you have to explicitly ask CIL to
+compute the CFG.<BR>
+<BR>
+<!--TOC subsubsection The CFG module (new in CIL 1.3.5)-->
+
+<H4 CLASS="subsubsection"><A NAME="htoc19">8.1.1</A>&nbsp;&nbsp;The CFG module (new in CIL 1.3.5)</H4><!--SEC END -->
+
+The best way to compute the CFG is with the CFG module. Just invoke
+<A HREF="api/Cfg.html#VALcomputeFileCFG">Cfg.computeFileCFG</A> on your file. The <A HREF="api/Cfg.html">Cfg</A> API
+describes the rest of actions you can take with this module, including
+computing the CFG for one function at a time, or printing the CFG in
+<TT>dot</TT> form.<BR>
+<BR>
+<!--TOC subsubsection Simplified control flow-->
+
+<H4 CLASS="subsubsection"><A NAME="htoc20">8.1.2</A>&nbsp;&nbsp;Simplified control flow</H4><!--SEC END -->
+
+CIL can reduce high-level C control-flow constructs like <TT>switch</TT> and
+<TT>continue</TT> to lower-level <TT>goto</TT>s. This completely eliminates some
+possible classes of statements from the program and may make the result
+easier to analyze (e.g., it simplifies data-flow analysis).<BR>
+<BR>
+You can invoke this transformation on the command line with
+<TT>--domakeCFG</TT> or programatically with <A HREF="api/Cil.html#VALprepareCFG">Cil.prepareCFG</A>.
+After calling Cil.prepareCFG, you can use <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>
+to compute the CFG information and find the successor and predecessor
+of each statement.<BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --domakeCFG</TT>
+transforms the following code (note the fall-through in case 1):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo (int predicate) {
+ int x = 0;
+ switch (predicate) {
+ case 0: return 111;
+ case 1: x = x + 1;
+ case 2: return (x+3);
+ case 3: break;
+ default: return 222;
+ }
+ return 333;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex23.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection Data flow analysis framework-->
+
+<H3 CLASS="subsection"><A NAME="htoc21">8.2</A>&nbsp;&nbsp;Data flow analysis framework</H3><!--SEC END -->
+
+The <A HREF="api/Dataflow.html">Dataflow</A> module (click for the ocamldoc) contains a
+parameterized framework for forward and backward data flow
+analyses. You provide the transfer functions and this module does the
+analysis. You must compute control-flow information (Section&nbsp;<A HREF="#sec-cfg">8.1</A>)
+before invoking the Dataflow module.<BR>
+<BR>
+<!--TOC subsection Dominators-->
+
+<H3 CLASS="subsection"><A NAME="htoc22">8.3</A>&nbsp;&nbsp;Dominators</H3><!--SEC END -->
+
+The module <A HREF="api/Dominators.html">Dominators</A> contains the computation of immediate
+ dominators. It uses the <A HREF="api/Dataflow.html">Dataflow</A> module. <BR>
+<BR>
+<!--TOC subsection Points-to Analysis-->
+
+<H3 CLASS="subsection"><A NAME="htoc23">8.4</A>&nbsp;&nbsp;Points-to Analysis</H3><!--SEC END -->
+
+The module <TT>ptranal.ml</TT> contains two interprocedural points-to
+analyses for CIL: <TT>Olf</TT> and <TT>Golf</TT>. <TT>Olf</TT> is the default.
+(Switching from <TT>olf.ml</TT> to <TT>golf.ml</TT> requires a change in
+<TT>Ptranal</TT> and a recompiling <TT>cilly</TT>.)<BR>
+<BR>
+The analyses have the following characteristics:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+Not based on C types (inferred pointer relationships are sound
+ despite most kinds of C casts)
+<LI CLASS="li-itemize">One level of subtyping
+<LI CLASS="li-itemize">One level of context sensitivity (Golf only)
+<LI CLASS="li-itemize">Monomorphic type structures
+<LI CLASS="li-itemize">Field insensitive (fields of structs are conflated)
+<LI CLASS="li-itemize">Demand-driven (points-to queries are solved on demand)
+<LI CLASS="li-itemize">Handle function pointers
+</UL>
+The analysis itself is factored into two components: <TT>Ptranal</TT>,
+which walks over the CIL file and generates constraints, and <TT>Olf</TT>
+or <TT>Golf</TT>, which solve the constraints. The analysis is invoked
+with the function <TT>Ptranal.analyze_file: Cil.file -&gt;
+ unit</TT>. This function builds the points-to graph for the CIL file
+and stores it internally. There is currently no facility for clearing
+internal state, so <TT>Ptranal.analyze_file</TT> should only be called
+once.<BR>
+<BR>
+The constructed points-to graph supports several kinds of queries,
+including alias queries (may two expressions be aliased?) and
+points-to queries (to what set of locations may an expression point?).<BR>
+<BR>
+The main interface with the alias analysis is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>Ptranal.may_alias: Cil.exp -&gt; Cil.exp -&gt; bool</TT>. If
+ <TT>true</TT>, the two expressions may have the same value.
+<LI CLASS="li-itemize"><TT>Ptranal.resolve_lval: Cil.lval -&gt; (Cil.varinfo
+ list)</TT>. Returns the list of variables to which the given
+ left-hand value may point.
+<LI CLASS="li-itemize"><TT>Ptranal.resolve_exp: Cil.exp -&gt; (Cil.varinfo list)</TT>.
+ Returns the list of variables to which the given expression may
+ point.
+<LI CLASS="li-itemize"><TT>Ptranal.resolve_funptr: Cil.exp -&gt; (Cil.fundec
+ list)</TT>. Returns the list of functions to which the given
+ expression may point.
+</UL>
+The precision of the analysis can be customized by changing the values
+of several flags:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>Ptranal.no_sub: bool ref</TT>.
+ If <TT>true</TT>, subtyping is disabled. Associated commandline option:
+ <B>--ptr_unify</B>.
+<LI CLASS="li-itemize"><TT>Ptranal.analyze_mono: bool ref</TT>.
+ (Golf only) If <TT>true</TT>, context sensitivity is disabled and the
+ analysis is effectively monomorphic. Commandline option:
+ <B>--ptr_mono</B>.
+<LI CLASS="li-itemize"><TT>Ptranal.smart_aliases: bool ref</TT>.
+ (Golf only) If <TT>true</TT>, &#8220;smart&#8221; disambiguation of aliases is
+ enabled. Otherwise, aliases are computed by intersecting points-to
+ sets. This is an experimental feature.
+<LI CLASS="li-itemize"><TT>Ptranal.model_strings: bool ref</TT>.
+ Make the alias analysis model string constants by treating them as
+ pointers to chars. Commandline option: <B>--ptr_model_strings</B>
+<LI CLASS="li-itemize"><TT>Ptranal.conservative_undefineds: bool ref</TT>.
+ Make the most pessimistic assumptions about globals if an undefined
+ function is present. Such a function can write to every global
+ variable. Commandline option: <B>--ptr_conservative</B>
+</UL>
+In practice, the best precision/efficiency tradeoff is achieved by
+setting <TT>Ptranal.no_sub</TT> to <TT>false</TT>, <TT>Ptranal.analyze_mono</TT> to
+<TT>true</TT>, and <TT>Ptranal.smart_aliases</TT> to <TT>false</TT>. These are the
+default values of the flags.<BR>
+<BR>
+There are also a few flags that can be used to inspect or serialize
+the results of the analysis.
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>Ptranal.debug_may_aliases</TT>.
+ Print the may-alias relationship of each pair of expressions in the
+ program. Commandline option: <B>--ptr_may_aliases</B>.
+<LI CLASS="li-itemize"><TT>Ptranal.print_constraints: bool ref</TT>.
+ If <TT>true</TT>, the analysis will print each constraint as it is
+ generated.
+<LI CLASS="li-itemize"><TT>Ptranal.print_types: bool ref</TT>.
+ If <TT>true</TT>, the analysis will print the inferred type of each
+ variable in the program.<BR>
+<BR>
+If <TT>Ptranal.analyze_mono</TT> and <TT>Ptranal.no_sub</TT> are both
+ <TT>true</TT>, this output is sufficient to reconstruct the points-to
+ graph. One nice feature is that there is a pretty printer for
+ recursive types, so the print routine does not loop.
+<LI CLASS="li-itemize"><TT>Ptranal.compute_results: bool ref</TT>.
+ If <TT>true</TT>, the analysis will print out the points-to set of each
+ variable in the program. This will essentially serialize the
+ points-to graph.
+</UL>
+<!--TOC subsection StackGuard-->
+
+<H3 CLASS="subsection"><A NAME="htoc24">8.5</A>&nbsp;&nbsp;StackGuard</H3><!--SEC END -->
+
+The module <TT>heapify.ml</TT> contains a transformation similar to the one
+described in &#8220;StackGuard: Automatic Adaptive Detection and Prevention of
+Buffer-Overflow Attacks&#8221;, <EM>Proceedings of the 7th USENIX Security
+Conference</EM>. In essence it modifies the program to maintain a separate
+stack for return addresses. Even if a buffer overrun attack occurs the
+actual correct return address will be taken from the special stack. <BR>
+<BR>
+Although it does work, this CIL module is provided mainly as an example of
+how to perform a simple source-to-source program analysis and
+transformation. As an optimization only functions that contain a dangerous
+local array make use of the special return address stack. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dostackGuard</TT>
+transforms the following dangerous code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int dangerous() {
+ char array[10];
+ scanf("%s",array); // possible buffer overrun!
+ }
+
+ int main () {
+ return dangerous();
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex24.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection Heapify-->
+
+<H3 CLASS="subsection"><A NAME="htoc25">8.6</A>&nbsp;&nbsp;Heapify</H3><!--SEC END -->
+
+The module <TT>heapify.ml</TT> also contains a transformation that moves all
+dangerous local arrays to the heap. This also prevents a number of buffer
+overruns. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --doheapify</TT>
+transforms the following dangerous code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int dangerous() {
+ char array[10];
+ scanf("%s",array); // possible buffer overrun!
+ }
+
+ int main () {
+ return dangerous();
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex25.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection One Return-->
+
+<H3 CLASS="subsection"><A NAME="htoc26">8.7</A>&nbsp;&nbsp;One Return</H3><!--SEC END -->
+
+The module <TT>oneret.ml</TT> contains a transformation the ensures that all
+function bodies have at most one return statement. This simplifies a number
+of analyses by providing a canonical exit-point. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dooneRet</TT>
+transforms the following code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo (int predicate) {
+ if (predicate &lt;= 0) {
+ return 1;
+ } else {
+ if (predicate &gt; 5)
+ return 2;
+ return 3;
+ }
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex26.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection Partial Evaluation and Constant Folding-->
+
+<H3 CLASS="subsection"><A NAME="htoc27">8.8</A>&nbsp;&nbsp;Partial Evaluation and Constant Folding</H3><!--SEC END -->
+
+The <TT>partial.ml</TT> module provides a simple interprocedural partial
+evaluation and constant folding data-flow analysis and transformation. This
+transformation requires the <TT>--domakeCFG</TT> option. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --domakeCFG --dopartial</TT>
+transforms the following code (note the eliminated <TT>if</TT> branch and the
+partial optimization of <TT>foo</TT>):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo(int x, int y) {
+ int unknown;
+ if (unknown)
+ return y+2;
+ return x+3;
+ }
+
+ int main () {
+ int a,b,c;
+ a = foo(5,7) + foo(6,7);
+ b = 4;
+ c = b * b;
+ if (b &gt; c)
+ return b-c;
+ else
+ return b+c;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex27.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection Reaching Definitions-->
+
+<H3 CLASS="subsection"><A NAME="htoc28">8.9</A>&nbsp;&nbsp;Reaching Definitions</H3><!--SEC END -->
+
+The <TT>reachingdefs.ml</TT> module uses the dataflow framework and CFG
+information to calculate the definitions that reach each
+statement. After computing the CFG (Section&nbsp;<A HREF="#sec-cfg">8.1</A>) and calling
+<TT>computeRDs</TT> on a
+function declaration, <TT>ReachingDef.stmtStartData</TT> will contain a
+mapping from statement IDs to data about which definitions reach each
+statement. In particular, it is a mapping from statement IDs to a
+triple the first two members of which are used internally. The third
+member is a mapping from variable IDs to Sets of integer options. If
+the set contains <TT>Some(i)</TT>, then the definition of that variable
+with ID <TT>i</TT> reaches that statement. If the set contains <TT>None</TT>,
+then there is a path to that statement on which there is no definition
+of that variable. Also, if the variable ID is unmapped at a
+statement, then no definition of that variable reaches that statement.<BR>
+<BR>
+To summarize, reachingdefs.ml has the following interface:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>computeRDs</TT> &ndash; Computes reaching definitions. Requires that
+CFG information has already been computed for each statement.
+<LI CLASS="li-itemize"><TT>ReachingDef.stmtStartData</TT> &ndash; contains reaching
+definition data after <TT>computeRDs</TT> is called.
+<LI CLASS="li-itemize"><TT>ReachingDef.defIdStmtHash</TT> &ndash; Contains a mapping
+from definition IDs to the ID of the statement in which
+the definition occurs.
+<LI CLASS="li-itemize"><TT>getRDs</TT> &ndash; Takes a statement ID and returns
+reaching definition data for that statement.
+<LI CLASS="li-itemize"><TT>instrRDs</TT> &ndash; Takes a list of instructions and the
+definitions that reach the first instruction, and for
+each instruction calculates the definitions that reach
+either into or out of that instruction.
+<LI CLASS="li-itemize"><TT>rdVisitorClass</TT> &ndash; A subclass of nopCilVisitor that
+can be extended such that the current reaching definition
+data is available when expressions are visited through
+the <TT>get_cur_iosh</TT> method of the class.
+</UL>
+<!--TOC subsection Available Expressions-->
+
+<H3 CLASS="subsection"><A NAME="htoc29">8.10</A>&nbsp;&nbsp;Available Expressions</H3><!--SEC END -->
+
+The <TT>availexps.ml</TT> module uses the dataflow framework and CFG
+information to calculate something similar to a traditional available
+expressions analysis. After <TT>computeAEs</TT> is called following a CFG
+calculation (Section&nbsp;<A HREF="#sec-cfg">8.1</A>), <TT>AvailableExps.stmtStartData</TT> will
+contain a mapping
+from statement IDs to data about what expressions are available at
+that statement. The data for each statement is a mapping for each
+variable ID to the whole expression available at that point(in the
+traditional sense) which the variable was last defined to be. So,
+this differs from a traditional available expressions analysis in that
+only whole expressions from a variable definition are considered rather
+than all expressions.<BR>
+<BR>
+The interface is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>computeAEs</TT> &ndash; Computes available expressions. Requires
+that CFG information has already been comptued for each statement.
+<LI CLASS="li-itemize"><TT>AvailableExps.stmtStartData</TT> &ndash; Contains available
+expressions data for each statement after <TT>computeAEs</TT> has been
+called.
+<LI CLASS="li-itemize"><TT>getAEs</TT> &ndash; Takes a statement ID and returns
+available expression data for that statement.
+<LI CLASS="li-itemize"><TT>instrAEs</TT> &ndash; Takes a list of instructions and
+the availalbe expressions at the first instruction, and
+for each instruction calculates the expressions available
+on entering or exiting each instruction.
+<LI CLASS="li-itemize"><TT>aeVisitorClass</TT> &ndash; A subclass of nopCilVisitor that
+can be extended such that the current available expressions
+data is available when expressions are visited through the
+<TT>get_cur_eh</TT> method of the class.
+</UL>
+<!--TOC subsection Liveness Analysis-->
+
+<H3 CLASS="subsection"><A NAME="htoc30">8.11</A>&nbsp;&nbsp;Liveness Analysis</H3><!--SEC END -->
+
+The <TT>liveness.ml</TT> module uses the dataflow framework and
+CFG information to calculate which variables are live at
+each program point. After <TT>computeLiveness</TT> is called
+following a CFG calculation (Section&nbsp;<A HREF="#sec-cfg">8.1</A>), <TT>LiveFlow.stmtStartData</TT> will
+contain a mapping for each statement ID to a set of <TT>varinfo</TT>s
+for varialbes live at that program point.<BR>
+<BR>
+The interface is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>computeLiveness</TT> &ndash; Computes live variables. Requires
+that CFG information has already been computed for each statement.
+<LI CLASS="li-itemize"><TT>LiveFlow.stmtStartData</TT> &ndash; Contains live variable data
+for each statement after <TT>computeLiveness</TT> has been called.
+</UL>
+Also included in this module is a command line interface that
+will cause liveness data to be printed to standard out for
+a particular function or label.
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>&ndash;doliveness</TT> &ndash; Instructs cilly to comptue liveness
+information and to print on standard out the variables live
+at the points specified by <TT>&ndash;live_func</TT> and <TT>live_label</TT>.
+If both are ommitted, then nothing is printed.
+<LI CLASS="li-itemize"><TT>&ndash;live_func</TT> &ndash; The name of the function whose
+liveness data is of interest. If <TT>&ndash;live_label</TT> is ommitted,
+then data for each statement is printed.
+<LI CLASS="li-itemize"><TT>&ndash;live_label</TT> &ndash; The name of the label at which
+the liveness data will be printed.
+</UL>
+<!--TOC subsection Dead Code Elimination-->
+
+<H3 CLASS="subsection"><A NAME="htoc31">8.12</A>&nbsp;&nbsp;Dead Code Elimination</H3><!--SEC END -->
+
+The module <TT>deadcodeelim.ml</TT> uses the reaching definitions
+analysis to eliminate assignment instructions whose results
+are not used. The interface is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>elim_dead_code</TT> &ndash; Performs dead code elimination
+on a function. Requires that CFG information has already
+been computed (Section&nbsp;<A HREF="#sec-cfg">8.1</A>).
+<LI CLASS="li-itemize"><TT>dce</TT> &ndash; Performs dead code elimination on an
+entire file. Requires that CFG information has already
+been computed.
+</UL>
+<!--TOC subsection Simple Memory Operations-->
+
+<H3 CLASS="subsection"><A NAME="htoc32">8.13</A>&nbsp;&nbsp;Simple Memory Operations</H3><!--SEC END -->
+
+The <TT>simplemem.ml</TT> module allows CIL lvalues that contain memory
+accesses to be even futher simplified via the introduction of
+well-typed temporaries. After this transformation all lvalues involve
+at most one memory reference.<BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dosimpleMem</TT>
+transforms the following code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int main () {
+ int ***three;
+ int **two;
+ ***three = **two;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex28.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection Simple Three-Address Code-->
+
+<H3 CLASS="subsection"><A NAME="htoc33">8.14</A>&nbsp;&nbsp;Simple Three-Address Code</H3><!--SEC END -->
+
+The <TT>simplify.ml</TT> module further reduces the complexity of program
+expressions and gives you a form of three-address code. After this
+transformation all expressions will adhere to the following grammar:
+<PRE CLASS="verbatim">
+ basic::=
+ Const _
+ Addrof(Var v, NoOffset)
+ StartOf(Var v, NoOffset)
+ Lval(Var v, off), where v is a variable whose address is not taken
+ and off contains only "basic"
+
+ exp::=
+ basic
+ Lval(Mem basic, NoOffset)
+ BinOp(bop, basic, basic)
+ UnOp(uop, basic)
+ CastE(t, basic)
+
+ lval ::=
+ Mem basic, NoOffset
+ Var v, off, where v is a variable whose address is not taken and off
+ contains only "basic"
+</PRE>In addition, all <TT>sizeof</TT> and <TT>alignof</TT> forms are turned into
+constants. Accesses to arrays and variables whose address is taken are
+turned into "Mem" accesses. All field and index computations are turned
+into address arithmetic.<BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dosimplify</TT>
+transforms the following code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int main() {
+ struct mystruct {
+ int a;
+ int b;
+ } m;
+ int local;
+ int arr[3];
+ int *ptr;
+
+ ptr = &amp;local;
+ m.a = local + sizeof(m) + arr[2];
+ return m.a;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex29.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<!--TOC subsection Converting C to C++-->
+
+<H3 CLASS="subsection"><A NAME="htoc34">8.15</A>&nbsp;&nbsp;Converting C to C++</H3><!--SEC END -->
+
+The module canonicalize.ml performs several transformations to correct
+differences between C and C++, so that the output is (hopefully) valid
+C++ code. This may be incomplete &mdash; certain fixes which are necessary
+for some programs are not yet implemented.<BR>
+<BR>
+Using the <TT>--doCanonicalize</TT> option with CIL will perform the
+following changes to your program:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Any variables that use C++ keywords as identifiers are renamed.
+<LI CLASS="li-enumerate">C allows global variables to have multiple declarations and
+ multiple (equivalent) definitions. This transformation removes
+ all but one declaration and all but one definition.
+<LI CLASS="li-enumerate"><TT>__inline</TT> is #defined to <TT>inline</TT>, and <TT>__restrict</TT>
+ is #defined to nothing.
+<LI CLASS="li-enumerate">C allows function pointers with no specified arguments to be used on
+ any argument list. To make C++ accept this code, we insert a cast
+ from the function pointer to a type that matches the arguments. Of
+ course, this does nothing to guarantee that the pointer actually has
+ that type.
+<LI CLASS="li-enumerate">Makes casts from int to enum types explicit. (CIL changes enum
+ constants to int constants, but doesn't use a cast.)
+</OL>
+<!--TOC section Controlling CIL-->
+
+<H2 CLASS="section"><A NAME="htoc35">9</A>&nbsp;&nbsp;Controlling CIL</H2><!--SEC END -->
+
+In the process of converting a C file to CIL we drop the unused prototypes
+and even inline function definitions. This results in much smaller files. If
+you do not want this behavior then you must pass the <TT>--keepunused</TT> argument
+to the CIL application. <BR>
+<BR>
+Alternatively you can put the following pragma in the code (instructing CIL
+to specifically keep the declarations and definitions of the function
+<TT>func1</TT> and variable <TT>var2</TT>, the definition of type <TT>foo</TT> and of
+structure <TT>bar</TT>):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+#pragma cilnoremove("func1", "var2", "type foo", "struct bar")
+</FONT></PRE>
+<!--TOC section GCC Extensions-->
+
+<H2 CLASS="section"><A NAME="htoc36">10</A>&nbsp;&nbsp;GCC Extensions</H2><!--SEC END -->
+
+The CIL parser handles most of the <TT>gcc</TT>
+<A HREF="javascript:loadTop('http://gcc.gnu.org/onlinedocs/gcc-3.0.2/gcc_5.html#SEC67')">extensions</A>
+and compiles them to CIL. The following extensions are not handled (note that
+we are able to compile a large number of programs, including the Linux kernel,
+without encountering these):
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Nested function definitions.
+<LI CLASS="li-enumerate">Constructing function calls.
+<LI CLASS="li-enumerate">Naming an expression's type.
+<LI CLASS="li-enumerate">Complex numbers
+<LI CLASS="li-enumerate">Hex floats
+<LI CLASS="li-enumerate">Subscripts on non-lvalue arrays.
+<LI CLASS="li-enumerate">Forward function parameter declarations
+</OL>
+The following extensions are handled, typically by compiling them away:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Attributes for functions, variables and types. In fact, we have a clear
+specification (see Section&nbsp;<A HREF="#sec-attrib">6.4</A>) of how attributes are interpreted. The
+specification extends that of <TT>gcc</TT>.
+<LI CLASS="li-enumerate">Old-style function definitions and prototypes. These are translated to
+new-style.
+<LI CLASS="li-enumerate">Locally-declared labels. As part of the translation to CIL, we generate
+new labels as needed.
+<LI CLASS="li-enumerate">Labels as values and computed goto. This allows a program to take the
+address of a label and to manipulate it as any value and also to perform a
+computed goto. We compile this by assigning each label whose address is taken
+a small integer that acts as its address. Every computed <TT>goto</TT> in the body
+of the function is replaced with a <TT>switch</TT> statement. If you want to invoke
+the label from another function, you are on your own (the <TT>gcc</TT>
+documentation says the same.)
+<LI CLASS="li-enumerate">Generalized lvalues. You can write code like <TT>(a, b) += 5</TT> and it gets
+translated to CIL.
+<LI CLASS="li-enumerate">Conditionals with omitted operands. Things like <TT>x ? : y</TT> are
+translated to CIL.
+<LI CLASS="li-enumerate">Double word integers. The type <TT>long long</TT> and the <TT>LL</TT> suffix on
+constants is understood. This is currently interpreted as 64-bit integers.
+<LI CLASS="li-enumerate">Local arrays of variable length. These are converted to uses of
+<TT>alloca</TT>, the array variable is replaced with a pointer to the allocated
+array and the instances of <TT>sizeof(a)</TT> are adjusted to return the size of
+the array and not the size of the pointer.
+<LI CLASS="li-enumerate">Non-constant local initializers. Like all local initializers these are
+compiled into assignments.
+<LI CLASS="li-enumerate">Compound literals. These are also turned into assignments.
+<LI CLASS="li-enumerate">Designated initializers. The CIL parser actually supports the full ISO
+syntax for initializers, which is more than both <TT>gcc</TT> and <TT>MSVC</TT>. I
+(George) think that this is the most complicated part of the C language and
+whoever designed it should be banned from ever designing languages again.
+<LI CLASS="li-enumerate">Case ranges. These are compiled into separate cases. There is no code
+duplication, just a larger number of <TT>case</TT> statements.
+<LI CLASS="li-enumerate">Transparent unions. This is a strange feature that allows you to define
+a function whose formal argument has a (tranparent) union type, but the
+argument is called as if it were the first element of the union. This is
+compiled away by saying that the type of the formal argument is that of the
+first field, and the first thing in the function body we copy the formal into
+a union. <BR>
+<BR>
+<LI CLASS="li-enumerate">Inline assembly-language. The full syntax is supported and it is carried
+as such in CIL.<BR>
+<BR>
+<LI CLASS="li-enumerate">Function names as strings. The identifiers <TT>__FUNCTION__</TT> and
+<TT>__PRETTY_FUNCTION__</TT> are replaced with string literals. <BR>
+<BR>
+<LI CLASS="li-enumerate">Keywords <TT>typeof</TT>, <TT>alignof</TT>, <TT>inline</TT> are supported.
+</OL>
+<!--TOC section CIL Limitations-->
+
+<H2 CLASS="section"><A NAME="htoc37">11</A>&nbsp;&nbsp;CIL Limitations</H2><!--SEC END -->
+
+There are several implementation details of CIL that might make it unusable
+ or less than ideal for certain tasks:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+CIL operates after preprocessing. If you need to see comments, for
+example, you cannot use CIL. But you can use attributes and pragmas instead.
+And there is some support to help you patch the include files before they are
+seen by the preprocessor. For example, this is how we turn some
+<TT>#define</TT>s that we don't like into function calls. <BR>
+<BR>
+<LI CLASS="li-itemize">CIL does transform the code in a non-trivial way. This is done in order
+to make most analyses easier. But if you want to see the code <TT>e1, e2++</TT>
+exactly as it appears in the code, then you should not use CIL. <BR>
+<BR>
+<LI CLASS="li-itemize">CIL removes all local scopes and moves all variables to function
+scope. It also separates a declaration with an initializer into a declaration
+plus an assignment. The unfortunate effect of this transformation is that
+local variables cannot have the <TT>const</TT> qualifier.</UL>
+<!--TOC section Known Bugs and Limitations-->
+
+<H2 CLASS="section"><A NAME="htoc38">12</A>&nbsp;&nbsp;Known Bugs and Limitations</H2><!--SEC END -->
+
+<UL CLASS="itemize"><LI CLASS="li-itemize">In the new versions of <TT>glibc</TT> there is a function
+ <TT>__builtin_va_arg</TT> that takes a type as its second argument. CIL
+ handles that through a slight trick. As it parses the function it changes a
+ call like:
+<PRE CLASS="verbatim">
+ mytype x = __builtin_va_arg(marker, mytype)
+</PRE>into
+<PRE CLASS="verbatim">
+ mytype x;
+ __builtin_va_arg(marker, sizeof(mytype), &amp;x);
+</PRE>
+ The latter form is used internally in CIL. However, the CIL pretty printer
+ will try to emit the original code. <BR>
+<BR>
+Similarly, <TT>__builtin_types_compatible_p(t1, t2)</TT>, which takes
+ types as arguments, is represented internally as
+ <TT>__builtin_types_compatible_p(sizeof t1, sizeof t2)</TT>, but the
+ sizeofs are removed when printing.<BR>
+<BR>
+<LI CLASS="li-itemize">The implementation of <TT>bitsSizeOf</TT> does not take into account the
+packing pragmas. However it was tested to be accurate on cygwin/gcc-2.95.3,
+Linux/gcc-2.95.3 and on Windows/MSVC.<BR>
+<BR>
+<LI CLASS="li-itemize">We do not support tri-graph sequences (ISO 5.2.1.1).<BR>
+<BR>
+<LI CLASS="li-itemize">GCC has a strange feature called &#8220;extern inline&#8221;. Such a function can
+be defined twice: first with the &#8220;extern inline&#8221; specifier and the second
+time without it. If optimizations are turned off then the &#8220;extern inline&#8221;
+definition is considered a prototype (its body is ignored). If optimizations
+are turned on then the extern inline function is inlined at all of its
+occurrences from the point of its definition all the way to the point where the
+(optional) second definition appears. No body is generated for an extern
+inline function. A body is generated for the real definition and that one is
+used in the rest of the file. <BR>
+<BR>
+CIL will rename your extern inline function (and its uses) with the suffix
+ <TT>__extinline</TT>. This means that if you have two such definition, that do
+ different things and the optimizations are not on, then the CIL version might
+ compute a different answer !<BR>
+<BR>
+Also, if you have multiple extern inline declarations then CIL will ignore
+but the first one. This is not so bad because GCC itself would not like it. <BR>
+<BR>
+<LI CLASS="li-itemize">There are still a number of bugs in handling some obscure features of
+GCC. For example, when you use variable-length arrays, CIL turns them into
+calls to <TT>alloca</TT>. This means that they are deallocated when the function
+returns and not when the local scope ends. <BR>
+<BR>
+Variable-length arrays are not supported as fields of a struct or union.<BR>
+<BR>
+<LI CLASS="li-itemize">CIL cannot parse arbitrary <TT>#pragma</TT> directives. Their
+ syntax must follow gcc's attribute syntax to be understood. If you
+ need a pragma that does not follow gcc syntax, add that pragma's name
+ to <TT>no_parse_pragma</TT> in <TT>src/frontc/clexer.mll</TT> to indicate that
+ CIL should treat that pragma as a monolithic string rather than try
+ to parse its arguments.<BR>
+<BR>
+CIL cannot parse a line containing an empty <TT>#pragma</TT>.<BR>
+<BR>
+<LI CLASS="li-itemize">CIL only parses <TT>#pragma</TT> directives at the "top level", this is,
+ outside of any enum, structure, union, or function definitions.<BR>
+<BR>
+If your compiler uses pragmas in places other than the top-level,
+ you may have to preprocess the sources in a special way (sed, perl,
+ etc.) to remove pragmas from these locations.<BR>
+<BR>
+<LI CLASS="li-itemize">CIL cannot parse the following code (fixing this problem would require
+extensive hacking of the LALR grammar):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int bar(int ()); // This prototype cannot be parsed
+int bar(int x()); // If you add a name to the function, it works
+int bar(int (*)()); // This also works (and it is more appropriate)
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-itemize">CIL also cannot parse certain K&amp;R old-style prototypes with missing
+return type:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+g(); // This cannot be parsed
+int g(); // This is Ok
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-itemize">CIL does not understand some obscure combinations of type specifiers
+(&#8220;signed&#8221; and &#8220;unsigned&#8221; applied to typedefs that themselves contain a
+sign specification; you could argue that this should not be allowed anyway):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+typedef signed char __s8;
+__s8 unsigned uchartest; // This is unsigned char for gcc
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-itemize">The statement <TT>x = 3 + x ++</TT> will perform the increment of <TT>x</TT>
+ before the assignment, while <TT>gcc</TT> delays the increment after the
+ assignment. It turned out that this behavior is much easier to implement
+ than gcc's one, and either way is correct (since the behavior is unspecified
+ in this case). Similarly, if you write <TT>x = x ++;</TT> then CIL will perform
+ the increment before the assignment, whereas GCC and MSVC will perform it
+ after the assignment.
+</UL>
+<!--TOC section Using the merger-->
+
+<H2 CLASS="section"><A NAME="htoc39">13</A>&nbsp;&nbsp;Using the merger</H2><!--SEC END -->
+<A NAME="sec-merger"></A><!--NAME merger.html-->
+<BR>
+<BR>
+There are many program analyses that are more effective when
+done on the whole program.<BR>
+<BR>
+The merger is a tool that combines all of the C source files in a project
+into a single C file. There are two tasks that a merger must perform:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Detect what are all the sources that make a project and with what
+compiler arguments they are compiled.<BR>
+<BR>
+<LI CLASS="li-enumerate">Merge all of the source files into a single file.
+</OL>
+For the first task the merger impersonates a compiler and a linker (both a
+GCC and a Microsoft Visual C mode are supported) and it expects to be invoked
+(from a build script or a Makefile) on all sources of the project. When
+invoked to compile a source the merger just preprocesses the source and saves
+the result using the name of the requested object file. By preprocessing at
+this time the merger is able to take into account variations in the command
+line arguments that affect preprocessing of different source files.<BR>
+<BR>
+When the merger is invoked to link a number of object files it collects the
+preprocessed sources that were stored with the names of the object files, and
+invokes the merger proper. Note that arguments that affect the compilation or
+linking must be the same for all source files.<BR>
+<BR>
+For the second task, the merger essentially concatenates the preprocessed
+sources with care to rename conflicting file-local declarations (we call this
+process alpha-conversion of a file). The merger also attempts to remove
+duplicate global declarations and definitions. Specifically the following
+actions are taken:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+File-scope names (<TT>static</TT> globals, names of types defined with
+<TT>typedef</TT>, and structure/union/enumeration tags) are given new names if they
+conflict with declarations from previously processed sources. The new name is
+formed by appending the suffix <TT>___n</TT>, where <TT>n</TT> is a unique integer
+identifier. Then the new names are applied to their occurrences in the file. <BR>
+<BR>
+<LI CLASS="li-itemize">Non-static declarations and definitions of globals are never renamed.
+But we try to remove duplicate ones. Equality of globals is detected by
+comparing the printed form of the global (ignoring the line number directives)
+after the body has been alpha-converted. This process is intended to remove
+those declarations (e.g. function prototypes) that originate from the same
+include file. Similarly, we try to eliminate duplicate definitions of
+<TT>inline</TT> functions, since these occasionally appear in include files.<BR>
+<BR>
+<LI CLASS="li-itemize">The types of all global declarations with the same name from all files
+are compared for type isomorphism. During this process, the merger detects all
+those isomorphisms between structures and type definitions that are <B>required</B> for the merged program to be legal. Such structure tags and
+typenames are coalesced and given the same name. <BR>
+<BR>
+<LI CLASS="li-itemize">Besides the structure tags and type names that are required to be
+isomorphic, the merger also tries to coalesce definitions of structures and
+types with the same name from different file. However, in this case the merger
+will not give an error if such definitions are not isomorphic; it will just
+use different names for them. <BR>
+<BR>
+<LI CLASS="li-itemize">In rare situations, it can happen that a file-local global in
+encountered first and it is not renamed, only to discover later when
+processing another file that there is an external symbol with the same name.
+In this case, a second pass is made over the merged file to rename the
+file-local symbol.
+</UL>
+Here is an example of using the merger:<BR>
+<BR>
+The contents of <TT>file1.c</TT> is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct foo; // Forward declaration
+extern struct foo *global;
+</FONT></PRE>
+The contents of <TT>file2.c</TT> is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct bar {
+ int x;
+ struct bar *next;
+};
+extern struct bar *global;
+struct foo {
+ int y;
+};
+extern struct foo another;
+void main() {
+}
+</FONT></PRE>
+There are several ways in which one might create an executable from these
+files:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<PRE CLASS="verbatim">
+gcc file1.c file2.c -o a.out
+</PRE><BR>
+<BR>
+<LI CLASS="li-itemize"><PRE CLASS="verbatim">
+gcc -c file1.c -o file1.o
+gcc -c file2.c -o file2.o
+ld file1.o file2.o -o a.out
+</PRE><BR>
+<BR>
+<LI CLASS="li-itemize"><PRE CLASS="verbatim">
+gcc -c file1.c -o file1.o
+gcc -c file2.c -o file2.o
+ar r libfile2.a file2.o
+gcc file1.o libfile2.a -o a.out
+</PRE><BR>
+<BR>
+<LI CLASS="li-itemize"><PRE CLASS="verbatim">
+gcc -c file1.c -o file1.o
+gcc -c file2.c -o file2.o
+ar r libfile2.a file2.o
+gcc file1.o -lfile2 -o a.out
+</PRE></UL>
+In each of the cases above you must replace all occurrences of <TT>gcc</TT> and
+<TT>ld</TT> with <TT>cilly --merge</TT>, and all occurrences of <TT>ar</TT> with <TT>cilly
+--merge --mode=AR</TT>. It is very important that the <TT>--merge</TT> flag be used
+throughout the build process. If you want to see the merged source file you
+must also pass the <TT>--keepmerged</TT> flag to the linking phase. <BR>
+<BR>
+The result of merging file1.c and file2.c is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+// from file1.c
+struct foo; // Forward declaration
+extern struct foo *global;
+
+// from file2.c
+struct foo {
+ int x;
+ struct foo *next;
+};
+struct foo___1 {
+ int y;
+};
+extern struct foo___1 another;
+</FONT></PRE>
+<!--TOC section Using the patcher-->
+
+<H2 CLASS="section"><A NAME="htoc40">14</A>&nbsp;&nbsp;Using the patcher</H2><!--SEC END -->
+<A NAME="sec-patcher"></A><!--NAME patcher.html-->
+<BR>
+<BR>
+Occasionally we have needed to modify slightly the standard include files.
+So, we developed a simple mechanism that allows us to create modified copies
+of the include files and use them instead of the standard ones. For this
+purpose we specify a patch file and we run a program caller Patcher which
+makes modified copies of include files and applies the patch.<BR>
+<BR>
+The patcher is invoked as follows:
+<PRE CLASS="verbatim">
+bin/patcher [options]
+
+Options:
+ --help Prints this help message
+ --verbose Prints a lot of information about what is being done
+ --mode=xxx What tool to emulate:
+ GNUCC - GNU CC
+ MSVC - MS VC cl compiler
+
+ --dest=xxx The destination directory. Will make one if it does not exist
+ --patch=xxx Patch file (can be specified multiple times)
+ --ppargs=xxx An argument to be passed to the preprocessor (can be specified
+ multiple times)
+
+ --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
+ --sfile=xxx A system-include file to be patched (treated as \#include &lt;xxx&gt;)
+
+ --clean Remove all files in the destination directory
+ --dumpversion Print the version name used for the current compiler
+
+ All of the other arguments are passed to the preprocessor. You should pass
+ enough arguments (e.g., include directories) so that the patcher can find the
+ right include files to be patched.
+</PRE>
+ Based on the given <TT>mode</TT> and the current version of the compiler (which
+the patcher can print when given the <TT>dumpversion</TT> argument) the patcher
+will create a subdirectory of the <TT>dest</TT> directory (say <TT>/usr/home/necula/cil/include</TT>), such as:
+<PRE CLASS="verbatim">
+/usr/home/necula/cil/include/gcc_2.95.3-5
+</PRE>
+ In that file the patcher will copy the modified versions of the include files
+specified with the <TT>ufile</TT> and <TT>sfile</TT> options. Each of these options can
+be specified multiple times. <BR>
+<BR>
+The patch file (specified with the <TT>patch</TT> option) has a format inspired by
+the Unix <TT>patch</TT> tool. The file has the following grammar:
+<PRE CLASS="verbatim">
+&lt;&lt;&lt; flags
+patterns
+===
+replacement
+&gt;&gt;&gt;
+</PRE>
+ The flags are a comma separated, case-sensitive, sequence of keywords or
+keyword = value. The following flags are supported:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>file=foo.h</TT> - will only apply the patch on files whose name is
+ <TT>foo.h</TT>.
+<LI CLASS="li-itemize"><TT>optional</TT> - this means that it is Ok if the current patch does not
+match any of the processed files.
+<LI CLASS="li-itemize"><TT>group=foo</TT> - will add this patch to the named group. If this is not
+specified then a unique group is created to contain just the current patch.
+When all files specified in the command line have been patched, an error
+message is generated for all groups for whom no member patch was used. We use
+this mechanism to receive notice when the patch triggers are out-dated with
+respect to the new include files.
+<LI CLASS="li-itemize"><TT>system=sysname</TT> - will only consider this pattern on a given
+operating system. The &#8220;sysname&#8221; is reported by the &#8220;$Ô&#8221; variable in
+Perl, except that Windows is always considered to have sysname
+&#8220;cygwin.&#8221; For Linux use &#8220;linux&#8221; (capitalization matters).
+<LI CLASS="li-itemize"><TT>ateof</TT> - In this case the patterns are ignored and the replacement
+text is placed at the end of the patched file. Use the <TT>file</TT> flag if you
+want to restrict the files in which this replacement is performed.
+<LI CLASS="li-itemize"><TT>atsof</TT> - The patterns are ignored and the replacement text is placed
+at the start of the patched file. Uf the <TT>file</TT> flag to restrict the
+application of this patch to a certain file.
+<LI CLASS="li-itemize"><TT>disabled</TT> - Use this flag if you want to disable the pattern.
+</UL>
+The patterns can consist of several groups of lines separated by the <TT>|||</TT>
+marker. Each of these group of lines is a multi-line pattern that if found in
+the file will be replaced with the text given at the end of the block. <BR>
+<BR>
+The matching is space-insensitive.<BR>
+<BR>
+All of the markers <TT>&lt;&lt;&lt;</TT>, <TT>|||</TT>, <TT>===</TT> and <TT>&gt;&gt;&gt;</TT> must appear at the
+beginning of a line but they can be followed by arbitrary text (which is
+ignored).<BR>
+<BR>
+The replacement text can contain the special keyword <TT>@__pattern__@</TT>,
+which is substituted with the pattern that matched. <BR>
+<BR>
+<!--TOC section Debugging support-->
+
+<H2 CLASS="section"><A NAME="htoc41">15</A>&nbsp;&nbsp;Debugging support</H2><!--SEC END -->
+<A NAME="sec-debugger"></A>
+Most of the time we debug our code using the Errormsg module along with the
+pretty printer. But if you want to use the Ocaml debugger here is an easy way
+to do it. Say that you want to debug the invocation of cilly that arises out
+of the following command:
+<PRE CLASS="verbatim">
+cilly -c hello.c
+</PRE>
+ You must follow the installation <A HREF="../ccured/setup.html">instructions</A>
+to install the Elist support files for ocaml and to extend your .emacs
+appropriately. Then from within Emacs you do
+<PRE CLASS="verbatim">
+ALT-X my-camldebug
+</PRE>
+ This will ask you for the command to use for running the Ocaml debugger
+(initially the default will be &#8220;ocamldebug&#8221; or the last command you
+introduced). You use the following command:
+<PRE CLASS="verbatim">
+cilly --ocamldebug -c hello.c
+</PRE>
+ This will run <TT>cilly</TT> as usual and invoke the Ocaml debugger when the cilly
+engine starts. The advantage of this way of invoking the debugger is that the
+directory search paths are set automatically and the right set or arguments is
+passed to the debugger. <BR>
+<BR>
+<!--TOC section Who Says C is Simple?-->
+
+<H2 CLASS="section"><A NAME="htoc42">16</A>&nbsp;&nbsp;Who Says C is Simple?</H2><!--SEC END -->
+<A NAME="sec-simplec"></A>
+When I (George) started to write CIL I thought it was going to take two weeks.
+Exactly a year has passed since then and I am still fixing bugs in it. This
+gross underestimate was due to the fact that I thought parsing and making
+sense of C is simple. You probably think the same. What I did not expect was
+how many dark corners this language has, especially if you want to parse
+real-world programs such as those written for GCC or if you are more ambitious
+and you want to parse the Linux or Windows NT sources (both of these were
+written without any respect for the standard and with the expectation that
+compilers will be changed to accommodate the program). <BR>
+<BR>
+The following examples were actually encountered either in real programs or
+are taken from the ISO C99 standard or from the GCC's testcases. My first
+reaction when I saw these was: <EM>Is this C?</EM>. The second one was : <EM>What the hell does it mean?</EM>. <BR>
+<BR>
+If you are contemplating doing program analysis for C on abstract-syntax
+trees then your analysis ought to be able to handle these things. Or, you can
+use CIL and let CIL translate them into clean C code. <BR>
+<BR>
+<!--TOC subsection Standard C-->
+
+<H3 CLASS="subsection"><A NAME="htoc43">16.1</A>&nbsp;&nbsp;Standard C</H3><!--SEC END -->
+
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Why does the following code return 0 for most values of <TT>x</TT>? (This
+should be easy.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x;
+ return x == (1 &amp;&amp; x);
+</FONT></PRE>
+See the <A HREF="examples/ex30.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Why does the following code return 0 and not -1? (Answer: because
+<TT>sizeof</TT> is unsigned, thus the result of the subtraction is unsigned, thus
+the shift is logical.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return ((1 - sizeof(int)) &gt;&gt; 32);
+</FONT></PRE>
+See the <A HREF="examples/ex31.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Scoping rules can be tricky. This function returns 5.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int x = 5;
+int f() {
+ int x = 3;
+ {
+ extern int x;
+ return x;
+ }
+}
+</FONT></PRE>
+See the <A HREF="examples/ex32.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Functions and function pointers are implicitly converted to each other.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int (*pf)(void);
+int f(void) {
+
+ pf = &amp;f; // This looks ok
+ pf = ***f; // Dereference a function?
+ pf(); // Invoke a function pointer?
+ (****pf)(); // Looks strange but Ok
+ (***************f)(); // Also Ok
+}
+</FONT></PRE>
+See the <A HREF="examples/ex33.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializer with designators are one of the hardest parts about ISO C.
+Neither MSVC or GCC implement them fully. GCC comes close though. What is the
+final value of <TT>i.nested.y</TT> and <TT>i.nested.z</TT>? (Answer: 2 and respectively
+6).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct {
+ int x;
+ struct {
+ int y, z;
+ } nested;
+} i = { .nested.y = 5, 6, .x = 1, 2 };
+</FONT></PRE>
+See the <A HREF="examples/ex34.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">This is from c-torture. This function returns 1.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+typedef struct
+{
+ char *key;
+ char *value;
+} T1;
+
+typedef struct
+{
+ long type;
+ char *value;
+} T3;
+
+T1 a[] =
+{
+ {
+ "",
+ ((char *)&amp;((T3) {1, (char *) 1}))
+ }
+};
+int main() {
+ T3 *pt3 = (T3*)a[0].value;
+ return pt3-&gt;value;
+}
+</FONT></PRE>
+See the <A HREF="examples/ex35.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Another one with constructed literals. This one is legal according to
+the GCC documentation but somehow GCC chokes on (it works in CIL though). This
+code returns 2.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return ((int []){1,2,3,4})[1];
+</FONT></PRE>
+See the <A HREF="examples/ex36.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">In the example below there is one copy of &#8220;bar&#8221; and two copies of
+ &#8220;pbar&#8221; (static prototypes at block scope have file scope, while for all
+ other types they have block scope).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo() {
+ static bar();
+ static (*pbar)() = bar;
+
+ }
+
+ static bar() {
+ return 1;
+ }
+
+ static (*pbar)() = 0;
+</FONT></PRE>
+See the <A HREF="examples/ex37.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Two years after heavy use of CIL, by us and others, I discovered a bug
+ in the parser. The return value of the following function depends on what
+ precedence you give to casts and unary minus:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ unsigned long foo() {
+ return (unsigned long) - 1 / 8;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex38.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+The correct interpretation is <TT>((unsigned long) - 1) / 8</TT>, which is a
+ relatively large number, as opposed to <TT>(unsigned long) (- 1 / 8)</TT>, which
+ is 0. </OL>
+<!--TOC subsection GCC ugliness-->
+
+<H3 CLASS="subsection"><A NAME="htoc44">16.2</A>&nbsp;&nbsp;GCC ugliness</H3><!--SEC END -->
+<A NAME="sec-ugly-gcc"></A>
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">GCC has generalized lvalues. You can take the address of a lot of
+strange things:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, y, z;
+ return &amp;(x ? y : z) - &amp; (x++, x);
+</FONT></PRE>
+See the <A HREF="examples/ex39.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC lets you omit the second component of a conditional expression.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ extern int f();
+ return f() ? : -1; // Returns the result of f unless it is 0
+</FONT></PRE>
+See the <A HREF="examples/ex40.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Computed jumps can be tricky. CIL compiles them away in a fairly clean
+way but you are on your own if you try to jump into another function this way.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+static void *jtab[2]; // A jump table
+static int doit(int x){
+
+ static int jtab_init = 0;
+ if(!jtab_init) { // Initialize the jump table
+ jtab[0] = &amp;&amp;lbl1;
+ jtab[1] = &amp;&amp;lbl2;
+ jtab_init = 1;
+ }
+ goto *jtab[x]; // Jump through the table
+lbl1:
+ return 0;
+lbl2:
+ return 1;
+}
+
+int main(void){
+ if (doit(0) != 0) exit(1);
+ if (doit(1) != 1) exit(1);
+ exit(0);
+}
+</FONT></PRE>
+See the <A HREF="examples/ex41.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">A cute little example that we made up. What is the returned value?
+(Answer: 1);
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return ({goto L; 0;}) &amp;&amp; ({L: 5;});
+</FONT></PRE>
+See the <A HREF="examples/ex42.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate"><TT>extern inline</TT> is a strange feature of GNU C. Can you guess what the
+following code computes?
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+extern inline foo(void) { return 1; }
+int firstuse(void) { return foo(); }
+
+// A second, incompatible definition of foo
+int foo(void) { return 2; }
+
+int main() {
+ return foo() + firstuse();
+}
+</FONT></PRE>
+See the <A HREF="examples/ex43.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+The answer depends on whether the optimizations are turned on. If they are
+then the answer is 3 (the first definition is inlined at all occurrences until
+the second definition). If the optimizations are off, then the first
+definition is ignore (treated like a prototype) and the answer is 4. <BR>
+<BR>
+CIL will misbehave on this example, if the optimizations are turned off (it
+ always returns 3).<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC allows you to cast an object of a type T into a union as long as the
+union has a field of that type:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+union u {
+ int i;
+ struct s {
+ int i1, i2;
+ } s;
+};
+
+union u x = (union u)6;
+
+int main() {
+ struct s y = {1, 2};
+ union u z = (union u)y;
+}
+</FONT></PRE>
+See the <A HREF="examples/ex44.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC allows you to use the <TT>__mode__</TT> attribute to specify the size
+of the integer instead of the standard <TT>char</TT>, <TT>short</TT> and so on:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int __attribute__ ((__mode__ ( __QI__ ))) i8;
+int __attribute__ ((__mode__ ( __HI__ ))) i16;
+int __attribute__ ((__mode__ ( __SI__ ))) i32;
+int __attribute__ ((__mode__ ( __DI__ ))) i64;
+</FONT></PRE>
+See the <A HREF="examples/ex45.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">The &#8220;alias&#8221; attribute on a function declaration tells the
+ linker to treat this declaration as another name for the specified
+ function. CIL will replace the declaration with a trampoline
+ function pointing to the specified target.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ static int bar(int x, char y) {
+ return x + y;
+ }
+
+ //foo is considered another name for bar.
+ int foo(int x, char y) __attribute__((alias("bar")));
+</FONT></PRE>
+See the <A HREF="examples/ex46.txt">CIL output</A> for this
+code fragment</OL>
+<!--TOC subsection Microsoft VC ugliness-->
+
+<H3 CLASS="subsection"><A NAME="htoc45">16.3</A>&nbsp;&nbsp;Microsoft VC ugliness</H3><!--SEC END -->
+
+This compiler has few extensions, so there is not much to say here.
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Why does the following code return 0 and not -1? (Answer: because of a
+bug in Microsoft Visual C. It thinks that the shift is unsigned just because
+the second operator is unsigned. CIL reproduces this bug when in MSVC mode.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return -3 &gt;&gt; (8 * sizeof(int));
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-enumerate">Unnamed fields in a structure seem really strange at first. It seems
+that Microsoft Visual C introduced this extension, then GCC picked it up (but
+in the process implemented it wrongly: in GCC the field <TT>y</TT> overlaps with
+<TT>x</TT>!).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct {
+ int x;
+ struct {
+ int y, z;
+ struct {
+ int u, v;
+ };
+ };
+} a;
+return a.x + a.y + a.z + a.u + a.v;
+</FONT></PRE>
+See the <A HREF="examples/ex47.txt">CIL output</A> for this
+code fragment</OL>
+<!--TOC section Authors-->
+
+<H2 CLASS="section"><A NAME="htoc46">17</A>&nbsp;&nbsp;Authors</H2><!--SEC END -->
+
+The CIL parser was developed starting from Hugues Casse's <TT>frontc</TT>
+front-end for C although all the files from the <TT>frontc</TT> distribution have
+been changed very extensively. The intermediate language and the elaboration
+stage are all written from scratch. The main author is
+<A HREF="mailto:necula@cs.berkeley.edu">George Necula</A>, with significant
+contributions from <A HREF="mailto:smcpeak@cs.berkeley.edu">Scott McPeak</A>,
+<A HREF="mailto:weimer@cs.berkeley.edu">Westley Weimer</A>,
+<A HREF="mailto:liblit@cs.wisc.edu">Ben Liblit</A>,
+<A HREF="javascript:loadTop('http://www.cs.berkeley.edu/~matth/')">Matt Harren</A>,
+Raymond To and Aman Bhargava.<BR>
+<BR>
+This work is based upon work supported in part by the National Science
+Foundation under Grants No. 9875171, 0085949 and 0081588, and gifts from
+Microsoft Research. Any opinions, findings, and conclusions or recommendations
+expressed in this material are those of the author(s) and do not necessarily
+reflect the views of the National Science Foundation or the other sponsors.<BR>
+<BR>
+<!--TOC section License-->
+
+<H2 CLASS="section"><A NAME="htoc47">18</A>&nbsp;&nbsp;License</H2><!--SEC END -->
+
+Copyright (c) 2001-2005,
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+George C. Necula &lt;necula@cs.berkeley.edu&gt;
+<LI CLASS="li-itemize">Scott McPeak &lt;smcpeak@cs.berkeley.edu&gt;
+<LI CLASS="li-itemize">Wes Weimer &lt;weimer@cs.berkeley.edu&gt;
+<LI CLASS="li-itemize">Ben Liblit &lt;liblit@cs.wisc.edu&gt;
+</UL>
+All rights reserved.<BR>
+<BR>
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:<BR>
+<BR>
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.<BR>
+<BR>
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.<BR>
+<BR>
+3. The names of the contributors may not be used to endorse or promote
+products derived from this software without specific prior written
+permission.<BR>
+<BR>
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.<BR>
+<BR>
+<!--TOC section Bug reports-->
+
+<H2 CLASS="section"><A NAME="htoc48">19</A>&nbsp;&nbsp;Bug reports</H2><!--SEC END -->
+
+We are certain that there are still some remaining bugs in CIL. If you find
+one please file a bug report in our Source Forge space
+<A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
+<BR>
+You can find there the latest announcements, a source distribution,
+bug report submission instructions and a mailing list: cil-users[at
+sign]lists.sourceforge.net. Please use this list to ask questions about CIL,
+as it will ensure your message is viewed by a broad audience. <BR>
+<BR>
+<!--TOC section Changes-->
+
+<H2 CLASS="section"><A NAME="htoc49">20</A>&nbsp;&nbsp;Changes</H2><!--SEC END -->
+<A NAME="sec-changes"></A><!--NAME changes.html-->
+
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<B>May 20, 2006</B>: <B>Released version 1.3.5</B>
+<LI CLASS="li-itemize"><B>May 19, 2006</B>: <TT>Makefile.cil.in</TT>/<TT>Makefile.cil</TT> have
+ been renamed <TT>Makefile.in</TT>/<TT>Makefile</TT>. And <TT>maincil.ml</TT> has
+ been renamed <TT>main.ml</TT>.
+<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added a new module <A HREF="api/Cfg.html">Cfg</A> to compute the
+ control-flow graph. Unlike the older <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>,
+ the new version does not modify the code.
+<LI CLASS="li-itemize"><B>May 18, 2006</B>: Added several new analyses: reaching
+ definitions, available expressions, liveness analysis, and dead code
+ elimination. See Section&nbsp;<A HREF="#sec-Extension">8</A>.
+<LI CLASS="li-itemize"><B>May 2, 2006</B>: Added a flag <TT>--noInsertImplicitCasts</TT>.
+ When this flag is used, CIL code will only include casts inserted by
+ the programmer. Implicit coercions are not changed to explicit casts.
+<LI CLASS="li-itemize"><B>April 16, 2006</B>: Minor improvements to the <TT>--stats</TT>
+ flag (Section&nbsp;<A HREF="#sec-cilly-asm-options">7.2</A>). We now use Pentium performance
+ counters by default, if your processor supports them.
+<LI CLASS="li-itemize"><B>April 10, 2006</B>: Extended <TT>machdep.c</TT> to support
+ microcontroller compilers where the struct alignment of integer
+ types does not match the size of the type. Thanks to Nathan
+ Cooprider for the patch.
+<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for global initializers of unions when
+ the union field being initialized is not the first one, and for
+ missing initializers of unions when the first field is not the
+ largest field.
+<LI CLASS="li-itemize"><B>April 6, 2006</B>: Fix for bitfields in the SFI module.
+<LI CLASS="li-itemize"><B>April 6, 2006</B>: Various fixes for gcc attributes.
+ <TT>packed</TT>, <TT>section</TT>, and <TT>always_inline</TT> attributes are now
+ parsed correctly. Also fixed printing of attributes on enum types.
+<LI CLASS="li-itemize"><B>March 30, 2006</B>: Fix for <TT>rmtemps.ml</TT>, which deletes
+ unused inline functions. When in <TT>gcc</TT> mode CIL now leaves all
+ inline functions in place, since <TT>gcc</TT> treats these as externally
+ visible.
+<LI CLASS="li-itemize"><B>March 15, 2006</B>: Fix for <TT>typeof(<I>e</I>)</TT> when <I>e</I> has type
+ <TT>void</TT>.
+<LI CLASS="li-itemize"><B>March 3, 2006</B>: Assume inline assembly instructions can
+ fall through for the purposes of adding return statements. Thanks to
+ Nathan Cooprider for the patch.
+<LI CLASS="li-itemize"><B>February 27, 2006</B>: Fix for extern inline functions when
+ the output of CIL is fed back into CIL.
+<LI CLASS="li-itemize"><B>January 30, 2006</B>: Fix parsing of <TT>switch</TT> without braces.
+<LI CLASS="li-itemize"><B>January 30, 2006</B>: Allow `$' to appear in identifiers.
+<LI CLASS="li-itemize"><B>January 13, 2006</B>: Added support for gcc's alias attribute
+ on functions. See Section&nbsp;<A HREF="#sec-ugly-gcc">16.2</A>, item 8.
+<LI CLASS="li-itemize"><B>December 9, 2005</B>: Christoph Spiel fixed the Golf and
+ Olf modules so that Golf can be used with the points-to analysis.
+ He also added performance fixes and cleaned up the documentation.
+<LI CLASS="li-itemize"><B>December 1, 2005</B>: Major rewrite of the ext/callgraph module.
+<LI CLASS="li-itemize"><B>December 1, 2005</B>: Preserve enumeration constants in CIL. Default
+is the old behavior to replace them with integers.
+<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added support for many GCC <TT>__builtin</TT>
+ functions.
+<LI CLASS="li-itemize"><B>November 30, 2005</B>: Added the EXTRAFEATURES configure
+ option, making it easier to add Features to the build process.
+<LI CLASS="li-itemize"><B>November 23, 2005</B>: In MSVC mode do not remove any locals whose name
+ appears as a substring in an inline assembly.
+<LI CLASS="li-itemize"><B>November 23, 2005</B>: Do not add a return to functions that have the
+ noreturn attribute.
+<LI CLASS="li-itemize"><B>November 22, 2005</B>: <B>Released version 1.3.4</B>
+<LI CLASS="li-itemize"><B>November 21, 2005</B>: Performance and correctness fixes for
+ the Points-to Analysis module. Thanks to Christoph Spiel for the
+ patches.
+<LI CLASS="li-itemize"><B>October 5, 2005</B>: CIL now builds on SPARC/Solaris. Thanks
+ to Nick Petroni and Remco van Engelen for the patches.
+<LI CLASS="li-itemize"><B>September 26, 2005</B>: CIL no longer uses the `<TT>-I-</TT>' flag
+ by default when preprocessing with gcc.
+<LI CLASS="li-itemize"><B>August 24, 2005</B>: Added a command-line option
+ &#8220;--forceRLArgEval&#8221; that forces function arguments to be evaluated
+ right-to-left. This is the default behavior in unoptimized gcc and
+ MSVC, but the order of evaluation is undefined when using
+ optimizations, unless you apply this CIL transformation. This flag
+ does not affect the order of evaluation of e.g. binary operators,
+ which remains undefined. Thanks to Nathan Cooprider for the patch.
+<LI CLASS="li-itemize"><B>August 9, 2005</B>: Fixed merging when there are more than 20
+ input files.
+<LI CLASS="li-itemize"><B>August 3, 2005</B>: When merging, it is now an error to
+ declare the same global variable twice with different initializers.
+<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in transparent unions.
+<LI CLASS="li-itemize"><B>July 27, 2005</B>: Fixed bug in collectInitializer. Thanks to
+ Benjamin Monate for the patch.
+<LI CLASS="li-itemize"><B>July 26, 2005</B>: Better support for extended inline assembly
+ in gcc.
+<LI CLASS="li-itemize"><B>July 26, 2005</B>: Added many more gcc __builtin* functions
+ to CIL. Most are treated as Call instructions, but a few are
+ translated into expressions so that they can be used in global
+ initializers. For example, &#8220;<TT>__builtin_offsetof(t, field)</TT>&#8221; is
+ rewritten as &#8220;<TT>&amp;((t*)0)-&gt;field</TT>&#8221;, the traditional way of calculating
+ an offset.
+<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug in the constant folding of shifts
+ when the second argument was negative or too large.
+<LI CLASS="li-itemize"><B>July 18, 2005</B>: Fixed bug where casts were not always
+ inserted in function calls.
+<LI CLASS="li-itemize"><B>June 10, 2005</B>: Fixed bug in the code that makes implicit
+ returns explicit. We weren't handling switch blocks correctly.
+<LI CLASS="li-itemize"><B>June 1, 2005</B>: <B>Released version 1.3.3</B>
+<LI CLASS="li-itemize"><B>May 31, 2005</B>: Fixed handling of noreturn attribute for function
+ pointers.
+<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the handling of constructors in gcc.
+<LI CLASS="li-itemize"><B>May 30, 2005</B>: Fixed bugs in the generation of global variable IDs.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Reimplemented the translation of function calls so
+ that we can intercept some builtins. This is important for the uses of
+ __builtin_constant_p in constants.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Export the plainCilPrinter, for debugging.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug with printing of const attribute for
+ arrays.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in generation of type signatures. Now they
+ should not contain expressions anymore, so you can use structural equality.
+ This used to lead to Out_of_Memory exceptions.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Fixed bug in type comparisons using
+ TBuiltin_va_list.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Improved the constant folding in array lengths and
+ case expressions.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the <TT>__builtin_frame_address</TT> to the set
+ of gcc builtins.
+<LI CLASS="li-itemize"><B>May 27, 2005</B>: Added the CIL project to SourceForge.
+<LI CLASS="li-itemize"><B>April 23, 2005</B>: The cattr field was not visited.
+<LI CLASS="li-itemize"><B>March 6, 2005</B>: Debian packaging support
+<LI CLASS="li-itemize"><B>February 16, 2005</B>: Merger fixes.
+<LI CLASS="li-itemize"><B>February 11, 2005</B>: Fixed a bug in <TT>--dopartial</TT>. Thanks to
+Nathan Cooprider for this fix.
+<LI CLASS="li-itemize"><B>January 31, 2005</B>: Make sure the input file is closed even if a
+ parsing error is encountered.
+<LI CLASS="li-itemize"><B>January 11, 2005</B>: <B>Released version 1.3.2</B>
+<LI CLASS="li-itemize"><B>January 11, 2005</B>: Fixed printing of integer constants whose
+ integer kind is shorter than an int.
+<LI CLASS="li-itemize"><B>January 11, 2005</B>: Added checks for negative size arrays and arrays
+ too big.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Added support for GCC attribute &#8220;volatile&#8221; for
+ tunctions (as a synonim for noreturn).
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Improved the comparison of array sizes when
+ comparing array types.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed handling of shell metacharacters in the
+ cilly command lione.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed dropping of cast in initialization of
+ local variable with the result of a function call.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed some structural comparisons that were
+ broken in the Ocaml 3.08.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed the <TT>unrollType</TT> function to not forget
+ attributes.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Better keeping track of locations of function
+ prototypes and definitions.
+<LI CLASS="li-itemize"><B>January 10, 2005</B>: Fixed bug with the expansion of enumeration
+ constants in attributes.
+<LI CLASS="li-itemize"><B>October 18, 2004</B>: Fixed a bug in cabsvisit.ml. CIl would wrap a
+ BLOCK around a single atom unnecessarily.
+<LI CLASS="li-itemize"><B>August 7, 2004</B>: <B>Released version 1.3.1</B>
+<LI CLASS="li-itemize"><B>August 4, 2004</B>: Fixed a bug in splitting of structs using
+ <TT>--dosimplify</TT>
+<LI CLASS="li-itemize"><B>July 29, 2004</B>: Minor changes to the type typeSig (type signatures)
+ to ensure that they do not contain types, so that you can do structural
+ comparison without danger of nontermination.
+<LI CLASS="li-itemize"><B>July 28, 2004</B>: Ocaml version 3.08 is required. Numerous small
+ changes while porting to Ocaml 3.08.
+<LI CLASS="li-itemize"><B>July 7, 2004</B>: <B>Released version 1.2.6</B>
+<LI CLASS="li-itemize"><B>July 2, 2004</B>: Character constants such as <TT>'c'</TT> should
+ have type <TT>int</TT>, not <TT>char</TT>. Added a utility function
+ <TT>Cil.charConstToInt</TT> that sign-extends chars greater than 128, if needed.
+<LI CLASS="li-itemize"><B>July 2, 2004</B>: Fixed a bug that was casting values to int
+ before applying the logical negation operator !. This caused
+ problems for floats, and for integer types bigger than <TT>int</TT>.
+<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added the field <TT>sallstmts</TT> to a function
+ description, to hold all statements in the function.
+<LI CLASS="li-itemize"><B>June 13, 2004</B>: Added new extensions for data flow analyses, and
+ for computing dominators.
+<LI CLASS="li-itemize"><B>June 10, 2004</B>: Force initialization of CIL at the start of
+Cabs2cil.
+<LI CLASS="li-itemize"><B>June 9, 2004</B>: Added support for GCC <TT>__attribute_used__</TT>
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: <B>Released version 1.2.5</B>
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Allow now to run ./configure CC=cl and set the MSVC
+compiler to be the default. The MSVC driver will now select the default name
+of the .exe file like the CL compiler.
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed a bug in the driver. The temporary files are
+deleted by the Perl script before the CL compiler gets to them?
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added the - form of arguments to the MSVC driver.
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Added a few more GCC-specific string escapes, (, [,
+{, %, E.
+<LI CLASS="li-itemize"><B>April 7, 2004</B>: Fixed bug with continuation lines in MSVC.
+<LI CLASS="li-itemize"><B>April 6, 2004</B>: Fixed embarassing bug in the parser: the precedence
+ of casts and unary operators was switched.
+<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug involving statements mixed between
+declarations containing initializers. Now we make sure that the initializers
+are run in the proper order with respect to the statements.
+<LI CLASS="li-itemize"><B>April 5, 2004</B>: Fixed a bug in the merger. The merger was keeping
+separate alpha renaming talbes (namespaces) for variables and types. This
+means that it might end up with a type and a variable named the same way, if
+they come from different files, which breaks an important CIL invariant.
+<LI CLASS="li-itemize"><B>March 11, 2004</B> : Fixed a bug in the Cil.copyFunction function. The
+new local variables were not getting fresh IDs.
+<LI CLASS="li-itemize"><B>March 5, 2004</B>: Fixed a bug in the handling of static function
+ prototypes in a block scope. They used to be renamed. Now we just consider
+ them global.
+<LI CLASS="li-itemize"><B>February 20, 2004</B>: <B>Released version 1.2.4</B>
+<LI CLASS="li-itemize"><B>February 15, 2004</B>: Changed the parser to allow extra semicolons
+ after field declarations.
+<LI CLASS="li-itemize"><B>February 14, 2004</B>: Changed the Errormsg functions: error, unimp,
+bug to not raise an exception. Instead they just set Errormsg.hadErrors.
+<LI CLASS="li-itemize"><B>February 13, 2004</B>: Change the parsing of attributes to recognize
+ enumeration constants.
+<LI CLASS="li-itemize"><B>February 10, 2004</B>: In some versions of <TT>gcc</TT> the identifier
+ _{thread is an identifier and in others it is a keyword. Added code
+ during configuration to detect which is the case.
+<LI CLASS="li-itemize"><B>January 7, 2004</B>: <B>Released version 1.2.3</B>
+<LI CLASS="li-itemize"><B>January 7, 2004</B>: Changed the alpha renamer to be less
+conservative. It will remember all versions of a name that were seen and will
+only create a new name if we have not seen one.
+<LI CLASS="li-itemize"><B>December 30, 2003</B> : Extended the <TT>cilly</TT> command to understand
+ better linker command options <TT>-lfoo</TT>.
+<LI CLASS="li-itemize"><B>December 5, 2003</B>: Added markup commands to the pretty-printer
+module. Also, changed the &#8220;@&lt;&#8221; left-flush command into &#8220;@''.
+<LI CLASS="li-itemize"><B>December 4, 2003</B>: Wide string literals are now handled
+directly by Cil (rather than being exploded into arrays). This is
+apparently handy for Microsoft Device Driver APIs that use intrinsic
+functions that require literal constant wide-string arguments.
+<LI CLASS="li-itemize"><B>December 3, 2003</B>: Added support for structured exception handling
+ extensions for the Microsoft compilers.
+<LI CLASS="li-itemize"><B>December 1, 2003</B>: Fixed a Makefile bug in the generation of the
+Cil library (e.g., <TT>cil.cma</TT>) that was causing it to be unusable. Thanks
+to KEvin Millikin for pointing out this bug.
+<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added support for linkage specifications
+ (extern &#8220;C&#8221;).
+<LI CLASS="li-itemize"><B>November 26, 2003</B>: Added the ocamlutil directory to contain some
+utilities shared with other projects.
+<LI CLASS="li-itemize"><B>November 25, 2003</B>: <B>Released version 1.2.2</B>
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that allowed a static local to
+ conflict with a global with the same name that is declared later in the
+ file.
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Removed the <TT>--keep</TT> option of the <TT>cilly</TT>
+ driver and replaced it with <TT>--save-temps</TT>.
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Added printing of what CIL features are being
+ run.
+<LI CLASS="li-itemize"><B>November 24, 2003</B>: Fixed a bug that resulted in attributes being
+ dropped for integer types.
+<LI CLASS="li-itemize"><B>November 11, 2003</B>: Fixed a bug in the visitor for enumeration
+ definitions.
+<LI CLASS="li-itemize"><B>October 24, 2003</B>: Fixed a problem in the configuration script. It
+ was not recognizing the Ocaml version number for beta versions.
+<LI CLASS="li-itemize"><B>October 15, 2003</B>: Fixed a problem in version 1.2.1 that was
+ preventing compilation on OCaml 3.04.
+<LI CLASS="li-itemize"><B>September 17, 2003: Released version 1.2.1.</B>
+<LI CLASS="li-itemize"><B>September 7, 2003</B>: Redesigned the interface for choosing
+ <TT>#line</TT> directive printing styles. Cil.printLn and
+ Cil.printLnComment have been merged into Cil.lineDirectiveStyle.
+<LI CLASS="li-itemize"><B>August 8, 2003</B>: Do not silently pad out functions calls with
+arguments to match the prototype.
+<LI CLASS="li-itemize"><B>August 1, 2003</B>: A variety of fixes suggested by Steve Chamberlain:
+initializers for externs, prohibit float literals in enum, initializers for
+unsized arrays were not working always, an overflow problem in Ocaml, changed
+the processing of attributes before struct specifiers<BR>
+<BR>
+<LI CLASS="li-itemize"><B>July 14, 2003</B>: Add basic support for GCC's "__thread" storage
+qualifier. If given, it will appear as a "thread" attribute at the top of the
+type of the declared object. Treatment is very similar to "__declspec(...)"
+in MSVC<BR>
+<BR>
+<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed some of the __alignof computations. Fixed
+ bug in the designated initializers for arrays (Array.get error).
+<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed infinite loop bug (Stack Overflow) in the
+ visitor for __alignof.
+<LI CLASS="li-itemize"><B>July 8, 2003</B>: Fixed bug in the conversion to CIL. A function or
+ array argument of
+ the GCC __typeof() was being converted to pointer type. Instead, it should
+ be left alone, just like for sizeof.
+<LI CLASS="li-itemize"><B>July 7, 2003</B>: New Escape module provides utility functions
+ for escaping characters and strings in accordance with C lexical
+ rules.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>July 2, 2003</B>: Relax CIL's rules for when two enumeration types are
+considered compatible. Previously CIL considered two enums to be compatible if
+they were the same enum. Now we follow the C99 standard.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 28, 2003</B>: In the Formatparse module, Eric Haugh found and
+ fixed a bug in the handling of lvalues of the form &#8220;lv-&gt;field.more&#8221;.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 28, 2003</B>: Extended the handling of gcc command lines
+arguments in the Perl scripts. <BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 23, 2003</B>: In Rmtmps module, simplified the API for
+ customizing the root set. Clients may supply a predicate that
+ returns true for each root global. Modifying various
+ &#8220;<TT>referenced</TT>&#8221; fields directly is no longer supported.<BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 17, 2003</B>: Reimplement internal utility routine
+ <TT>Cil.escape_char</TT>. Faster and better. <BR>
+<BR>
+<LI CLASS="li-itemize"><B>June 14, 2003</B>: Implemented support for <TT>__attribute__s</TT>
+appearing between "struct" and the struct tag name (also for unions and
+enums), since gcc supports this as documented in section 4.30 of the gcc
+(2.95.3) manual<BR>
+<BR>
+<LI CLASS="li-itemize"><B>May 30, 2003</B>: Released the regression tests.
+<LI CLASS="li-itemize"><B>May 28, 2003</B>: <B>Released version 1.1.2</B>
+<LI CLASS="li-itemize"><B>May 26, 2003</B>: Add the <TT>simplify</TT> module that compiles CIL
+expressions into simpler expressions, similar to those that appear in a
+3-address intermediate language.
+<LI CLASS="li-itemize"><B>May 26, 2003</B>: Various fixes and improvements to the pointer
+analysis modules.
+<LI CLASS="li-itemize"><B>May 26, 2003</B>: Added optional consistency checking for
+transformations.
+<LI CLASS="li-itemize"><B>May 25, 2003</B>: Added configuration support for big endian machines.
+Now <A HREF="api/Cil.html#VALlittle_endian">Cil.little_endian</A> can be used to test whether the machine is
+little endian or not.
+<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed a bug in the handling of inline functions. The
+CIL merger used to turn these functions into &#8220;static&#8221;, which is incorrect.
+<LI CLASS="li-itemize"><B>May 22, 2003</B>: Expanded the CIL consistency checker to verify
+undesired sharing relationships between data structures.
+<LI CLASS="li-itemize"><B>May 22, 2003</B>: Fixed bug in the <TT>oneret</TT> CIL module: it was
+mishandling certain labeled return statements.
+<LI CLASS="li-itemize"><B>May 5, 2003</B>: <B>Released version 1.0.11</B>
+<LI CLASS="li-itemize"><B>May 5, 2003</B>: OS X (powerpc/darwin) support for CIL. Special
+thanks to Jeff Foster, Andy Begel and Tim Leek.
+<LI CLASS="li-itemize"><B>April 30, 2003</B>: Better description of how to use CIL for your
+analysis.
+<LI CLASS="li-itemize"><B>April 28, 2003</B>: Fixed a bug with <TT>--dooneRet</TT> and
+<TT>--doheapify</TT>. Thanks, Manos Renieris.
+<LI CLASS="li-itemize"><B>April 16, 2003</B>: Reworked management of
+ temporary/intermediate output files in Perl driver scripts. Default
+ behavior is now to remove all such files. To keep intermediate
+ files, use one of the following existing flags:
+ <UL CLASS="itemize"><LI CLASS="li-itemize">
+ <TT>--keepmerged</TT> for the single-file merge of all sources
+ <LI CLASS="li-itemize"><TT>--keep=&lt;<I>dir</I></TT><TT>&gt;</TT> for various other CIL and
+ CCured output files
+ <LI CLASS="li-itemize"><TT>--save-temps</TT> for various gcc intermediate files; MSVC
+ has no equivalent option
+ </UL>
+ As part of this change, some intermediate files have changed their
+ names slightly so that new suffixes are always preceded by a
+ period. For example, CCured output that used to appear in
+ &#8220;<TT>foocured.c</TT>&#8221; now appears in &#8220;<TT>foo.cured.c</TT>&#8221;.
+<LI CLASS="li-itemize"><B>April 7, 2003</B>: Changed the representation of the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
+global constructor. Now it is possible to update the initializer without
+reconstructing the global (which in turn it would require reconstructing the
+list of globals that make up a program). We did this because it is often
+tempting to use <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and the <A HREF="api/Cil.html#VALGVar">Cil.GVar</A>
+was the only global that could not be updated in place.
+<LI CLASS="li-itemize"><B>April 6, 2003</B>: Reimplemented parts of the cilly.pl script to make
+it more robust in the presence of complex compiler arguments.
+<LI CLASS="li-itemize"><B>March 10, 2003</B>: <B>Released version 1.0.9</B>
+<LI CLASS="li-itemize"><B>March 10, 2003</B>: Unified and documented a large number of CIL
+Library Modules: oneret, simplemem, makecfg, heapify, stackguard, partial.
+Also documented the main client interface for the pointer analysis.
+<LI CLASS="li-itemize"><B>February 18, 2003</B>: Fixed a bug in logwrites that was causing it
+to produce invalid C code on writes to bitfields. Thanks, David Park.
+<LI CLASS="li-itemize"><B>February 15, 2003</B>: <B>Released version 1.0.8</B>
+<LI CLASS="li-itemize"><B>February 15, 2003</B>: PDF versions of the manual and API are
+available for those who would like to print them out.
+<LI CLASS="li-itemize"><B>February 14, 2003</B>: CIL now comes bundled with alias analyses.
+<LI CLASS="li-itemize"><B>February 11, 2003</B>: Added support for adding/removing options from
+ <TT>./configure</TT>.
+<LI CLASS="li-itemize"><B>February 3, 2003</B>: <B>Released version 1.0.7</B>
+<LI CLASS="li-itemize"><B>February 1, 2003</B>: Some bug fixes in the handling of variable
+argument functions in new versions of <TT>gcc</TT> And <TT>glibc</TT>.
+<LI CLASS="li-itemize"><B>January 29, 2003</B>: Added the logical AND and OR operators.
+Exapanded the translation to CIL to handle more complicated initializers
+(including those that contain logical operators).
+<LI CLASS="li-itemize"><B>January 28, 2003</B>: <B>Released version 1.0.6</B>
+<LI CLASS="li-itemize"><B>January 28, 2003</B>: Added support for the new handling of
+variable-argument functions in new versions of <TT>glibc</TT>.
+<LI CLASS="li-itemize"><B>January 19, 2003</B>: Added support for declarations in interpreted
+ constructors. Relaxed the semantics of the patterns for variables.
+<LI CLASS="li-itemize"><B>January 17, 2003</B>: Added built-in prototypes for the gcc built-in
+ functions. Changed the <TT>pGlobal</TT> method in the printers to print the
+ carriage return as well.
+<LI CLASS="li-itemize"><B>January 9, 2003</B>: Reworked lexer and parser's strategy for
+ tracking source file names and line numbers to more closely match
+ typical native compiler behavior. The visible CIL interface is
+ unchanged.
+<LI CLASS="li-itemize"><B>January 9, 2003</B>: Changed the interface to the alpha convertor. Now
+you can pass a list where it will record undo information that you can use to
+revert the changes that it makes to the scope tables.
+<LI CLASS="li-itemize"><B>January 6, 2003</B>: <B>Released version 1.0.5</B>
+<LI CLASS="li-itemize"><B>January 4, 2003</B>: Changed the interface for the Formatcil module.
+ Now the placeholders in the pattern have names. Also expanded the
+ documentation of the Formatcil module.
+ Now the placeholders in the pattern have names.
+<LI CLASS="li-itemize"><B>January 3, 2003</B>: Extended the <TT>rmtmps</TT> module to also remove
+ unused labels that are generated in the conversion to CIL. This reduces the
+ number of warnings that you get from <TT>cgcc</TT> afterwards.
+<LI CLASS="li-itemize"><B>December 17, 2002</B>: Fixed a few bugs in CIL related to the
+ representation of string literals. The standard says that a string literal
+ is an array. In CIL, a string literal has type pointer to character. This is
+ Ok, except as an argument of sizeof. To support this exception, we have
+ added to CIL the expression constructor SizeOfStr. This allowed us to fix
+ bugs with computing <TT>sizeof("foo bar")</TT> and <TT>sizeof((char*)"foo bar")</TT>
+ (the former is 8 and the latter is 4).<BR>
+<BR>
+<LI CLASS="li-itemize"><B>December 8, 2002</B>: Fixed a few bugs in the lexer and parser
+ relating to hex and octal escapes in string literals. Also fixed
+ the dependencies between the lexer and parser.
+<LI CLASS="li-itemize"><B>December 5, 2002</B>: Fixed visitor bugs that were causing
+ some attributes not to be visited and some queued instructions to be
+ dropped.
+<LI CLASS="li-itemize"><B>December 3, 2002</B>: Added a transformation to catch stack
+ overflows. Fixed the heapify transformation.
+<LI CLASS="li-itemize"><B>October 14, 2002</B>: CIL is now available under the BSD license
+(see the License section or the file LICENSE). <B>Released version 1.0.4</B>
+<LI CLASS="li-itemize"><B>October 9, 2002</B>: More FreeBSD configuration changes, support
+for the GCC-ims <TT>__signed</TT> and <TT>__volatile</TT>. Thanks to Axel
+Simon for pointing out these problems. <B>Released version 1.0.3</B>
+<LI CLASS="li-itemize"><B>October 8, 2002</B>: FreeBSD configuration and porting fixes.
+Thanks to Axel Simon for pointing out these problems.
+<LI CLASS="li-itemize"><B>September 10, 2002</B>: Fixed bug in conversion to CIL. Now we drop
+all &#8220;const&#8221; qualifiers from the types of locals, even from the fields of
+local structures or elements of arrays.
+<LI CLASS="li-itemize"><B>September 7, 2002</B>: Extended visitor interface to distinguish visitng
+ offsets inside lvalues from offsets inside initializer lists.
+<LI CLASS="li-itemize"><B>September 7, 2002</B>: <B>Released version 1.0.1</B>
+<LI CLASS="li-itemize"><B>September 6, 2002</B>: Extended the patcher with the <TT>ateof</TT> flag.
+<LI CLASS="li-itemize"><B>September 4, 2002</B>: Fixed bug in the elaboration to CIL. In some
+cases constant folding of <TT>||</TT> and <TT>&amp;&amp;</TT> was computed wrong.
+<LI CLASS="li-itemize"><B>September 3, 2002</B>: Fixed the merger documentation.
+<LI CLASS="li-itemize"><B>August 29, 2002</B>: <B>Released version 1.0.0.</B>
+<LI CLASS="li-itemize"><B>August 29, 2002</B>: Started numbering versions with a major nubmer,
+minor and revisions. Released version 1.0.0.
+<LI CLASS="li-itemize"><B>August 25, 2002</B>: Fixed the implementation of the unique
+identifiers for global variables and composites. Now those identifiers are
+globally unique.
+<LI CLASS="li-itemize"><B>August 24, 2002</B>: Added to the machine-dependent configuration the
+<TT>sizeofvoid</TT>. It is 1 on gcc and 0 on MSVC. Extended the implementation of
+<TT>Cil.bitsSizeOf</TT> to handle this (it was previously returning an error when
+trying to compute the size of <TT>void</TT>).
+<LI CLASS="li-itemize"><B>August 24, 2002</B>: Changed the representation of structure and
+unions to distinguish between undefined structures and those that are defined
+to be empty (allowed on gcc). The sizeof operator is undefined for the former
+and returns 0 for the latter.
+<LI CLASS="li-itemize"><B>August 22, 2002</B>: Apply a patch from Richard H. Y. to support
+FreeBSD installations. Thanks, Richard!
+<LI CLASS="li-itemize"><B>August 12, 2002</B>: Fixed a bug in the translation of wide-character
+strings. Now this translation matches that of the underlying compiler. Changed
+the implementation of the compiler dependencies.
+<LI CLASS="li-itemize"><B>May 25, 2002</B>: Added interpreted constructors and destructors.
+<LI CLASS="li-itemize"><B>May 17, 2002</B>: Changed the representation of functions to move the
+&#8220;inline&#8221; information to the varinfo. This way we can print the &#8220;inline&#8221;
+even in declarations which is what gcc does.
+<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the visitor for initializers to make two
+tail-recursive passes (the second is a <TT>List.rev</TT> and only done if one of
+the initializers change). This prevents <TT>Stack_Overflow</TT> for large
+initializers. Also improved the processing of initializers when converting to
+CIL.
+<LI CLASS="li-itemize"><B>May 15, 2002</B>: Changed the front-end to allow the use of <TT>MSVC</TT>
+mode even on machines that do not have MSVC. The machine-dependent parameters
+for GCC will be used in that case.
+<LI CLASS="li-itemize"><B>May 11, 2002</B>: Changed the representation of formals in function
+types. Now the function type is purely functional.
+<LI CLASS="li-itemize"><B>May 4, 2002</B>: Added the function
+<A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> and changed <A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> to be
+tail recursive. This prevents stack overflow on huge files.
+<LI CLASS="li-itemize"><B>February 28, 2002</B>: Changed the significance of the
+<TT>CompoundInit</TT> in <A HREF="api/Cil.html#TYPEinit">Cil.init</A> to allow for missing initializers at the
+end of an array initializer. Added the API function
+<A HREF="api/Cil.html#VALfoldLeftCompoundAll">Cil.foldLeftCompoundAll</A>.
+</UL>
+<!--HTMLFOOT-->
+<!--ENDHTML-->
+<!--FOOTER-->
+<HR SIZE=2><BLOCKQUOTE CLASS="quote"><EM>This document was translated from L<sup>A</sup>T<sub>E</sub>X by
+</EM><A HREF="http://pauillac.inria.fr/~maranget/hevea/index.html"><EM>H<FONT SIZE=2><sup>E</sup></FONT>V<FONT SIZE=2><sup>E</sup></FONT>A</EM></A><EM>.</EM></BLOCKQUOTE></BODY>
+</HTML>
diff --git a/cil/doc/cil.version.tex b/cil/doc/cil.version.tex
new file mode 100644
index 0000000..c584859
--- /dev/null
+++ b/cil/doc/cil.version.tex
@@ -0,0 +1,2 @@
+\def\cilversion{1.3.5}
+\def\ccuredversion{@CCURED_VERSION@}
diff --git a/cil/doc/cil001.html b/cil/doc/cil001.html
new file mode 100644
index 0000000..5edc5da
--- /dev/null
+++ b/cil/doc/cil001.html
@@ -0,0 +1,134 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Introduction
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil002.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc1">1</A>&nbsp;&nbsp;Introduction</H2>
+New: CIL now has a Source Forge page:
+ <A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
+<BR>
+CIL (<B>C</B> <B>I</B>ntermediate <B>L</B>anguage) is a high-level representation
+along with a set of tools that permit easy analysis and source-to-source
+transformation of C programs.<BR>
+<BR>
+CIL is both lower-level than abstract-syntax trees, by clarifying ambiguous
+constructs and removing redundant ones, and also higher-level than typical
+intermediate languages designed for compilation, by maintaining types and a
+close relationship with the source program. The main advantage of CIL is that
+it compiles all valid C programs into a few core constructs with a very clean
+semantics. Also CIL has a syntax-directed type system that makes it easy to
+analyze and manipulate C programs. Furthermore, the CIL front-end is able to
+process not only ANSI-C programs but also those using Microsoft C or GNU C
+extensions. If you do not use CIL and want instead to use just a C parser and
+analyze programs expressed as abstract-syntax trees then your analysis will
+have to handle a lot of ugly corners of the language (let alone the fact that
+parsing C itself is not a trivial task). See Section&nbsp;<A HREF="cil016.html#sec-simplec">16</A> for some
+examples of such extreme programs that CIL simplifies for you.<BR>
+<BR>
+In essence, CIL is a highly-structured, &#8220;clean&#8221; subset of C. CIL features a
+reduced number of syntactic and conceptual forms. For example, all looping
+constructs are reduced to a single form, all function bodies are given
+explicit <TT>return</TT> statements, syntactic sugar like <TT>"-&gt;"</TT> is
+eliminated and function arguments with array types become pointers. (For an
+extensive list of how CIL simplifies C programs, see Section&nbsp;<A HREF="cil004.html#sec-cabs2cil">4</A>.)
+This reduces the number of cases that must be considered when manipulating a C
+program. CIL also separates type declarations from code and flattens scopes
+within function bodies. This structures the program in a manner more amenable
+to rapid analysis and transformation. CIL computes the types of all program
+expressions, and makes all type promotions and casts explicit. CIL supports
+all GCC and MSVC extensions except for nested functions and complex numbers.
+Finally, CIL organizes C's imperative features into expressions, instructions
+and statements based on the presence and absence of side-effects and
+control-flow. Every statement can be annotated with successor and predecessor
+information. Thus CIL provides an integrated program representation that can
+be used with routines that require an AST (e.g. type-based analyses and
+pretty-printers), as well as with routines that require a CFG (e.g., dataflow
+analyses). CIL also supports even lower-level representations (e.g.,
+three-address code), see Section&nbsp;<A HREF="ext.html#sec-Extension">8</A>. <BR>
+<BR>
+CIL comes accompanied by a number of Perl scripts that perform generally
+useful operations on code:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+A <A HREF="cil007.html#sec-driver">driver</A> which behaves as either the <TT>gcc</TT> or
+Microsoft VC compiler and can invoke the preprocessor followed by the CIL
+application. The advantage of this script is that you can easily use CIL and
+the analyses written for CIL with existing make files.
+<LI CLASS="li-itemize">A <A HREF="merger.html#sec-merger">whole-program merger</A> that you can use as a
+replacement for your compiler and it learns all the files you compile when you
+make a project and merges all of the preprocessed source files into a single
+one. This makes it easy to do whole-program analysis.
+<LI CLASS="li-itemize">A <A HREF="patcher.html#sec-patcher">patcher</A> makes it easy to create modified
+copies of the system include files. The CIL driver can then be told to use
+these patched copies instead of the standard ones.
+</UL>
+CIL has been tested very extensively. It is able to process the SPECINT95
+benchmarks, the Linux kernel, GIMP and other open-source projects. All of
+these programs are compiled to the simple CIL and then passed to <TT>gcc</TT> and
+they still run! We consider the compilation of Linux a major feat especially
+since Linux contains many of the ugly GCC extensions (see Section&nbsp;<A HREF="cil016.html#sec-ugly-gcc">16.2</A>).
+This adds to about 1,000,000 lines of code that we tested it on. It is also
+able to process the few Microsoft NT device drivers that we have had access
+to. CIL was tested against GCC's c-torture testsuite and (except for the tests
+involving complex numbers and inner functions, which CIL does not currently
+implement) CIL passes most of the tests. Specifically CIL fails 23 tests out
+of the 904 c-torture tests that it should pass. GCC itself fails 19 tests. A
+total of 1400 regression test cases are run automatically on each change to
+the CIL sources.<BR>
+<BR>
+CIL is relatively independent on the underlying machine and compiler. When
+you build it CIL will configure itself according to the underlying compiler.
+However, CIL has only been tested on Intel x86 using the gcc compiler on Linux
+and cygwin and using the MS Visual C compiler. (See below for specific
+versions of these compilers that we have used CIL for.)<BR>
+<BR>
+The largest application we have used CIL for is
+<A HREF="javascript:loadTop('../ccured/index.html')">CCured</A>, a compiler that compiles C code into
+type-safe code by analyzing your pointer usage and inserting runtime checks in
+the places that cannot be guaranteed statically to be type safe. <BR>
+<BR>
+You can also use CIL to &#8220;compile&#8221; code that uses GCC extensions (e.g. the
+Linux kernel) into standard C code.<BR>
+<BR>
+CIL also comes accompanies by a growing library of extensions (see
+Section&nbsp;<A HREF="ext.html#sec-Extension">8</A>). You can use these for your projects or as examples of
+using CIL. <BR>
+<BR>
+<TT>PDF</TT> versions of <A HREF="CIL.pdf">this manual</A> and the
+<A HREF="CIL-API.pdf">CIL API</A> are available. However, we recommend the
+<TT>HTML</TT> versions because the postprocessed code examples are easier to
+view. <BR>
+<BR>
+If you use CIL in your project, we would appreciate letting us know. If you
+want to cite CIL in your research writings, please refer to the paper &#8220;CIL:
+Intermediate Language and Tools for Analysis and Transformation of C
+Programs&#8221; by George C. Necula, Scott McPeak, S.P. Rahul and Westley Weimer,
+in &#8220;Proceedings of Conference on Compilier Construction&#8221;, 2002.<BR>
+<BR>
+<HR>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil002.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil002.html b/cil/doc/cil002.html
new file mode 100644
index 0000000..e575ce3
--- /dev/null
+++ b/cil/doc/cil002.html
@@ -0,0 +1,98 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Installation
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil001.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil003.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc2">2</A>&nbsp;&nbsp;Installation</H2>
+You will need OCaml release 3.08 or higher to build CIL. CIL has been tested
+on Linux and on Windows (where it can behave at either Microsoft Visual C or
+gcc).<BR>
+<BR>
+If you want to use CIL on Windows then you must get a complete installation
+of <TT>cygwin</TT> and the source-code OCaml distribution and compile it yourself
+using the cygwin tools (as opposed to getting the Win32 native-code version of
+OCaml). If you have not done this before then take a look
+<A HREF="../ccured/setup.html">here</A>. (Don't need to worry about <TT>cvs</TT> and
+<TT>ssh</TT> unless you will need to use the master CVS repository for CIL.)
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Download the CIL <A HREF="distrib">distribution</A> (latest version is
+<A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>). See the Section&nbsp;<A HREF="changes.html#sec-changes">20</A> for recent changes to the CIL distribution.
+<LI CLASS="li-enumerate">Unzip and untar the source distribution. This will create a directory
+ called <TT>cil</TT> whose structure is explained below.<BR>
+<TT>tar xvfz cil-1.3.5.tar.gz</TT>
+<LI CLASS="li-enumerate">Enter the <TT>cil</TT> directory and run the <TT>configure</TT> script and then
+ GNU make to build the distribution. If you are on Windows, at least the
+ <TT>configure</TT> step must be run from within <TT>bash</TT>.<BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>cd cil</CODE><BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>./configure</CODE><BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>make</CODE><BR>
+&nbsp;&nbsp;&nbsp;&nbsp;<CODE>make quicktest</CODE><BR>
+<LI CLASS="li-enumerate">You should now find <TT>cilly.asm.exe</TT> in a
+subdirectory of <TT>obj</TT>. The name of the subdirectory is either <TT>x86_WIN32</TT>
+if you are using <TT>cygwin</TT> on Windows or <TT>x86_LINUX</TT> if you are using
+Linux (although you should be using instead the Perl wrapper <TT>bin/cilly</TT>).
+Note that we do not have an <TT>install</TT> make target and you should use Cil
+from the development directory.
+<LI CLASS="li-enumerate">If you decide to use CIL, <B>please</B>
+<A HREF="mailto:necula@cs.berkeley.edu">send us a note</A>. This will help recharge
+our batteries after more than a year of development. And of course, do send us
+your bug reports as well.</OL>
+The <TT>configure</TT> script tries to find appropriate defaults for your system.
+You can control its actions by passing the following arguments:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>CC=foo</TT> Specifies the path for the <TT>gcc</TT> executable. By default
+whichever version is in the PATH is used. If <TT>CC</TT> specifies the Microsoft
+<TT>cl</TT> compiler, then that compiler will be set as the default one. Otherwise,
+the <TT>gcc</TT> compiler will be the default.
+</UL>
+CIL requires an underlying C compiler and preprocessor. CIL depends on the
+underlying compiler and machine for the sizes and alignment of types.The
+installation procedure for CIL queries the underlying compiler for
+architecture and compiler dependent configuration parameters, such as the size
+of a pointer or the particular alignment rules for structure fields. (This
+means, of course, that you should re-run <TT>./configure</TT> when you move CIL to
+another machine.)<BR>
+<BR>
+We have tested CIL on the following compilers:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+On Windows, <TT>cl</TT> compiler version 12.00.8168 (MSVC 6),
+ 13.00.9466 (MSVC .Net), and 13.10.3077 (MSVC .Net 2003). Run <TT>cl</TT>
+ with no arguments to get the compiler version.
+<LI CLASS="li-itemize">On Windows, using <TT>cygwin</TT> and <TT>gcc</TT> version 2.95.3, 3.0,
+ 3.2, 3.3, and 3.4.
+<LI CLASS="li-itemize">On Linux, using <TT>gcc</TT> version 2.95.3, 3.0, 3.2, 3.3, and 4.0.
+</UL>
+Others have successfully used CIL with Mac OS X (on both PowerPC and
+x86), Solaris, and *BSD. If you make any changes to the build
+system in order to run CIL on your platform, please send us a patch.<BR>
+<BR>
+ <HR>
+<A HREF="cil001.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil003.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil003.html b/cil/doc/cil003.html
new file mode 100644
index 0000000..4b885f3
--- /dev/null
+++ b/cil/doc/cil003.html
@@ -0,0 +1,187 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Distribution Contents
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil002.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil004.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc3">3</A>&nbsp;&nbsp;Distribution Contents</H2>
+The file <A HREF="distrib/cil-1.3.5.tar.gz"><TT>distrib/cil-1.3.5.tar.gz</TT></A>
+contains the complete source CIL distribution,
+consisting of the following files:<BR>
+<TABLE CELLSPACING=2 CELLPADDING=0>
+<TR><TD ALIGN=left NOWRAP>Filename</TD>
+<TD ALIGN=left NOWRAP>Description</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>Makefile.in</TT></TD>
+<TD ALIGN=left NOWRAP><TT>configure</TT> source for the
+ Makefile that builds CIL</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>configure</TT></TD>
+<TD ALIGN=left NOWRAP>The configure script</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>configure.in</TT></TD>
+<TD ALIGN=left NOWRAP>The <TT>autoconf</TT> source for <TT>configure</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>config.guess</TT>, <TT>config.sub</TT>, <TT>install-sh</TT></TD>
+<TD ALIGN=left NOWRAP>stuff required by
+ <TT>configure</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>doc/</TT></TD>
+<TD ALIGN=left NOWRAP>HTML documentation of the CIL API</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>obj/</TT></TD>
+<TD ALIGN=left NOWRAP>Directory that will contain the compiled
+ CIL modules and executables</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>bin/cilly.in</TT></TD>
+<TD ALIGN=left NOWRAP>The <TT>configure</TT> source for a Perl script
+ that can be invoked with the
+ same arguments as either <TT>gcc</TT> or
+ Microsoft Visual C and will convert the
+ program to CIL, perform some simple
+ transformations, emit it and compile it as
+ usual.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>lib/CompilerStub.pm</TT></TD>
+<TD ALIGN=left NOWRAP>A Perl class that can be used to write code
+ that impersonates a compiler. <TT>cilly</TT>
+ uses it.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>lib/Merger.pm</TT></TD>
+<TD ALIGN=left NOWRAP>A subclass of <TT>CompilerStub.pm</TT> that can
+ be used to merge source files into a single
+ source file.<TT>cilly</TT>
+ uses it.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>bin/patcher.in</TT></TD>
+<TD ALIGN=left NOWRAP>A Perl script that applies specified patches
+ to standard include files.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/check.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Checks the well-formedness of a CIL file</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/cil.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Definition of CIL abstract syntax and
+ utilities for manipulating it</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/clist.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for efficiently managing lists
+ that need to be concatenated often</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/errormsg.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for error reporting</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/ext/heapify.ml</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL transformation that moves array local
+ variables from the stack to the heap</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/ext/logcalls.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL transformation that logs every
+ function call</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/ext/sfi.ml</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL transformation that can log every
+ memory read and write</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/clexer.mll</TT></TD>
+<TD ALIGN=left NOWRAP>The lexer</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cparser.mly</TT></TD>
+<TD ALIGN=left NOWRAP>The parser</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The abstract syntax</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cprint.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The pretty printer for CABS</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/frontc/cabs2cil.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The elaborator to CIL</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/main.ml</TT></TD>
+<TD ALIGN=left NOWRAP>The <TT>cilly</TT> application</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/pretty.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for pretty printing</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/rmtmps.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>A CIL tranformation that removes unused
+ types, variables and inlined functions</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/stats.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities for maintaining timing statistics</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/testcil.ml</TT></TD>
+<TD ALIGN=left NOWRAP>A random test of CIL (against the resident
+ C compiler)</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/trace.ml,mli</TT></TD>
+<TD ALIGN=left NOWRAP>Utilities useful for printing debugging
+ information</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/</TT></TD>
+<TD ALIGN=left NOWRAP>Miscellaneous libraries that are not
+ specific to CIL.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml</TT></TD>
+<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/Makefile.ocaml.build</TT></TD>
+<TD ALIGN=left NOWRAP>A file that is included by <TT>Makefile</TT></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>ocamlutil/perfcount.c</TT></TD>
+<TD ALIGN=left NOWRAP>C code that links with src/stats.ml
+ and reads Intel performance
+ counters.</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP>&nbsp;</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/feature_config.ml</TT></TD>
+<TD ALIGN=left NOWRAP>File generated by the Makefile
+ describing which extra &#8220;features&#8221;
+ to compile. See Section&nbsp;<A HREF="cilly.html#sec-cil">5</A></TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>obj/@ARCHOS@/machdep.ml</TT></TD>
+<TD ALIGN=left NOWRAP>File generated by the Makefile containing
+ information about your architecture,
+ such as the size of a pointer</TD>
+</TR>
+<TR><TD ALIGN=left NOWRAP><TT>src/machdep.c</TT></TD>
+<TD ALIGN=left NOWRAP>C program that generates
+ <TT>machdep.ml</TT> files</TD>
+</TR></TABLE><BR>
+<HR>
+<A HREF="cil002.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil004.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil004.html b/cil/doc/cil004.html
new file mode 100644
index 0000000..16fde39
--- /dev/null
+++ b/cil/doc/cil004.html
@@ -0,0 +1,350 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Compiling C to CIL
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil003.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cilly.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc4">4</A>&nbsp;&nbsp;Compiling C to CIL</H2><A NAME="sec-cabs2cil"></A>
+In this section we try to describe a few of the many transformations that are
+applied to a C program to convert it to CIL. The module that implements this
+conversion is about 5000 lines of OCaml code. In contrast a simple program
+transformation that instruments all functions to keep a shadow stack of the
+true return address (thus preventing stack smashing) is only 70 lines of code.
+This example shows that the analysis is so much simpler because it has to
+handle only a few simple C constructs and also because it can leverage on CIL
+infrastructure such as visitors and pretty-printers.<BR>
+<BR>
+In no particular order these are a few of the most significant ways in which
+C programs are compiled into CIL:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+CIL will eliminate all declarations for unused entities. This means that
+just because your hello world program includes <TT>stdio.h</TT> it does not mean
+that your analysis has to handle all the ugly stuff from <TT>stdio.h</TT>.<BR>
+<BR>
+<LI CLASS="li-enumerate">Type specifiers are interpreted and normalized:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int long signed x;
+signed long extern x;
+long static int long y;
+
+// Some code that uses these declaration, so that CIL does not remove them
+int main() { return x + y; }
+</FONT></PRE>
+See the <A HREF="examples/ex1.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Anonymous structure and union declarations are given a name.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ struct { int x; } s;
+</FONT></PRE>
+See the <A HREF="examples/ex2.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Nested structure tag definitions are pulled apart. This means that all
+structure tag definitions can be found by a simple scan of the globals.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct foo {
+ struct bar {
+ union baz {
+ int x1;
+ double x2;
+ } u1;
+ int y;
+ } s1;
+ int z;
+} f;
+</FONT></PRE>
+See the <A HREF="examples/ex3.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">All structure, union, enumeration definitions and the type definitions
+from inners scopes are moved to global scope (with appropriate renaming). This
+facilitates moving around of the references to these entities.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int main() {
+ struct foo {
+ int x; } foo;
+ {
+ struct foo {
+ double d;
+ };
+ return foo.x;
+ }
+}
+</FONT></PRE>
+See the <A HREF="examples/ex4.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Prototypes are added for those functions that are called before being
+defined. Furthermore, if a prototype exists but does not specify the type of
+parameters that is fixed. But CIL will not be able to add prototypes for those
+functions that are neither declared nor defined (but are used!).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int f(); // Prototype without arguments
+ int f(double x) {
+ return g(x);
+ }
+ int g(double x) {
+ return x;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex5.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Array lengths are computed based on the initializers or by constant
+folding.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int a1[] = {1,2,3};
+ int a2[sizeof(int) &gt;= 4 ? 8 : 16];
+</FONT></PRE>
+See the <A HREF="examples/ex6.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Enumeration tags are computed using constant folding:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int main() {
+ enum {
+ FIVE = 5,
+ SIX, SEVEN,
+ FOUR = FIVE - 1,
+ EIGHT = sizeof(double)
+ } x = FIVE;
+ return x;
+}
+
+</FONT></PRE>
+See the <A HREF="examples/ex7.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializers are normalized to include specific initialization for the
+missing elements:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int a1[5] = {1,2,3};
+ struct foo { int x, y; } s1 = { 4 };
+</FONT></PRE>
+See the <A HREF="examples/ex8.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializer designators are interpreted and eliminated. Subobjects are
+properly marked with braces. CIL implements
+the whole ISO C99 specification for initializer (neither GCC nor MSVC do) and
+a few GCC extensions.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ struct foo {
+ int x, y;
+ int a[5];
+ struct inner {
+ int z;
+ } inner;
+ } s = { 0, .inner.z = 3, .a[1 ... 2] = 5, 4, y : 8 };
+</FONT></PRE>
+See the <A HREF="examples/ex9.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">String initializers for arrays of characters are processed
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+char foo[] = "foo plus bar";
+</FONT></PRE>
+See the <A HREF="examples/ex10.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">String constants are concatenated
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+char *foo = "foo " " plus " " bar ";
+</FONT></PRE>
+See the <A HREF="examples/ex11.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializers for local variables are turned into assignments. This is in
+order to separate completely the declarative part of a function body from the
+statements. This has the unfortunate effect that we have to drop the <TT>const</TT>
+qualifier from local variables !
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5;
+ struct foo { int f1, f2; } a [] = {1, 2, 3, 4, 5 };
+</FONT></PRE>
+See the <A HREF="examples/ex12.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Local variables in inner scopes are pulled to function scope (with
+appropriate renaming). Local scopes thus disappear. This makes it easy to find
+and operate on all local variables in a function.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5;
+ int main() {
+ int x = 6;
+ {
+ int x = 7;
+ return x;
+ }
+ return x;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex13.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Global declarations in local scopes are moved to global scope:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5;
+ int main() {
+ int x = 6;
+ {
+ static int x = 7;
+ return x;
+ }
+ return x;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex14.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Return statements are added for functions that are missing them. If the
+return type is not a base type then a <TT>return</TT> without a value is added.
+The guaranteed presence of return statements makes it easy to implement a
+transformation that inserts some code to be executed immediately before
+returning from a function.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo() {
+ int x = 5;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex15.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">One of the most significant transformations is that expressions that
+contain side-effects are separated into statements.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, f(int);
+ return (x ++ + f(x));
+</FONT></PRE>
+See the <A HREF="examples/ex16.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+Internally, the <TT>x ++</TT> statement is turned into an assignment which the
+pretty-printer prints like the original. CIL has only three forms of basic
+statements: assignments, function calls and inline assembly.<BR>
+<BR>
+<LI CLASS="li-enumerate">Shortcut evaluation of boolean expressions and the <TT>?:</TT> operator are
+compiled into explicit conditionals:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x;
+ int y = x ? 2 : 4;
+ int z = x || y;
+ // Here we duplicate the return statement
+ if(x &amp;&amp; y) { return 0; } else { return 1; }
+ // To avoid excessive duplication, CIL uses goto's for
+ // statement that have more than 5 instructions
+ if(x &amp;&amp; y || z) { x ++; y ++; z ++; x ++; y ++; return z; }
+</FONT></PRE>
+See the <A HREF="examples/ex17.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC's conditional expression with missing operands are also compiled
+into conditionals:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int f();;
+ return f() ? : 4;
+</FONT></PRE>
+See the <A HREF="examples/ex18.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">All forms of loops (<TT>while</TT>, <TT>for</TT> and <TT>do</TT>) are compiled
+internally as a single <TT>while(1)</TT> looping construct with explicit <TT>break</TT>
+statement for termination. For simple <TT>while</TT> loops the pretty printer is
+able to print back the original:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, y;
+ for(int i = 0; i&lt;5; i++) {
+ if(i == 5) continue;
+ if(i == 4) break;
+ i += 2;
+ }
+ while(x &lt; 5) {
+ if(x == 3) continue;
+ x ++;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex19.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC's block expressions are compiled away. (That's right there is an
+infinite loop in this code.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x = 5, y = x;
+ int z = ({ x++; L: y -= x; y;});
+ return ({ goto L; 0; });
+</FONT></PRE>
+See the <A HREF="examples/ex20.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL contains support for both MSVC and GCC inline assembly (both in one
+internal construct)<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL compiles away the GCC extension that allows many kinds of constructs
+to be used as lvalues:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, y, z;
+ return &amp;(x ? y : z) - &amp; (x ++, x);
+</FONT></PRE>
+See the <A HREF="examples/ex21.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">All types are computed and explicit casts are inserted for all
+promotions and conversions that a compiler must insert:<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL will turn old-style function definition (without prototype) into
+new-style definitions. This will make the compiler less forgiving when
+checking function calls, and will catch for example cases when a function is
+called with too few arguments. This happens in old-style code for the purpose
+of implementing variable argument functions.<BR>
+<BR>
+<LI CLASS="li-enumerate">Since CIL sees the source after preprocessing the code after CIL does
+not contain the comments and the preprocessing directives.<BR>
+<BR>
+<LI CLASS="li-enumerate">CIL will remove from the source file those type declarations, local
+variables and inline functions that are not used in the file. This means that
+your analysis does not have to see all the ugly stuff that comes from the
+header files:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+#include &lt;stdio.h&gt;
+
+typedef int unused_type;
+
+static char unused_static (void) { return 0; }
+
+int main() {
+ int unused_local;
+ printf("Hello world\n"); // Only printf will be kept from stdio.h
+}
+</FONT></PRE>
+See the <A HREF="examples/ex22.txt">CIL output</A> for this
+code fragment</OL>
+<HR>
+<A HREF="cil003.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cilly.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil006.html b/cil/doc/cil006.html
new file mode 100644
index 0000000..8fc3194
--- /dev/null
+++ b/cil/doc/cil006.html
@@ -0,0 +1,627 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+CIL API Documentation
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cilly.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil007.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc8">6</A>&nbsp;&nbsp;CIL API Documentation</H2><A NAME="sec-api"></A>
+The CIL API is documented in the file <TT>src/cil.mli</TT>. We also have an
+<A HREF="api/index.html">online documentation</A> extracted from <TT>cil.mli</TT>. We
+index below the main types that are used to represent C programs in CIL:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/index_types.html">An index of all types</A>
+<LI CLASS="li-itemize"><A HREF="api/index_values.html">An index of all values</A>
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfile">Cil.file</A> is the representation of a file.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEglobal">Cil.global</A> is the representation of a global declaration or
+definitions. Values for <A HREF="api/Cil.html#VALemptyFunction">operating on globals</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEtyp">Cil.typ</A> is the representation of a type.
+Values for <A HREF="api/Cil.html#VALvoidType">operating on types</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEcompinfo">Cil.compinfo</A> is the representation of a structure or a union
+type
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfieldinfo">Cil.fieldinfo</A> is the representation of a field in a structure
+or a union
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEenuminfo">Cil.enuminfo</A> is the representation of an enumeration type.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEvarinfo">Cil.varinfo</A> is the representation of a variable
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEfundec">Cil.fundec</A> is the representation of a function
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPElval">Cil.lval</A> is the representation of an lvalue.
+Values for <A HREF="api/Cil.html#VALmakeVarInfo">operating on lvalues</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEexp">Cil.exp</A> is the representation of an expression without
+side-effects.
+Values for <A HREF="api/Cil.html#VALzero">operating on expressions</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEinstr">Cil.instr</A> is the representation of an instruction (with
+side-effects but without control-flow)
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> is the representation of a control-flow statements.
+Values for <A HREF="api/Cil.html#VALmkStmt">operating on statements</A>.
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A> is the representation of attributes.
+Values for <A HREF="api/Cil.html#TYPEattributeClass">operating on attributes</A>.
+</UL>
+<A NAME="toc3"></A>
+<H3 CLASS="subsection"><A NAME="htoc9">6.1</A>&nbsp;&nbsp;Using the visitor</H3><A NAME="sec-visitor"></A>
+One of the most useful tools exported by the CIL API is an implementation of
+the visitor pattern for CIL programs. The visiting engine scans depth-first
+the structure of a CIL program and at each node is queries a user-provided
+visitor structure whether it should do one of the following operations:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+Ignore this node and all its descendants
+<LI CLASS="li-itemize">Descend into all of the children and when done rebuild the node if any
+of the children have changed.
+<LI CLASS="li-itemize">Replace the subtree rooted at the node with another tree.
+<LI CLASS="li-itemize">Replace the subtree with another tree, then descend into the children
+and rebuild the node if necessary and then invoke a user-specified function.
+<LI CLASS="li-itemize">In addition to all of the above actions then visitor can specify that
+some instructions should be queued to be inserted before the current
+instruction or statement being visited.
+</UL>
+By writing visitors you can customize the program traversal and
+transformation. One major limitation of the visiting engine is that it does
+not propagate information from one node to another. Each visitor must use its
+own private data to achieve this effect if necessary. <BR>
+<BR>
+Each visitor is an object that is an instance of a class of type <A HREF="api/Cil.cilVisitor.html#.">Cil.cilVisitor..</A>
+The most convenient way to obtain such classes is to specialize the
+<A HREF="api/Cil.nopCilVisitor.html#c">Cil.nopCilVisitor.c</A>lass (which just traverses the tree doing
+nothing). Any given specialization typically overrides only a few of the
+methods. Take a look for example at the visitor defined in the module
+<TT>logwrites.ml</TT>. Another, more elaborate example of a visitor is the
+[copyFunctionVisitor] defined in <TT>cil.ml</TT>.<BR>
+<BR>
+Once you have defined a visitor you can invoke it with one of the functions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Cil.html#VALvisitCilFile">Cil.visitCilFile</A> or <A HREF="api/Cil.html#VALvisitCilFileSameGlobals">Cil.visitCilFileSameGlobals</A> - visit a file
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilGlobal">Cil.visitCilGlobal</A> - visit a global
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilFunction">Cil.visitCilFunction</A> - visit a function definition
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilExp">Cil.visitCilExp</A> - visit an expression
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilLval">Cil.visitCilLval</A> - visit an lvalue
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilInstr">Cil.visitCilInstr</A> - visit an instruction
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilStmt">Cil.visitCilStmt</A> - visit a statement
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALvisitCilType">Cil.visitCilType</A> - visit a type. Note that this does not visit
+the files of a composite type. use visitGlobal to visit the [GCompTag] that
+defines the fields.
+</UL>
+Some transformations may want to use visitors to insert additional
+instructions before statements and instructions. To do so, pass a list of
+instructions to the <A HREF="api/Cil.html#VALqueueInstr">Cil.queueInstr</A> method of the specialized
+object. The instructions will automatically be inserted before that
+instruction in the transformed code. The <A HREF="api/Cil.html#VALunqueueInstr">Cil.unqueueInstr</A> method
+should not normally be called by the user. <BR>
+<BR>
+<A NAME="toc4"></A>
+<H3 CLASS="subsection"><A NAME="htoc10">6.2</A>&nbsp;&nbsp;Interpreted Constructors and Deconstructors</H3>
+Interpreted constructors and deconstructors are a facility for constructing
+and deconstructing CIL constructs using a pattern with holes that can be
+filled with a variety of kinds of elements. The pattern is a string that uses
+the C syntax to represent C language elements. For example, the following
+code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.cType "void * const (*)(int x)"
+</FONT></PRE>
+is an alternative way to construct the internal representation of the type of pointer to function
+with an integer argument and a void * const as result:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+TPtr(TFun(TVoid [Attr("const", [])],
+ [ ("x", TInt(IInt, []), []) ], false, []), [])
+</FONT></PRE>
+The advantage of the interpreted constructors is that you can use familiar C
+syntax to construct CIL abstract-syntax trees. <BR>
+<BR>
+You can construct this way types, lvalues, expressions, instructions and
+statements. The pattern string can also contain a number of placeholders that
+are replaced during construction with CIL items passed as additional argument
+to the construction function. For example, the <TT>%e:id</TT> placeholder means
+that the argument labeled &#8220;id&#8221; (expected to be of form <TT>Fe exp</TT>) will
+supply the expression to replace the placeholder. For example, the following
+code constructs an increment instruction at location <TT>loc</TT>:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.cInstr "%v:x = %v:x + %e:something"
+ loc
+ [ ("something", Fe some_exp);
+ ("x", Fv some_varinfo) ]
+</FONT></PRE>
+An alternative way to construct the same CIL instruction is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Set((Var some_varinfo, NoOffset),
+ BinOp(PlusA, Lval (Var some_varinfo, NoOffset),
+ some_exp, intType),
+ loc)
+</FONT></PRE>
+See <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> for a definition of the placeholders that are
+understood.<BR>
+<BR>
+A dual feature is the interpreted deconstructors. This can be used to test
+whether a CIL construct has a certain form:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.dType "void * const (*)(int x)" t
+</FONT></PRE>
+will test whether the actual argument <TT>t</TT> is indeed a function pointer of
+the required type. If it is then the result is <TT>Some []</TT> otherwise it is
+<TT>None</TT>. Furthermore, for the purpose of the interpreted deconstructors
+placeholders in patterns match anything of the right type. For example,
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.dType "void * (*)(%F:t)" t
+</FONT></PRE>
+will match any function pointer type, independent of the type and number of
+the formals. If the match succeeds the result is <TT>Some [ FF forms ]</TT> where
+<TT>forms</TT> is a list of names and types of the formals. Note that each member
+in the resulting list corresponds positionally to a placeholder in the
+pattern.<BR>
+<BR>
+The interpreted constructors and deconstructors do not support the complete C
+syntax, but only a substantial fragment chosen to simplify the parsing. The
+following is the syntax that is supported:
+<PRE CLASS="verbatim">
+Expressions:
+ E ::= %e:ID | %d:ID | %g:ID | n | L | ( E ) | Unop E | E Binop E
+ | sizeof E | sizeof ( T ) | alignof E | alignof ( T )
+ | &amp; L | ( T ) E
+
+Unary operators:
+ Unop ::= + | - | ~ | %u:ID
+
+Binary operators:
+ Binop ::= + | - | * | / | &lt;&lt; | &gt;&gt; | &amp; | ``|'' | ^
+ | == | != | &lt; | &gt; | &lt;= | &gt;= | %b:ID
+
+Lvalues:
+ L ::= %l:ID | %v:ID Offset | * E | (* E) Offset | E -&gt; ident Offset
+
+Offsets:
+ Offset ::= empty | %o:ID | . ident Offset | [ E ] Offset
+
+Types:
+ T ::= Type_spec Attrs Decl
+
+Type specifiers:
+ Type_spec ::= void | char | unsigned char | short | unsigned short
+ | int | unsigned int | long | unsigned long | %k:ID | float
+ | double | struct %c:ID | union %c:ID
+
+
+Declarators:
+ Decl ::= * Attrs Decl | Direct_decl
+
+
+Direct declarators:
+ Direct_decl ::= empty | ident | ( Attrs Decl )
+ | Direct_decl [ Exp_opt ]
+ | ( Attrs Decl )( Parameters )
+
+Optional expressions
+ Exp_opt ::= empty | E | %eo:ID
+
+Formal parameters
+ Parameters ::= empty | ... | %va:ID | %f:ID | T | T , Parameters
+
+List of attributes
+ Attrs ::= empty | %A:ID | Attrib Attrs
+
+Attributes
+ Attrib ::= const | restrict | volatile | __attribute__ ( ( GAttr ) )
+
+GCC Attributes
+ GAttr ::= ident | ident ( AttrArg_List )
+
+Lists of GCC Attribute arguments:
+ AttrArg_List ::= AttrArg | %P:ID | AttrArg , AttrArg_List
+
+GCC Attribute arguments
+ AttrArg ::= %p:ID | ident | ident ( AttrArg_List )
+
+Instructions
+ Instr ::= %i:ID ; | L = E ; | L Binop= E | Callres L ( Args )
+
+Actual arguments
+ Args ::= empty | %E:ID | E | E , Args
+
+Call destination
+ Callres ::= empty | L = | %lo:ID
+
+Statements
+ Stmt ::= %s:ID | if ( E ) then Stmt ; | if ( E ) then Stmt else Stmt ;
+ | return Exp_opt | break ; | continue ; | { Stmt_list }
+ | while (E ) Stmt | Instr_list
+
+Lists of statements
+ Stmt_list ::= empty | %S:ID | Stmt Stmt_list
+ | Type_spec Attrs Decl ; Stmt_list
+ | Type_spec Attrs Decl = E ; Stmt_list
+ | Type_spec Attrs Decl = L (Args) ; Stmt_list
+
+List of instructions
+ Instr_list ::= Instr | %I:ID | Instr Instr_list
+</PRE>
+Notes regarding the syntax:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+In the grammar description above non-terminals are written with
+uppercase initial<BR>
+<BR>
+<LI CLASS="li-itemize">All of the patterns consist of the <TT>%</TT> character followed by one or
+two letters, followed by &#8220;:&#8221; and an indentifier. For each such
+pattern there is a corresponding constructor of the <A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A>
+type, whose name is the letter 'F' followed by the same one or two letters as
+in the pattern. That constructor is used by the user code to pass a
+<A HREF="api/Cil.html#TYPEformatArg">Cil.formatArg</A> actual argument to the interpreted constructor and by
+the interpreted deconstructor to return what was matched for a pattern.<BR>
+<BR>
+<LI CLASS="li-itemize">If the pattern name is uppercase, it designates a list of the elements
+designated by the corresponding lowercase pattern. E.g. %E designated lists
+of expressions (as in the actual arguments of a call).<BR>
+<BR>
+<LI CLASS="li-itemize">The two-letter patterns whose second letter is &#8220;o&#8221; designate an
+optional element. E.g. %eo designates an optional expression (as in the
+length of an array). <BR>
+<BR>
+<LI CLASS="li-itemize">Unlike in calls to <TT>printf</TT>, the pattern %g is used for strings. <BR>
+<BR>
+<LI CLASS="li-itemize">The usual precedence and associativity rules as in C apply <BR>
+<BR>
+<LI CLASS="li-itemize">The pattern string can contain newlines and comments, using both the
+<TT>/* ... */</TT> style as well as the <TT>//</TT> one. <BR>
+<BR>
+<LI CLASS="li-itemize">When matching a &#8220;cast&#8221; pattern of the form <TT>( T ) E</TT>, the
+deconstructor will match even expressions that do not have the actual cast but
+in that case the type is matched against the type of the expression. E.g. the
+patters <TT>"(int)%e"</TT> will match any expression of type <TT>int</TT> whether it
+has an explicit cast or not. <BR>
+<BR>
+<LI CLASS="li-itemize">The %k pattern is used to construct and deconstruct an integer type of
+any kind. <BR>
+<BR>
+<LI CLASS="li-itemize">Notice that the syntax of types and declaration are the same (in order
+to simplify the parser). This means that technically you can write a whole
+declaration instead of a type in the cast. In this case the name that you
+declare is ignored.<BR>
+<BR>
+<LI CLASS="li-itemize">In lists of formal parameters and lists of attributes, an empty list in
+the pattern matches any formal parameters or attributes. <BR>
+<BR>
+<LI CLASS="li-itemize">When matching types, uses of named types are unrolled to expose a real
+type before matching. <BR>
+<BR>
+<LI CLASS="li-itemize">The order of the attributes is ignored during matching. The the pattern
+for a list of attributes contains %A then the resulting <TT>formatArg</TT> will be
+bound to <B>all</B> attributes in the list. For example, the pattern <TT>"const
+%A"</TT> matches any list of attributes that contains <TT>const</TT> and binds the
+corresponding placeholder to the entire list of attributes, including
+<TT>const</TT>. <BR>
+<BR>
+<LI CLASS="li-itemize">All instruction-patterns must be terminated by semicolon<BR>
+<BR>
+<LI CLASS="li-itemize">The autoincrement and autodecrement instructions are not supported. Also
+not supported are complex expressions, the <TT>&amp;&amp;</TT> and <TT>||</TT> shortcut
+operators, and a number of other more complex instructions or statements. In
+general, the patterns support only constructs that can be represented directly
+in CIL.<BR>
+<BR>
+<LI CLASS="li-itemize">The pattern argument identifiers are not used during deconstruction.
+Instead, the result contains a sequence of values in the same order as the
+appearance of pattern arguments in the pattern.<BR>
+<BR>
+<LI CLASS="li-itemize">You can mix statements with declarations. For each declaration a new
+ temporary will be constructed (using a function you provive). You can then
+ refer to that temporary by name in the rest of the pattern.<BR>
+<BR>
+<LI CLASS="li-itemize">The <TT>%v:</TT> pattern specifier is optional.
+</UL>
+The following function are defined in the <TT>Formatcil</TT> module for
+constructing and deconstructing:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Formatcil.html#VALcExp">Formatcil.cExp</A> constructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcType">Formatcil.cType</A> constructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcLval">Formatcil.cLval</A> constructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcInstr">Formatcil.cInstr</A> constructs <A HREF="api/Cil.html#TYPEinstr">Cil.instr</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALcStmt">Formatcil.cStmt</A> and <A HREF="api/Formatcil.html#VALcStmts">Formatcil.cStmts</A> construct <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdExp">Formatcil.dExp</A> deconstructs <A HREF="api/Cil.html#TYPEexp">Cil.exp</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdType">Formatcil.dType</A> deconstructs <A HREF="api/Cil.html#TYPEtyp">Cil.typ</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdLval">Formatcil.dLval</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
+<LI CLASS="li-itemize"><A HREF="api/Formatcil.html#VALdInstr">Formatcil.dInstr</A> deconstructs <A HREF="api/Cil.html#TYPElval">Cil.lval</A>.
+</UL>
+Below is an example using interpreted constructors. This example generates
+the CIL representation of code that scans an array backwards and initializes
+every even-index element with an expression:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+Formatcil.cStmts
+ loc
+ "int idx = sizeof(array) / sizeof(array[0]) - 1;
+ while(idx &gt;= 0) {
+ // Some statements to be run for all the elements of the array
+ %S:init
+ if(! (idx &amp; 1))
+ array[idx] = %e:init_even;
+ /* Do not forget to decrement the index variable */
+ idx = idx - 1;
+ }"
+ (fun n t -&gt; makeTempVar myfunc ~name:n t)
+ [ ("array", Fv myarray);
+ ("init", FS [stmt1; stmt2; stmt3]);
+ ("init_even", Fe init_expr_for_even_elements) ]
+</FONT></PRE>
+To write the same CIL statement directly in CIL would take much more effort.
+Note that the pattern is parsed only once and the result (a function that
+takes the arguments and constructs the statement) is memoized. <BR>
+<BR>
+
+<H4 CLASS="subsubsection"><A NAME="htoc11">6.2.1</A>&nbsp;&nbsp;Performance considerations for interpreted constructors</H4>
+Parsing the patterns is done with a LALR parser and it takes some time. To
+improve performance the constructors and deconstructors memoize the parsed
+patterns and will only compile a pattern once. Also all construction and
+deconstruction functions can be applied partially to the pattern string to
+produce a function that can be later used directly to construct or
+deconstruct. This function appears to be about two times slower than if the
+construction is done using the CIL constructors (without memoization the
+process would be one order of magnitude slower.) However, the convenience of
+interpreted constructor might make them a viable choice in many situations
+when performance is not paramount (e.g. prototyping).<BR>
+<BR>
+<A NAME="toc5"></A>
+<H3 CLASS="subsection"><A NAME="htoc12">6.3</A>&nbsp;&nbsp;Printing and Debugging support</H3>
+The Modules <A HREF="api/Pretty.html">Pretty</A> and <A HREF="api/Errormsg.html">Errormsg</A> contain respectively
+utilities for pretty printing and reporting errors and provide a convenient
+<TT>printf</TT>-like interface. <BR>
+<BR>
+Additionally, CIL defines for each major type a pretty-printing function that
+you can use in conjunction with the <A HREF="api/Pretty.html">Pretty</A> interface. The
+following are some of the pretty-printing functions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Cil.html#VALd_exp">Cil.d_exp</A> - print an expression
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_type">Cil.d_type</A> - print a type
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_lval">Cil.d_lval</A> - print an lvalue
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_global">Cil.d_global</A> - print a global
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_stmt">Cil.d_stmt</A> - print a statment
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_instr">Cil.d_instr</A> - print an instruction
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_init">Cil.d_init</A> - print an initializer
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attr">Cil.d_attr</A> - print an attribute
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_attrlist">Cil.d_attrlist</A> - print a set of attributes
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_loc">Cil.d_loc</A> - print a location
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_ikind">Cil.d_ikind</A> - print an integer kind
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_fkind">Cil.d_fkind</A> - print a floating point kind
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_const">Cil.d_const</A> - print a constant
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALd_storage">Cil.d_storage</A> - print a storage specifier
+</UL>
+You can even customize the pretty-printer by creating instances of
+<A HREF="api/Cil.cilPrinter.html#.">Cil.cilPrinter..</A> Typically such an instance extends
+<A HREF="api/Cil.html#VALdefaultCilPrinter">Cil.defaultCilPrinter</A>. Once you have a customized pretty-printer you
+can use the following printing functions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<A HREF="api/Cil.html#VALprintExp">Cil.printExp</A> - print an expression
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintType">Cil.printType</A> - print a type
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintLval">Cil.printLval</A> - print an lvalue
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintGlobal">Cil.printGlobal</A> - print a global
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintStmt">Cil.printStmt</A> - print a statment
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInstr">Cil.printInstr</A> - print an instruction
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintInit">Cil.printInit</A> - print an initializer
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttr">Cil.printAttr</A> - print an attribute
+<LI CLASS="li-itemize"><A HREF="api/Cil.html#VALprintAttrs">Cil.printAttrs</A> - print a set of attributes
+</UL>
+CIL has certain internal consistency invariants. For example, all references
+to a global variable must point to the same <TT>varinfo</TT> structure. This
+ensures that one can rename the variable by changing the name in the
+<TT>varinfo</TT>. These constraints are mentioned in the API documentation. There
+is also a consistency checker in file <TT>src/check.ml</TT>. If you suspect that
+your transformation is breaking these constraints then you can pass the
+<TT>--check</TT> option to cilly and this will ensure that the consistency checker
+is run after each transformation. <BR>
+<BR>
+<A NAME="toc6"></A>
+<H3 CLASS="subsection"><A NAME="htoc13">6.4</A>&nbsp;&nbsp;Attributes</H3><A NAME="sec-attrib"></A>
+In CIL you can attach attributes to types and to names (variables, functions
+and fields). Attributes are represented using the type <A HREF="api/Cil.html#TYPEattribute">Cil.attribute</A>.
+An attribute consists of a name and a number of arguments (represented using
+the type <A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). Almost any expression can be used as an
+attribute argument. Attributes are stored in lists sorted by the name of the
+attribute. To maintain list ordering, use the functions
+<A HREF="api/Cil.html#VALtypeAttrs">Cil.typeAttrs</A> to retrieve the attributes of a type and the functions
+<A HREF="api/Cil.html#VALaddAttribute">Cil.addAttribute</A> and <A HREF="api/Cil.html#VALaddAttributes">Cil.addAttributes</A> to add attributes.
+Alternatively you can use <A HREF="api/Cil.html#VALtypeAddAttributes">Cil.typeAddAttributes</A> to add an attribute to
+a type (and return the new type).<BR>
+<BR>
+GCC already has extensive support for attributes, and CIL extends this
+support to user-defined attributes. A GCC attribute has the syntax:
+<PRE CLASS="verbatim">
+ gccattribute ::= __attribute__((attribute)) (Note the double parentheses)
+</PRE>
+ Since GCC and MSVC both support various flavors of each attribute (with or
+without leading or trailing _) we first strip ALL leading and trailing _
+from the attribute name (but not the identified in [ACons] parameters in
+<A HREF="api/Cil.html#TYPEattrparam">Cil.attrparam</A>). When we print attributes, for GCC we add two leading
+and two trailing _; for MSVC we add just two leading _.<BR>
+<BR>
+There is support in CIL so that you can control the printing of attributes
+(see <A HREF="api/Cil.html#VALsetCustomPrintAttribute">Cil.setCustomPrintAttribute</A> and
+<A HREF="api/Cil.html#VALsetCustomPrintAttributeScope">Cil.setCustomPrintAttributeScope</A>). This custom-printing support is now
+used to print the "const" qualifier as "<TT>const</TT>" and not as
+"<TT>__attribute__((const))</TT>".<BR>
+<BR>
+The attributes are specified in declarations. This is unfortunate since the C
+syntax for declarations is already quite complicated and after writing the
+parser and elaborator for declarations I am convinced that few C programmers
+understand it completely. Anyway, this seems to be the easiest way to support
+attributes. <BR>
+<BR>
+Name attributes must be specified at the very end of the declaration, just
+before the <TT>=</TT> for the initializer or before the <TT>,</TT> the separates a
+declaration in a group of declarations or just before the <TT>;</TT> that
+terminates the declaration. A name attribute for a function being defined can
+be specified just before the brace that starts the function body.<BR>
+<BR>
+For example (in the following examples <TT>A1</TT>,...,<TT>An</TT> are type attributes
+and <TT>N</TT> is a name attribute (each of these uses the <TT>__attribute__</TT> syntax):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x N;
+ int x N, * y N = 0, z[] N;
+ extern void exit() N;
+ int fact(int x) N { ... }
+</FONT></PRE>
+Type attributes can be specified along with the type using the following
+ rules:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+ The type attributes for a base type (int, float, named type, reference
+ to struct or union or enum) must be specified immediately following the
+ type (actually it is Ok to mix attributes with the specification of the
+ type, in between unsigned and int for example).<BR>
+<BR>
+For example:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int A1 x N; /* A1 applies to the type int. An example is an attribute
+ "even" restricting the type int to even values. */
+ struct foo A1 A2 x; // Both A1 and A2 apply to the struct foo type
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-enumerate">The type attributes for a pointer type must be specified immediately
+ after the * symbol.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ /* A pointer (A1) to an int (A2) */
+ int A2 * A1 x;
+ /* A pointer (A1) to a pointer (A2) to a float (A3) */
+ float A3 * A2 * A1 x;
+</FONT></PRE>
+Note: The attributes for base types and for pointer types are a strict
+ extension of the ANSI C type qualifiers (const, volatile and restrict). In
+ fact CIL treats these qualifiers as attributes. <BR>
+<BR>
+<LI CLASS="li-enumerate">The attributes for a function type or for an array type can be
+ specified using parenthesized declarators.<BR>
+<BR>
+For example:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ /* A function (A1) from int (A2) to float (A3) */
+ float A3 (A1 f)(int A2);
+
+ /* A pointer (A1) to a function (A2) that returns an int (A3) */
+ int A3 (A2 * A1 pfun)(void);
+
+ /* An array (A1) of int (A2) */
+ int A2 (A1 x0)[]
+
+ /* Array (A1) of pointers (A2) to functions (A3) that take an int (A4) and
+ * return a pointer (A5) to int (A6) */
+ int A6 * A5 (A3 * A2 (A1 x1)[5])(int A4);
+
+
+ /* A function (A4) that takes a float (A5) and returns a pointer (A6) to an
+ * int (A7) */
+ extern int A7 * A6 (A4 x2)(float A5 x);
+
+ /* A function (A1) that takes a int (A2) and that returns a pointer (A3) to
+ * a function (A4) that takes a float (A5) and returns a pointer (A6) to an
+ * int (A7) */
+ int A7 * A6 (A4 * A3 (A1 x3)(int A2 x))(float A5) {
+ return &amp; x2;
+ }
+</FONT></PRE></OL>
+Note: ANSI C does not allow the specification of type qualifiers for function
+and array types, although it allows for the parenthesized declarator. With
+just a bit of thought (looking at the first few examples above) I hope that
+the placement of attributes for function and array types will seem intuitive.<BR>
+<BR>
+This extension is not without problems however. If you want to refer just to
+a type (in a cast for example) then you leave the name out. But this leads to
+strange conflicts due to the parentheses that we introduce to scope the
+attributes. Take for example the type of x0 from above. It should be written
+as:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int A2 (A1 )[]
+</FONT></PRE>
+But this will lead most C parsers into deep confusion because the parentheses
+around A1 will be confused for parentheses of a function designator. To push
+this problem around (I don't know a solution) whenever we are about to print a
+parenthesized declarator with no name but with attributes, we comment out the
+attributes so you can see them (for whatever is worth) without confusing the
+compiler. For example, here is how we would print the above type:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int A2 /*(A1 )*/[]
+</FONT></PRE>
+
+<H5 CLASS="paragraph">Handling of predefined GCC attributes</H5>
+GCC already supports attributes in a lot of places in declarations. The only
+place where we support attributes and GCC does not is right before the { that
+starts a function body. <BR>
+<BR>
+GCC classifies its attributes in attributes for functions, for variables and
+for types, although the latter category is only usable in definition of struct
+or union types and is not nearly as powerful as the CIL type attributes. We
+have made an effort to reclassify GCC attributes as name and type attributes
+(they only apply for function types). Here is what we came up with:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+ GCC name attributes:<BR>
+<BR>
+section, constructor, destructor, unused, weak, no_instrument_function,
+ noreturn, alias, no_check_memory_usage, dllinport, dllexport, exception,
+ model<BR>
+<BR>
+Note: the "noreturn" attribute would be more appropriately qualified as a
+ function type attribute. But we classify it as a name attribute to make
+ it easier to support a similarly named MSVC attribute. <BR>
+<BR>
+<LI CLASS="li-itemize">GCC function type attributes:<BR>
+<BR>
+fconst (printed as "const"), format, regparm, stdcall,
+ cdecl, longcall<BR>
+<BR>
+I was not able to completely decipher the position in which these attributes
+ must go. So, the CIL elaborator knows these names and applies the following
+ rules:
+ <UL CLASS="itemize"><LI CLASS="li-itemize">
+ All of the name attributes that appear in the specifier part (i.e. at
+ the beginning) of a declaration are associated with all declared names. <BR>
+<BR>
+<LI CLASS="li-itemize">All of the name attributes that appear at the end of a declarator are
+ associated with the particular name being declared.<BR>
+<BR>
+<LI CLASS="li-itemize">More complicated is the handling of the function type attributes, since
+ there can be more than one function in a single declaration (a function
+ returning a pointer to a function). Lacking any real understanding of how
+ GCC handles this, I attach the function type attribute to the "nearest"
+ function. This means that if a pointer to a function is "nearby" the
+ attribute will be correctly associated with the function. In truth I pray
+ that nobody uses declarations as that of x3 above.
+ </UL>
+</UL>
+
+<H5 CLASS="paragraph">Handling of predefined MSVC attributes</H5>
+MSVC has two kinds of attributes, declaration modifiers to be printed before
+ the storage specifier using the notation "<TT>__declspec(...)</TT>" and a few
+ function type attributes, printed almost as our CIL function type
+ attributes. <BR>
+<BR>
+The following are the name attributes that are printed using
+ <TT>__declspec</TT> right before the storage designator of the declaration:
+ thread, naked, dllimport, dllexport, noreturn<BR>
+<BR>
+The following are the function type attributes supported by MSVC:
+ fastcall, cdecl, stdcall<BR>
+<BR>
+It is not worth going into the obscure details of where MSVC accepts these
+ type attributes. The parser thinks it knows these details and it pulls
+ these attributes from wherever they might be placed. The important thing
+ is that MSVC will accept if we print them according to the rules of the CIL
+ attributes ! <BR>
+<BR>
+<HR>
+<A HREF="cilly.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil007.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil007.html b/cil/doc/cil007.html
new file mode 100644
index 0000000..7d6c023
--- /dev/null
+++ b/cil/doc/cil007.html
@@ -0,0 +1,279 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+The CIL Driver
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil006.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="ext.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc14">7</A>&nbsp;&nbsp;The CIL Driver</H2><A NAME="sec-driver"></A>
+We have packaged CIL as an application <TT>cilly</TT> that contains certain
+example modules, such as <TT>logwrites.ml</TT> (a module
+that instruments code to print the addresses of memory locations being
+written). Normally, you write another module like that, add command-line
+options and an invocation of your module in <TT>src/main.ml</TT>. Once you compile
+CIL you will obtain the file <TT>obj/cilly.asm.exe</TT>. <BR>
+<BR>
+We wrote a driver for this executable that makes it easy to invoke your
+analysis on existing C code with very little manual intervention. This driver
+is <TT>bin/cilly</TT> and is quite powerful. Note that the <TT>cilly</TT> script
+is configured during installation with the path where CIL resides. This means
+that you can move it to any place you want. <BR>
+<BR>
+A simple use of the driver is:
+<PRE CLASS="verbatim">
+bin/cilly --save-temps -D HAPPY_MOOD -I myincludes hello.c -o hello
+</PRE>
+<FONT COLOR=blue>--save-temps</FONT> tells CIL to save the resulting output files in the
+current directory. Otherwise, they'll be put in <TT>/tmp</TT> and deleted
+automatically. Not that this is the only CIL-specific flag in the
+list &ndash; the other flags use <TT>gcc</TT>'s syntax.<BR>
+<BR>
+This performs the following actions:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+preprocessing using the -D and -I arguments with the resulting
+ file left in <TT>hello.i</TT>,
+<LI CLASS="li-itemize">the invocation of the <TT>cilly.asm</TT> application which parses <TT>hello.i</TT>
+ converts it to CIL and the pretty-prints it to <TT>hello.cil.c</TT>
+<LI CLASS="li-itemize">another round of preprocessing with the result placed in <TT>hello.cil.i</TT>
+<LI CLASS="li-itemize">the true compilation with the result in <TT>hello.cil.o</TT>
+<LI CLASS="li-itemize">a linking phase with the result in <TT>hello</TT>
+</UL>
+Note that <TT>cilly</TT> behaves like the <TT>gcc</TT> compiler. This makes it
+easy to use it with existing <TT>Makefiles</TT>:
+<PRE CLASS="verbatim">
+make CC="bin/cilly" LD="bin/cilly"
+</PRE>
+ <TT>cilly</TT> can also behave as the Microsoft Visual C compiler, if the first
+ argument is <TT>--mode=MSVC</TT>:
+<PRE CLASS="verbatim">
+bin/cilly --mode=MSVC /D HAPPY_MOOD /I myincludes hello.c /Fe hello.exe
+</PRE>
+ (This in turn will pass a <TT>--MSVC</TT> flag to the underlying <TT>cilly.asm</TT>
+ process which will make it understand the Microsoft Visual C extensions)<BR>
+<BR>
+<TT>cilly</TT> can also behave as the archiver <TT>ar</TT>, if it is passed an
+argument <TT>--mode=AR</TT>. Note that only the <TT>cr</TT> mode is supported (create a
+new archive and replace all files in there). Therefore the previous version of
+the archive is lost. <BR>
+<BR>
+Furthermore, <TT>cilly</TT> allows you to pass some arguments on to the
+underlying <TT>cilly.asm</TT> process. As a general rule all arguments that start
+with <TT>--</TT> and that <TT>cilly</TT> itself does not process, are passed on. For
+example,
+<PRE CLASS="verbatim">
+bin/cilly --dologwrites -D HAPPY_MOOD -I myincludes hello.c -o hello.exe
+</PRE>
+ will produce a file <TT>hello.cil.c</TT> that prints all the memory addresses
+written by the application. <BR>
+<BR>
+The most powerful feature of <TT>cilly</TT> is that it can collect all the
+sources in your project, merge them into one file and then apply CIL. This
+makes it a breeze to do whole-program analysis and transformation. All you
+have to do is to pass the <TT>--merge</TT> flag to <TT>cilly</TT>:
+<PRE CLASS="verbatim">
+make CC="bin/cilly --save-temps --dologwrites --merge"
+</PRE>
+ You can even leave some files untouched:
+<PRE CLASS="verbatim">
+make CC="bin/cilly --save-temps --dologwrites --merge --leavealone=foo --leavealone=bar"
+</PRE>
+ This will merge all the files except those with the basename <TT>foo</TT> and
+<TT>bar</TT>. Those files will be compiled as usual and then linked in at the very
+end. <BR>
+<BR>
+The sequence of actions performed by <TT>cilly</TT> depends on whether merging
+is turned on or not:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+If merging is off
+ <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+ For every file <TT>file.c</TT> to compile
+ <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
+ Preprocess the file with the given arguments to
+ produce <TT>file.i</TT>
+ <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>file.cil.c</TT>
+ <LI CLASS="li-enumerate">Preprocess to <TT>file.cil.i</TT>
+ <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>file.cil.o</TT>
+ </OL>
+ <LI CLASS="li-enumerate">Link the resulting objects
+ </OL>
+<LI CLASS="li-itemize">If merging is on
+ <OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+ For every file <TT>file.c</TT> to compile
+ <OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
+ Preprocess the file with the given arguments to
+ produce <TT>file.i</TT>
+ <LI CLASS="li-enumerate">Save the preprocessed source as <TT>file.o</TT>
+ </OL>
+ <LI CLASS="li-enumerate">When linking executable <TT>hello.exe</TT>, look at every object
+ file that must be linked and see if it actually
+ contains preprocessed source. Pass all those files to a
+ special merging application (described in
+ Section&nbsp;<A HREF="merger.html#sec-merger">13</A>) to produce <TT>hello.exe_comb.c</TT>
+ <LI CLASS="li-enumerate">Invoke <TT>cilly.asm</TT> to produce a <TT>hello.exe_comb.cil.c</TT>
+ <LI CLASS="li-enumerate">Preprocess to <TT>hello.exe_comb.cil.i</TT>
+ <LI CLASS="li-enumerate">Invoke the underlying compiler to produce <TT>hello.exe_comb.cil.o</TT>
+ <LI CLASS="li-enumerate">Invoke the actual linker to produce <TT>hello.exe</TT>
+ </OL>
+</UL>
+Note that files that you specify with <TT>--leavealone</TT> are not merged and
+never presented to CIL. They are compiled as usual and then are linked in at
+the end. <BR>
+<BR>
+And a final feature of <TT>cilly</TT> is that it can substitute copies of the
+system's include files:
+<PRE CLASS="verbatim">
+make CC="bin/cilly --includedir=myinclude"
+</PRE>
+ This will force the preprocessor to use the file <TT>myinclude/xxx/stdio.h</TT>
+(if it exists) whenever it encounters <TT>#include &lt;stdio.h&gt;</TT>. The <TT>xxx</TT> is
+a string that identifies the compiler version you are using. This modified
+include files should be produced with the patcher script (see
+Section&nbsp;<A HREF="patcher.html#sec-patcher">14</A>).<BR>
+<BR>
+<A NAME="toc7"></A>
+<H3 CLASS="subsection"><A NAME="htoc15">7.1</A>&nbsp;&nbsp;<TT>cilly</TT> Options</H3>
+Among the options for the <TT>cilly</TT> you can put anything that can normally
+go in the command line of the compiler that <TT>cilly</TT> is impersonating.
+<TT>cilly</TT> will do its best to pass those options along to the appropriate
+subprocess. In addition, the following options are supported (a complete and
+up-to-date list can always be obtained by running <TT>cilly --help</TT>):
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>--mode=mode</TT> This must be the first argument if present. It makes
+<TT>cilly</TT> behave as a given compiled. The following modes are recognized:
+ <UL CLASS="itemize"><LI CLASS="li-itemize">
+ GNUCC - the GNU C Compiler. This is the default.
+ <LI CLASS="li-itemize">MSVC - the Microsoft Visual C compiler. Of course, you should
+ pass only MSVC valid options in this case.
+ <LI CLASS="li-itemize">AR - the archiver <TT>ar</TT>. Only the mode <TT>cr</TT> is supported and
+ the original version of the archive is lost.
+ </UL>
+<LI CLASS="li-itemize"><TT>--help</TT> Prints a list of the options supported.
+<LI CLASS="li-itemize"><TT>--verbose</TT> Prints lots of messages about what is going on.
+<LI CLASS="li-itemize"><TT>--stages</TT> Less than <TT>--verbose</TT> but lets you see what <TT>cilly</TT>
+ is doing.
+<LI CLASS="li-itemize"><TT>--merge</TT> This tells <TT>cilly</TT> to first attempt to collect into one
+source file all of the sources that make your application, and then to apply
+<TT>cilly.asm</TT> on the resulting source. The sequence of actions in this case is
+described above and the merger itself is described in Section&nbsp;<A HREF="merger.html#sec-merger">13</A>.<BR>
+<BR>
+<LI CLASS="li-itemize"><TT>--leavealone=xxx</TT>. Do not merge and do not present to CIL the files
+whose basename is "xxx". These files are compiled as usual and linked in at
+the end.
+<LI CLASS="li-itemize"><TT>--includedir=xxx</TT>. Override the include files with those in the given
+directory. The given directory is the same name that was given an an argument
+to the patcher (see Section&nbsp;<A HREF="patcher.html#sec-patcher">14</A>). In particular this means that
+that directory contains subdirectories named based on the current compiler
+version. The patcher creates those directories.
+<LI CLASS="li-itemize"><TT>--usecabs</TT>. Do not CIL, but instead just parse the source and print
+its AST out. This should looked like the preprocessed file. This is useful
+when you suspect that the conversion to CIL phase changes the meaning of the
+program.
+<LI CLASS="li-itemize"><TT>--save-temps=xxx</TT>. Temporary files are preserved in the xxx
+ directory. For example, the output of CIL will be put in a file
+ named <TT>*.cil.c</TT>.
+<LI CLASS="li-itemize"><TT>--save-temps</TT>. Temporay files are preserved in the current directory.
+</UL>
+<A NAME="toc8"></A>
+<H3 CLASS="subsection"><A NAME="htoc16">7.2</A>&nbsp;&nbsp;<TT>cilly.asm</TT> Options</H3>
+ <A NAME="sec-cilly-asm-options"></A>
+All of the options that start with <TT>--</TT> and are not understood by
+<TT>cilly</TT> are passed on to <TT>cilly.asm</TT>. <TT>cilly</TT> also passes along to
+<TT>cilly.asm</TT> flags such as <TT>--MSVC</TT> that both need to know
+about. The following options are supported:<BR>
+<BR>
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <B>General Options:</B>
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+ <TT>--version</TT> output version information and exit
+ <LI CLASS="li-itemize"><TT>--verbose</TT> Print lots of random stuff. This is passed on from cilly
+ <LI CLASS="li-itemize"><TT>--warnall</TT> Show all warnings.
+ <LI CLASS="li-itemize"><TT>--debug=xxx</TT> turns on debugging flag xxx
+ <LI CLASS="li-itemize"><TT>--nodebug=xxx</TT> turns off debugging flag xxx
+ <LI CLASS="li-itemize"><TT>--flush</TT> Flush the output streams often (aids debugging).
+ <LI CLASS="li-itemize"><TT>--check</TT> Run a consistency check over the CIL after every operation.
+ <LI CLASS="li-itemize"><TT>--nocheck</TT> turns off consistency checking of CIL.
+ <LI CLASS="li-itemize"><TT>--noPrintLn</TT> Don't output #line directives in the output.
+ <LI CLASS="li-itemize"><TT>--commPrintLn</TT> Print #line directives in the output, but
+ put them in comments.
+ <LI CLASS="li-itemize"><TT>--log=xxx</TT> Set the name of the log file. By default stderr is used
+ <LI CLASS="li-itemize"><TT>--MSVC</TT> Enable MSVC compatibility. Default is GNU.
+ <LI CLASS="li-itemize"><TT>--ignore-merge-conflicts</TT> ignore merging conflicts.
+ <LI CLASS="li-itemize"><TT>--extrafiles=filename</TT>: the name of a file that contains
+ a list of additional files to process, separated by whitespace.
+ <LI CLASS="li-itemize"><TT>--stats</TT> Print statistics about the running time of the
+ parser, conversion to CIL, etc. Also prints memory-usage
+ statistics. You can time parts of your own code as well. Calling
+ (<TT>Stats.time &#8220;label&#8221; func arg</TT>) will evaluate <TT>(func arg)</TT>
+ and remember how long this takes. If you call <TT>Stats.time</TT>
+ repeatedly with the same label, CIL will report the aggregate
+ time.<BR>
+<BR>
+If available, CIL uses the x86 performance counters for these
+ stats. This is very precise, but results in &#8220;wall-clock time.&#8221;
+ To report only user-mode time, find the call to <TT>Stats.reset</TT> in
+ <TT>main.ml</TT>, and change it to <TT>Stats.reset false</TT>.<BR>
+<BR>
+<B>Lowering Options</B>
+ <LI CLASS="li-itemize"><TT>--noLowerConstants</TT> do not lower constant expressions.
+ <LI CLASS="li-itemize"><TT>--noInsertImplicitCasts</TT> do not insert implicit casts.
+ <LI CLASS="li-itemize"><TT>--forceRLArgEval</TT> Forces right to left evaluation of function arguments.
+ <LI CLASS="li-itemize"><TT>--disallowDuplication</TT> Prevent small chunks of code from being duplicated.
+ <LI CLASS="li-itemize"><TT>--keepunused</TT> Do not remove the unused variables and types.
+ <LI CLASS="li-itemize"><TT>--rmUnusedInlines</TT> Delete any unused inline functions. This is the default in MSVC mode.<BR>
+<BR>
+<B>Output Options:</B>
+ <LI CLASS="li-itemize"><TT>--printCilAsIs</TT> Do not try to simplify the CIL when
+ printing. Without this flag, CIL will attempt to produce prettier
+ output by e.g. changing <TT>while(1)</TT> into more meaningful loops.
+ <LI CLASS="li-itemize"><TT>--noWrap</TT> do not wrap long lines when printing
+ <LI CLASS="li-itemize"><TT>--out=xxx</TT> the name of the output CIL file. <TT>cilly</TT>
+ sets this for you.
+ <LI CLASS="li-itemize"><TT>--mergedout=xxx</TT> specify the name of the merged file
+ <LI CLASS="li-itemize"><TT>--cabsonly=xxx</TT> CABS output file name
+<BR>
+<BR>
+ <B>Selected features.</B> See Section&nbsp;<A HREF="ext.html#sec-Extension">8</A> for more information.
+<LI CLASS="li-itemize"><TT>--dologcalls</TT>. Insert code in the processed source to print the name of
+functions as are called. Implemented in <TT>src/ext/logcalls.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dologwrites</TT>. Insert code in the processed source to print the
+address of all memory writes. Implemented in <TT>src/ext/logwrites.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dooneRet</TT>. Make each function have at most one 'return'.
+Implemented in <TT>src/ext/oneret.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dostackGuard</TT>. Instrument function calls and returns to
+maintain a separate stack for return addresses. Implemeted in
+<TT>src/ext/heapify.ml</TT>.
+<LI CLASS="li-itemize"><TT>--domakeCFG</TT>. Make the program look more like a CFG. Implemented
+in <TT>src/cil.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dopartial</TT>. Do interprocedural partial evaluation and
+constant folding. Implemented in <TT>src/ext/partial.ml</TT>.
+<LI CLASS="li-itemize"><TT>--dosimpleMem</TT>. Simplify all memory expressions. Implemented in
+<TT>src/ext/simplemem.ml</TT>. <BR>
+<BR>
+For an up-to-date list of available options, run <TT>cilly.asm --help</TT>. </UL>
+<HR>
+<A HREF="cil006.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="ext.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil009.html b/cil/doc/cil009.html
new file mode 100644
index 0000000..f408d00
--- /dev/null
+++ b/cil/doc/cil009.html
@@ -0,0 +1,48 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Controlling CIL
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="ext.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil010.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc35">9</A>&nbsp;&nbsp;Controlling CIL</H2>
+In the process of converting a C file to CIL we drop the unused prototypes
+and even inline function definitions. This results in much smaller files. If
+you do not want this behavior then you must pass the <TT>--keepunused</TT> argument
+to the CIL application. <BR>
+<BR>
+Alternatively you can put the following pragma in the code (instructing CIL
+to specifically keep the declarations and definitions of the function
+<TT>func1</TT> and variable <TT>var2</TT>, the definition of type <TT>foo</TT> and of
+structure <TT>bar</TT>):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+#pragma cilnoremove("func1", "var2", "type foo", "struct bar")
+</FONT></PRE>
+<HR>
+<A HREF="ext.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil010.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil010.html b/cil/doc/cil010.html
new file mode 100644
index 0000000..e7b1e4b
--- /dev/null
+++ b/cil/doc/cil010.html
@@ -0,0 +1,100 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+GCC Extensions
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil009.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil011.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc36">10</A>&nbsp;&nbsp;GCC Extensions</H2>
+The CIL parser handles most of the <TT>gcc</TT>
+<A HREF="javascript:loadTop('http://gcc.gnu.org/onlinedocs/gcc-3.0.2/gcc_5.html#SEC67')">extensions</A>
+and compiles them to CIL. The following extensions are not handled (note that
+we are able to compile a large number of programs, including the Linux kernel,
+without encountering these):
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Nested function definitions.
+<LI CLASS="li-enumerate">Constructing function calls.
+<LI CLASS="li-enumerate">Naming an expression's type.
+<LI CLASS="li-enumerate">Complex numbers
+<LI CLASS="li-enumerate">Hex floats
+<LI CLASS="li-enumerate">Subscripts on non-lvalue arrays.
+<LI CLASS="li-enumerate">Forward function parameter declarations
+</OL>
+The following extensions are handled, typically by compiling them away:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Attributes for functions, variables and types. In fact, we have a clear
+specification (see Section&nbsp;<A HREF="cil006.html#sec-attrib">6.4</A>) of how attributes are interpreted. The
+specification extends that of <TT>gcc</TT>.
+<LI CLASS="li-enumerate">Old-style function definitions and prototypes. These are translated to
+new-style.
+<LI CLASS="li-enumerate">Locally-declared labels. As part of the translation to CIL, we generate
+new labels as needed.
+<LI CLASS="li-enumerate">Labels as values and computed goto. This allows a program to take the
+address of a label and to manipulate it as any value and also to perform a
+computed goto. We compile this by assigning each label whose address is taken
+a small integer that acts as its address. Every computed <TT>goto</TT> in the body
+of the function is replaced with a <TT>switch</TT> statement. If you want to invoke
+the label from another function, you are on your own (the <TT>gcc</TT>
+documentation says the same.)
+<LI CLASS="li-enumerate">Generalized lvalues. You can write code like <TT>(a, b) += 5</TT> and it gets
+translated to CIL.
+<LI CLASS="li-enumerate">Conditionals with omitted operands. Things like <TT>x ? : y</TT> are
+translated to CIL.
+<LI CLASS="li-enumerate">Double word integers. The type <TT>long long</TT> and the <TT>LL</TT> suffix on
+constants is understood. This is currently interpreted as 64-bit integers.
+<LI CLASS="li-enumerate">Local arrays of variable length. These are converted to uses of
+<TT>alloca</TT>, the array variable is replaced with a pointer to the allocated
+array and the instances of <TT>sizeof(a)</TT> are adjusted to return the size of
+the array and not the size of the pointer.
+<LI CLASS="li-enumerate">Non-constant local initializers. Like all local initializers these are
+compiled into assignments.
+<LI CLASS="li-enumerate">Compound literals. These are also turned into assignments.
+<LI CLASS="li-enumerate">Designated initializers. The CIL parser actually supports the full ISO
+syntax for initializers, which is more than both <TT>gcc</TT> and <TT>MSVC</TT>. I
+(George) think that this is the most complicated part of the C language and
+whoever designed it should be banned from ever designing languages again.
+<LI CLASS="li-enumerate">Case ranges. These are compiled into separate cases. There is no code
+duplication, just a larger number of <TT>case</TT> statements.
+<LI CLASS="li-enumerate">Transparent unions. This is a strange feature that allows you to define
+a function whose formal argument has a (tranparent) union type, but the
+argument is called as if it were the first element of the union. This is
+compiled away by saying that the type of the formal argument is that of the
+first field, and the first thing in the function body we copy the formal into
+a union. <BR>
+<BR>
+<LI CLASS="li-enumerate">Inline assembly-language. The full syntax is supported and it is carried
+as such in CIL.<BR>
+<BR>
+<LI CLASS="li-enumerate">Function names as strings. The identifiers <TT>__FUNCTION__</TT> and
+<TT>__PRETTY_FUNCTION__</TT> are replaced with string literals. <BR>
+<BR>
+<LI CLASS="li-enumerate">Keywords <TT>typeof</TT>, <TT>alignof</TT>, <TT>inline</TT> are supported.
+</OL>
+<HR>
+<A HREF="cil009.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil011.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil011.html b/cil/doc/cil011.html
new file mode 100644
index 0000000..975c8dd
--- /dev/null
+++ b/cil/doc/cil011.html
@@ -0,0 +1,53 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+CIL Limitations
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil010.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil012.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc37">11</A>&nbsp;&nbsp;CIL Limitations</H2>
+There are several implementation details of CIL that might make it unusable
+ or less than ideal for certain tasks:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+CIL operates after preprocessing. If you need to see comments, for
+example, you cannot use CIL. But you can use attributes and pragmas instead.
+And there is some support to help you patch the include files before they are
+seen by the preprocessor. For example, this is how we turn some
+<TT>#define</TT>s that we don't like into function calls. <BR>
+<BR>
+<LI CLASS="li-itemize">CIL does transform the code in a non-trivial way. This is done in order
+to make most analyses easier. But if you want to see the code <TT>e1, e2++</TT>
+exactly as it appears in the code, then you should not use CIL. <BR>
+<BR>
+<LI CLASS="li-itemize">CIL removes all local scopes and moves all variables to function
+scope. It also separates a declaration with an initializer into a declaration
+plus an assignment. The unfortunate effect of this transformation is that
+local variables cannot have the <TT>const</TT> qualifier.</UL>
+<HR>
+<A HREF="cil010.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil012.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil012.html b/cil/doc/cil012.html
new file mode 100644
index 0000000..5d18fd5
--- /dev/null
+++ b/cil/doc/cil012.html
@@ -0,0 +1,133 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Known Bugs and Limitations
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil011.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="merger.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc38">12</A>&nbsp;&nbsp;Known Bugs and Limitations</H2>
+<UL CLASS="itemize"><LI CLASS="li-itemize">In the new versions of <TT>glibc</TT> there is a function
+ <TT>__builtin_va_arg</TT> that takes a type as its second argument. CIL
+ handles that through a slight trick. As it parses the function it changes a
+ call like:
+<PRE CLASS="verbatim">
+ mytype x = __builtin_va_arg(marker, mytype)
+</PRE>into
+<PRE CLASS="verbatim">
+ mytype x;
+ __builtin_va_arg(marker, sizeof(mytype), &amp;x);
+</PRE>
+ The latter form is used internally in CIL. However, the CIL pretty printer
+ will try to emit the original code. <BR>
+<BR>
+Similarly, <TT>__builtin_types_compatible_p(t1, t2)</TT>, which takes
+ types as arguments, is represented internally as
+ <TT>__builtin_types_compatible_p(sizeof t1, sizeof t2)</TT>, but the
+ sizeofs are removed when printing.<BR>
+<BR>
+<LI CLASS="li-itemize">The implementation of <TT>bitsSizeOf</TT> does not take into account the
+packing pragmas. However it was tested to be accurate on cygwin/gcc-2.95.3,
+Linux/gcc-2.95.3 and on Windows/MSVC.<BR>
+<BR>
+<LI CLASS="li-itemize">We do not support tri-graph sequences (ISO 5.2.1.1).<BR>
+<BR>
+<LI CLASS="li-itemize">GCC has a strange feature called &#8220;extern inline&#8221;. Such a function can
+be defined twice: first with the &#8220;extern inline&#8221; specifier and the second
+time without it. If optimizations are turned off then the &#8220;extern inline&#8221;
+definition is considered a prototype (its body is ignored). If optimizations
+are turned on then the extern inline function is inlined at all of its
+occurrences from the point of its definition all the way to the point where the
+(optional) second definition appears. No body is generated for an extern
+inline function. A body is generated for the real definition and that one is
+used in the rest of the file. <BR>
+<BR>
+CIL will rename your extern inline function (and its uses) with the suffix
+ <TT>__extinline</TT>. This means that if you have two such definition, that do
+ different things and the optimizations are not on, then the CIL version might
+ compute a different answer !<BR>
+<BR>
+Also, if you have multiple extern inline declarations then CIL will ignore
+but the first one. This is not so bad because GCC itself would not like it. <BR>
+<BR>
+<LI CLASS="li-itemize">There are still a number of bugs in handling some obscure features of
+GCC. For example, when you use variable-length arrays, CIL turns them into
+calls to <TT>alloca</TT>. This means that they are deallocated when the function
+returns and not when the local scope ends. <BR>
+<BR>
+Variable-length arrays are not supported as fields of a struct or union.<BR>
+<BR>
+<LI CLASS="li-itemize">CIL cannot parse arbitrary <TT>#pragma</TT> directives. Their
+ syntax must follow gcc's attribute syntax to be understood. If you
+ need a pragma that does not follow gcc syntax, add that pragma's name
+ to <TT>no_parse_pragma</TT> in <TT>src/frontc/clexer.mll</TT> to indicate that
+ CIL should treat that pragma as a monolithic string rather than try
+ to parse its arguments.<BR>
+<BR>
+CIL cannot parse a line containing an empty <TT>#pragma</TT>.<BR>
+<BR>
+<LI CLASS="li-itemize">CIL only parses <TT>#pragma</TT> directives at the "top level", this is,
+ outside of any enum, structure, union, or function definitions.<BR>
+<BR>
+If your compiler uses pragmas in places other than the top-level,
+ you may have to preprocess the sources in a special way (sed, perl,
+ etc.) to remove pragmas from these locations.<BR>
+<BR>
+<LI CLASS="li-itemize">CIL cannot parse the following code (fixing this problem would require
+extensive hacking of the LALR grammar):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int bar(int ()); // This prototype cannot be parsed
+int bar(int x()); // If you add a name to the function, it works
+int bar(int (*)()); // This also works (and it is more appropriate)
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-itemize">CIL also cannot parse certain K&amp;R old-style prototypes with missing
+return type:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+g(); // This cannot be parsed
+int g(); // This is Ok
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-itemize">CIL does not understand some obscure combinations of type specifiers
+(&#8220;signed&#8221; and &#8220;unsigned&#8221; applied to typedefs that themselves contain a
+sign specification; you could argue that this should not be allowed anyway):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+typedef signed char __s8;
+__s8 unsigned uchartest; // This is unsigned char for gcc
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-itemize">The statement <TT>x = 3 + x ++</TT> will perform the increment of <TT>x</TT>
+ before the assignment, while <TT>gcc</TT> delays the increment after the
+ assignment. It turned out that this behavior is much easier to implement
+ than gcc's one, and either way is correct (since the behavior is unspecified
+ in this case). Similarly, if you write <TT>x = x ++;</TT> then CIL will perform
+ the increment before the assignment, whereas GCC and MSVC will perform it
+ after the assignment.
+</UL>
+<HR>
+<A HREF="cil011.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="merger.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil015.html b/cil/doc/cil015.html
new file mode 100644
index 0000000..a3dff7d
--- /dev/null
+++ b/cil/doc/cil015.html
@@ -0,0 +1,60 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Debugging support
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="patcher.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil016.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc41">15</A>&nbsp;&nbsp;Debugging support</H2><A NAME="sec-debugger"></A>
+Most of the time we debug our code using the Errormsg module along with the
+pretty printer. But if you want to use the Ocaml debugger here is an easy way
+to do it. Say that you want to debug the invocation of cilly that arises out
+of the following command:
+<PRE CLASS="verbatim">
+cilly -c hello.c
+</PRE>
+ You must follow the installation <A HREF="../ccured/setup.html">instructions</A>
+to install the Elist support files for ocaml and to extend your .emacs
+appropriately. Then from within Emacs you do
+<PRE CLASS="verbatim">
+ALT-X my-camldebug
+</PRE>
+ This will ask you for the command to use for running the Ocaml debugger
+(initially the default will be &#8220;ocamldebug&#8221; or the last command you
+introduced). You use the following command:
+<PRE CLASS="verbatim">
+cilly --ocamldebug -c hello.c
+</PRE>
+ This will run <TT>cilly</TT> as usual and invoke the Ocaml debugger when the cilly
+engine starts. The advantage of this way of invoking the debugger is that the
+directory search paths are set automatically and the right set or arguments is
+passed to the debugger. <BR>
+<BR>
+<HR>
+<A HREF="patcher.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil016.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil016.html b/cil/doc/cil016.html
new file mode 100644
index 0000000..3191a9d
--- /dev/null
+++ b/cil/doc/cil016.html
@@ -0,0 +1,342 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Who Says C is Simple?
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil015.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil017.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc42">16</A>&nbsp;&nbsp;Who Says C is Simple?</H2><A NAME="sec-simplec"></A>
+When I (George) started to write CIL I thought it was going to take two weeks.
+Exactly a year has passed since then and I am still fixing bugs in it. This
+gross underestimate was due to the fact that I thought parsing and making
+sense of C is simple. You probably think the same. What I did not expect was
+how many dark corners this language has, especially if you want to parse
+real-world programs such as those written for GCC or if you are more ambitious
+and you want to parse the Linux or Windows NT sources (both of these were
+written without any respect for the standard and with the expectation that
+compilers will be changed to accommodate the program). <BR>
+<BR>
+The following examples were actually encountered either in real programs or
+are taken from the ISO C99 standard or from the GCC's testcases. My first
+reaction when I saw these was: <EM>Is this C?</EM>. The second one was : <EM>What the hell does it mean?</EM>. <BR>
+<BR>
+If you are contemplating doing program analysis for C on abstract-syntax
+trees then your analysis ought to be able to handle these things. Or, you can
+use CIL and let CIL translate them into clean C code. <BR>
+<BR>
+<A NAME="toc24"></A>
+<H3 CLASS="subsection"><A NAME="htoc43">16.1</A>&nbsp;&nbsp;Standard C</H3>
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Why does the following code return 0 for most values of <TT>x</TT>? (This
+should be easy.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x;
+ return x == (1 &amp;&amp; x);
+</FONT></PRE>
+See the <A HREF="examples/ex30.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Why does the following code return 0 and not -1? (Answer: because
+<TT>sizeof</TT> is unsigned, thus the result of the subtraction is unsigned, thus
+the shift is logical.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return ((1 - sizeof(int)) &gt;&gt; 32);
+</FONT></PRE>
+See the <A HREF="examples/ex31.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Scoping rules can be tricky. This function returns 5.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int x = 5;
+int f() {
+ int x = 3;
+ {
+ extern int x;
+ return x;
+ }
+}
+</FONT></PRE>
+See the <A HREF="examples/ex32.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Functions and function pointers are implicitly converted to each other.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int (*pf)(void);
+int f(void) {
+
+ pf = &amp;f; // This looks ok
+ pf = ***f; // Dereference a function?
+ pf(); // Invoke a function pointer?
+ (****pf)(); // Looks strange but Ok
+ (***************f)(); // Also Ok
+}
+</FONT></PRE>
+See the <A HREF="examples/ex33.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Initializer with designators are one of the hardest parts about ISO C.
+Neither MSVC or GCC implement them fully. GCC comes close though. What is the
+final value of <TT>i.nested.y</TT> and <TT>i.nested.z</TT>? (Answer: 2 and respectively
+6).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct {
+ int x;
+ struct {
+ int y, z;
+ } nested;
+} i = { .nested.y = 5, 6, .x = 1, 2 };
+</FONT></PRE>
+See the <A HREF="examples/ex34.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">This is from c-torture. This function returns 1.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+typedef struct
+{
+ char *key;
+ char *value;
+} T1;
+
+typedef struct
+{
+ long type;
+ char *value;
+} T3;
+
+T1 a[] =
+{
+ {
+ "",
+ ((char *)&amp;((T3) {1, (char *) 1}))
+ }
+};
+int main() {
+ T3 *pt3 = (T3*)a[0].value;
+ return pt3-&gt;value;
+}
+</FONT></PRE>
+See the <A HREF="examples/ex35.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Another one with constructed literals. This one is legal according to
+the GCC documentation but somehow GCC chokes on (it works in CIL though). This
+code returns 2.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return ((int []){1,2,3,4})[1];
+</FONT></PRE>
+See the <A HREF="examples/ex36.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">In the example below there is one copy of &#8220;bar&#8221; and two copies of
+ &#8220;pbar&#8221; (static prototypes at block scope have file scope, while for all
+ other types they have block scope).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo() {
+ static bar();
+ static (*pbar)() = bar;
+
+ }
+
+ static bar() {
+ return 1;
+ }
+
+ static (*pbar)() = 0;
+</FONT></PRE>
+See the <A HREF="examples/ex37.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Two years after heavy use of CIL, by us and others, I discovered a bug
+ in the parser. The return value of the following function depends on what
+ precedence you give to casts and unary minus:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ unsigned long foo() {
+ return (unsigned long) - 1 / 8;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex38.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+The correct interpretation is <TT>((unsigned long) - 1) / 8</TT>, which is a
+ relatively large number, as opposed to <TT>(unsigned long) (- 1 / 8)</TT>, which
+ is 0. </OL>
+<A NAME="toc25"></A>
+<H3 CLASS="subsection"><A NAME="htoc44">16.2</A>&nbsp;&nbsp;GCC ugliness</H3><A NAME="sec-ugly-gcc"></A>
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">GCC has generalized lvalues. You can take the address of a lot of
+strange things:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int x, y, z;
+ return &amp;(x ? y : z) - &amp; (x++, x);
+</FONT></PRE>
+See the <A HREF="examples/ex39.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC lets you omit the second component of a conditional expression.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ extern int f();
+ return f() ? : -1; // Returns the result of f unless it is 0
+</FONT></PRE>
+See the <A HREF="examples/ex40.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">Computed jumps can be tricky. CIL compiles them away in a fairly clean
+way but you are on your own if you try to jump into another function this way.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+static void *jtab[2]; // A jump table
+static int doit(int x){
+
+ static int jtab_init = 0;
+ if(!jtab_init) { // Initialize the jump table
+ jtab[0] = &amp;&amp;lbl1;
+ jtab[1] = &amp;&amp;lbl2;
+ jtab_init = 1;
+ }
+ goto *jtab[x]; // Jump through the table
+lbl1:
+ return 0;
+lbl2:
+ return 1;
+}
+
+int main(void){
+ if (doit(0) != 0) exit(1);
+ if (doit(1) != 1) exit(1);
+ exit(0);
+}
+</FONT></PRE>
+See the <A HREF="examples/ex41.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">A cute little example that we made up. What is the returned value?
+(Answer: 1);
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return ({goto L; 0;}) &amp;&amp; ({L: 5;});
+</FONT></PRE>
+See the <A HREF="examples/ex42.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate"><TT>extern inline</TT> is a strange feature of GNU C. Can you guess what the
+following code computes?
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+extern inline foo(void) { return 1; }
+int firstuse(void) { return foo(); }
+
+// A second, incompatible definition of foo
+int foo(void) { return 2; }
+
+int main() {
+ return foo() + firstuse();
+}
+</FONT></PRE>
+See the <A HREF="examples/ex43.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+The answer depends on whether the optimizations are turned on. If they are
+then the answer is 3 (the first definition is inlined at all occurrences until
+the second definition). If the optimizations are off, then the first
+definition is ignore (treated like a prototype) and the answer is 4. <BR>
+<BR>
+CIL will misbehave on this example, if the optimizations are turned off (it
+ always returns 3).<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC allows you to cast an object of a type T into a union as long as the
+union has a field of that type:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+union u {
+ int i;
+ struct s {
+ int i1, i2;
+ } s;
+};
+
+union u x = (union u)6;
+
+int main() {
+ struct s y = {1, 2};
+ union u z = (union u)y;
+}
+</FONT></PRE>
+See the <A HREF="examples/ex44.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">GCC allows you to use the <TT>__mode__</TT> attribute to specify the size
+of the integer instead of the standard <TT>char</TT>, <TT>short</TT> and so on:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+int __attribute__ ((__mode__ ( __QI__ ))) i8;
+int __attribute__ ((__mode__ ( __HI__ ))) i16;
+int __attribute__ ((__mode__ ( __SI__ ))) i32;
+int __attribute__ ((__mode__ ( __DI__ ))) i64;
+</FONT></PRE>
+See the <A HREF="examples/ex45.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<LI CLASS="li-enumerate">The &#8220;alias&#8221; attribute on a function declaration tells the
+ linker to treat this declaration as another name for the specified
+ function. CIL will replace the declaration with a trampoline
+ function pointing to the specified target.
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ static int bar(int x, char y) {
+ return x + y;
+ }
+
+ //foo is considered another name for bar.
+ int foo(int x, char y) __attribute__((alias("bar")));
+</FONT></PRE>
+See the <A HREF="examples/ex46.txt">CIL output</A> for this
+code fragment</OL>
+<A NAME="toc26"></A>
+<H3 CLASS="subsection"><A NAME="htoc45">16.3</A>&nbsp;&nbsp;Microsoft VC ugliness</H3>
+This compiler has few extensions, so there is not much to say here.
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Why does the following code return 0 and not -1? (Answer: because of a
+bug in Microsoft Visual C. It thinks that the shift is unsigned just because
+the second operator is unsigned. CIL reproduces this bug when in MSVC mode.)
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ return -3 &gt;&gt; (8 * sizeof(int));
+</FONT></PRE><BR>
+<BR>
+<LI CLASS="li-enumerate">Unnamed fields in a structure seem really strange at first. It seems
+that Microsoft Visual C introduced this extension, then GCC picked it up (but
+in the process implemented it wrongly: in GCC the field <TT>y</TT> overlaps with
+<TT>x</TT>!).
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct {
+ int x;
+ struct {
+ int y, z;
+ struct {
+ int u, v;
+ };
+ };
+} a;
+return a.x + a.y + a.z + a.u + a.v;
+</FONT></PRE>
+See the <A HREF="examples/ex47.txt">CIL output</A> for this
+code fragment</OL>
+<HR>
+<A HREF="cil015.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil017.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil017.html b/cil/doc/cil017.html
new file mode 100644
index 0000000..a9e04eb
--- /dev/null
+++ b/cil/doc/cil017.html
@@ -0,0 +1,53 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Authors
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil016.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil018.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc46">17</A>&nbsp;&nbsp;Authors</H2>
+The CIL parser was developed starting from Hugues Casse's <TT>frontc</TT>
+front-end for C although all the files from the <TT>frontc</TT> distribution have
+been changed very extensively. The intermediate language and the elaboration
+stage are all written from scratch. The main author is
+<A HREF="mailto:necula@cs.berkeley.edu">George Necula</A>, with significant
+contributions from <A HREF="mailto:smcpeak@cs.berkeley.edu">Scott McPeak</A>,
+<A HREF="mailto:weimer@cs.berkeley.edu">Westley Weimer</A>,
+<A HREF="mailto:liblit@cs.wisc.edu">Ben Liblit</A>,
+<A HREF="javascript:loadTop('http://www.cs.berkeley.edu/~matth/')">Matt Harren</A>,
+Raymond To and Aman Bhargava.<BR>
+<BR>
+This work is based upon work supported in part by the National Science
+Foundation under Grants No. 9875171, 0085949 and 0081588, and gifts from
+Microsoft Research. Any opinions, findings, and conclusions or recommendations
+expressed in this material are those of the author(s) and do not necessarily
+reflect the views of the National Science Foundation or the other sponsors.<BR>
+<BR>
+<HR>
+<A HREF="cil016.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil018.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil018.html b/cil/doc/cil018.html
new file mode 100644
index 0000000..dc039ea
--- /dev/null
+++ b/cil/doc/cil018.html
@@ -0,0 +1,71 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+License
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil017.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil019.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc47">18</A>&nbsp;&nbsp;License</H2>
+Copyright (c) 2001-2005,
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+George C. Necula &lt;necula@cs.berkeley.edu&gt;
+<LI CLASS="li-itemize">Scott McPeak &lt;smcpeak@cs.berkeley.edu&gt;
+<LI CLASS="li-itemize">Wes Weimer &lt;weimer@cs.berkeley.edu&gt;
+<LI CLASS="li-itemize">Ben Liblit &lt;liblit@cs.wisc.edu&gt;
+</UL>
+All rights reserved.<BR>
+<BR>
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:<BR>
+<BR>
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.<BR>
+<BR>
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.<BR>
+<BR>
+3. The names of the contributors may not be used to endorse or promote
+products derived from this software without specific prior written
+permission.<BR>
+<BR>
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.<BR>
+<BR>
+<HR>
+<A HREF="cil017.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil019.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cil019.html b/cil/doc/cil019.html
new file mode 100644
index 0000000..84e3f8b
--- /dev/null
+++ b/cil/doc/cil019.html
@@ -0,0 +1,45 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Bug reports
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil018.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="changes.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc48">19</A>&nbsp;&nbsp;Bug reports</H2>
+We are certain that there are still some remaining bugs in CIL. If you find
+one please file a bug report in our Source Forge space
+<A HREF="javascript:loadTop('http://sourceforge.net/projects/cil')">http://sourceforge.net/projects/cil</A>. <BR>
+<BR>
+You can find there the latest announcements, a source distribution,
+bug report submission instructions and a mailing list: cil-users[at
+sign]lists.sourceforge.net. Please use this list to ask questions about CIL,
+as it will ensure your message is viewed by a broad audience. <BR>
+<BR>
+<HR>
+<A HREF="cil018.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="changes.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cilly.html b/cil/doc/cilly.html
new file mode 100644
index 0000000..1a28758
--- /dev/null
+++ b/cil/doc/cilly.html
@@ -0,0 +1,187 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+How to Use CIL
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil004.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil006.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc5">5</A>&nbsp;&nbsp;How to Use CIL</H2><A NAME="sec-cil"></A><BR>
+<BR>
+There are two predominant ways to use CIL to write a program analysis or
+transformation. The first is to phrase your analysis as a module that is
+called by our existing driver. The second is to use CIL as a stand-alone
+library. We highly recommend that you use <TT>cilly</TT>, our driver. <BR>
+<BR>
+<A NAME="toc1"></A>
+<H3 CLASS="subsection"><A NAME="htoc6">5.1</A>&nbsp;&nbsp;Using <TT>cilly</TT>, the CIL driver</H3>
+The most common way to use CIL is to write an Ocaml module containing your
+analysis and transformation, which you then link into our boilerplate
+driver application called <TT>cilly</TT>. <TT>cilly</TT> is a Perl script that
+processes and mimics <TT>GCC</TT> and <TT>MSVC</TT> command-line arguments and then
+calls <TT>cilly.byte.exe</TT> or <TT>cilly.asm.exe</TT> (CIL's Ocaml executable). <BR>
+<BR>
+An example of such module is <TT>logwrites.ml</TT>, a transformation that is
+distributed with CIL and whose purpose is to instrument code to print the
+addresses of memory locations being written. (We plan to release a
+C-language interface to CIL so that you can write your analyses in C
+instead of Ocaml.) See Section&nbsp;<A HREF="ext.html#sec-Extension">8</A> for a survey of other example
+modules. <BR>
+<BR>
+Assuming that you have written <TT>/home/necula/logwrites.ml</TT>,
+here is how you use it:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">Modify <TT>logwrites.ml</TT> so that it includes a CIL &#8220;feature
+ descriptor&#8221; like this:
+<PRE CLASS="verbatim">
+let feature : featureDescr =
+ { fd_name = "logwrites";
+ fd_enabled = ref false;
+ fd_description = "generation of code to log memory writes";
+ fd_extraopt = [];
+ fd_doit =
+ (function (f: file) -&gt;
+ let lwVisitor = new logWriteVisitor in
+ visitCilFileSameGlobals lwVisitor f)
+ }
+</PRE>The <TT>fd_name</TT> field names the feature and its associated
+ command-line arguments. The <TT>fd_enabled</TT> field is a <TT>bool ref</TT>.
+ &#8220;<TT>fd_doit</TT>&#8221; will be invoked if <TT>!fd_enabled</TT> is true after
+ argument parsing, so initialize the ref cell to true if you want
+ this feature to be enabled by default.<BR>
+<BR>
+When the user passes the <TT>--dologwrites</TT>
+ command-line option to <TT>cilly</TT>, the variable associated with the
+ <TT>fd_enabled</TT> flag is set and the <TT>fd_doit</TT> function is called
+ on the <TT>Cil.file</TT> that represents the merger (see Section&nbsp;<A HREF="merger.html#sec-merger">13</A>) of
+ all C files listed as arguments. <BR>
+<BR>
+<LI CLASS="li-enumerate">Invoke <TT>configure</TT> with the arguments
+<PRE CLASS="verbatim">
+./configure EXTRASRCDIRS=/home/necula EXTRAFEATURES=logwrites
+</PRE>
+ This step works if each feature is packaged into its own ML file, and the
+name of the entry point in the file is <TT>feature</TT>.<BR>
+<BR>
+An alternative way to specify the new features is to change the build files
+yourself, as explained below. You'll need to use this method if a single
+feature is split across multiple files.
+<OL CLASS="enumerate" type=a><LI CLASS="li-enumerate">
+ Put <TT>logwrites.ml</TT> in the <TT>src</TT> or <TT>src/ext</TT> directory. This
+ will make sure that <TT>make</TT> can find it. If you want to put it in some
+ other directory, modify <TT>Makefile.in</TT> and add to <TT>SOURCEDIRS</TT> your
+ directory. Alternately, you can create a symlink from <TT>src</TT> or
+ <TT>src/ext</TT> to your file.<BR>
+<BR>
+<LI CLASS="li-enumerate">Modify the <TT>Makefile.in</TT> and add your module to the
+ <TT>CILLY_MODULES</TT> or
+ <TT>CILLY_LIBRARY_MODULES</TT> variables. The order of the modules matters. Add
+ your modules somewhere after <TT>cil</TT> and before <TT>main</TT>.<BR>
+<BR>
+<LI CLASS="li-enumerate">If you have any helper files for your module, add those to
+ the makefile in the same way. e.g.:
+<PRE CLASS="verbatim">
+CILLY_MODULES = $(CILLY_LIBRARY_MODULES) \
+ myutilities1 myutilities2 logwrites \
+ main
+</PRE>
+ Again, order is important: <TT>myutilities2.ml</TT> will be able to refer
+ to Myutilities1 but not Logwrites. If you have any ocamllex or ocamlyacc
+ files, add them to both <TT>CILLY_MODULES</TT> and either <TT>MLLS</TT> or
+ <TT>MLYS</TT>.<BR>
+<BR>
+<LI CLASS="li-enumerate">Modify <TT>main.ml</TT> so that your new feature descriptor appears in
+ the global list of CIL features.
+<PRE CLASS="verbatim">
+let features : C.featureDescr list =
+ [ Logcalls.feature;
+ Oneret.feature;
+ Heapify.feature1;
+ Heapify.feature2;
+ makeCFGFeature;
+ Partial.feature;
+ Simplemem.feature;
+ Logwrites.feature; (* add this line to include the logwrites feature! *)
+ ]
+ @ Feature_config.features
+</PRE>
+ Features are processed in the order they appear on this list. Put
+ your feature last on the list if you plan to run any of CIL's
+ built-in features (such as makeCFGfeature) before your own.</OL><BR>
+Standard code in <TT>cilly</TT> takes care of adding command-line arguments,
+ printing the description, and calling your function automatically.
+ Note: do not worry about introducing new bugs into CIL by adding a single
+ line to the feature list. <BR>
+<BR>
+<LI CLASS="li-enumerate">Now you can invoke the <TT>cilly</TT> application on a preprocessed file, or
+ instead use the <TT>cilly</TT> driver which provides a convenient compiler-like
+ interface to <TT>cilly</TT>. See Section&nbsp;<A HREF="cil007.html#sec-driver">7</A> for details using <TT>cilly</TT>.
+ Remember to enable your analysis by passing the right argument (e.g.,
+ <TT>--dologwrites</TT>). </OL>
+<A NAME="toc2"></A>
+<H3 CLASS="subsection"><A NAME="htoc7">5.2</A>&nbsp;&nbsp;Using CIL as a library</H3>
+CIL can also be built as a library that is called from your stand-alone
+application. Add <TT>cil/src</TT>, <TT>cil/src/frontc</TT>, <TT>cil/obj/x86_LINUX</TT>
+(or <TT>cil/obj/x86_WIN32</TT>) to your Ocaml project <TT>-I</TT> include paths.
+Building CIL will also build the library <TT>cil/obj/*/cil.cma</TT> (or
+<TT>cil/obj/*/cil.cmxa</TT>). You can then link your application against that
+library. <BR>
+<BR>
+You can call the <TT>Frontc.parse: string -&gt; unit -&gt; Cil.file</TT> function with
+the name of a file containing the output of the C preprocessor.
+The <TT>Mergecil.merge: Cil.file list -&gt; string -&gt; Cil.file</TT> function merges
+multiple files. You can then invoke your analysis function on the resulting
+<TT>Cil.file</TT> data structure. You might want to call
+<TT>Rmtmps.removeUnusedTemps</TT> first to clean up the prototypes and variables
+that are not used. Then you can call the function <TT>Cil.dumpFile:
+cilPrinter -&gt; out_channel -&gt; Cil.file -&gt; unit</TT> to print the file to a
+given output channel. A good <TT>cilPrinter</TT> to use is
+<TT>defaultCilPrinter</TT>. <BR>
+<BR>
+Check out <TT>src/main.ml</TT> and <TT>bin/cilly</TT> for other good ideas
+about high-level file processing. Again, we highly recommend that you just
+our <TT>cilly</TT> driver so that you can avoid spending time re-inventing the
+wheel to provide drop-in support for standard <TT>makefile</TT>s. <BR>
+<BR>
+Here is a concrete example of compiling and linking your project against
+CIL. Imagine that your program analysis or transformation is contained in
+the single file <TT>main.ml</TT>.
+<PRE CLASS="verbatim">
+$ ocamlopt -c -I $(CIL)/obj/x86_LINUX/ main.ml
+$ ocamlopt -ccopt -L$(CIL)/obj/x86_LINUX/ -o main unix.cmxa str.cmxa \
+ $(CIL)/obj/x86_LINUX/cil.cmxa main.cmx
+</PRE>
+The first line compiles your analysis, the second line links it against CIL
+(as a library) and the Ocaml Unix library. For more information about
+compiling and linking Ocaml programs, see the Ocaml home page
+at <A HREF="javascript:loadTop('http://caml.inria.fr/ocaml/')">http://caml.inria.fr/ocaml/</A>. <BR>
+<BR>
+In the next section we give an overview of the API that you can use
+to write your analysis and transformation. <BR>
+<BR>
+<HR>
+<A HREF="cil004.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil006.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/cilpp.haux b/cil/doc/cilpp.haux
new file mode 100644
index 0000000..1b9fa16
--- /dev/null
+++ b/cil/doc/cilpp.haux
@@ -0,0 +1,64 @@
+\@addtocsec{htoc}{1}{0}{\@print{1}\quad{}Introduction}
+\@addtocsec{htoc}{2}{0}{\@print{2}\quad{}Installation}
+\@addtocsec{htoc}{3}{0}{\@print{3}\quad{}Distribution Contents}
+\@addtocsec{htoc}{4}{0}{\@print{4}\quad{}Compiling C to CIL}
+\newlabel{sec-cabs2cil}{{4}{X}}
+\@addtocsec{htoc}{5}{0}{\@print{5}\quad{}How to Use CIL}
+\newlabel{sec-cil}{{5}{X}}
+\@addtocsec{htoc}{6}{1}{\@print{5.1}\quad{}Using \t{cilly}, the CIL driver}
+\@addtocsec{htoc}{7}{1}{\@print{5.2}\quad{}Using CIL as a library}
+\@addtocsec{htoc}{8}{0}{\@print{6}\quad{}CIL API Documentation}
+\newlabel{sec-api}{{6}{X}}
+\@addtocsec{htoc}{9}{1}{\@print{6.1}\quad{}Using the visitor}
+\newlabel{sec-visitor}{{6.1}{X}}
+\@addtocsec{htoc}{10}{1}{\@print{6.2}\quad{}Interpreted Constructors and Deconstructors}
+\@addtocsec{htoc}{11}{2}{\@print{6.2.1}\quad{}Performance considerations for interpreted constructors}
+\@addtocsec{htoc}{12}{1}{\@print{6.3}\quad{}Printing and Debugging support}
+\@addtocsec{htoc}{13}{1}{\@print{6.4}\quad{}Attributes}
+\newlabel{sec-attrib}{{6.4}{X}}
+\@addtocsec{htoc}{14}{0}{\@print{7}\quad{}The CIL Driver}
+\newlabel{sec-driver}{{7}{X}}
+\@addtocsec{htoc}{15}{1}{\@print{7.1}\quad{}\t{cilly} Options}
+\@addtocsec{htoc}{16}{1}{\@print{7.2}\quad{}\t{cilly.asm} Options}
+\newlabel{sec-cilly-asm-options}{{7.2}{X}}
+\@addtocsec{htoc}{17}{0}{\@print{8}\quad{}Library of CIL Modules}
+\newlabel{sec-Extension}{{8}{X}}
+\@addtocsec{htoc}{18}{1}{\@print{8.1}\quad{}Control-Flow Graphs}
+\newlabel{sec-cfg}{{8.1}{X}}
+\@addtocsec{htoc}{19}{2}{\@print{8.1.1}\quad{}The CFG module (new in CIL 1.3.5)}
+\@addtocsec{htoc}{20}{2}{\@print{8.1.2}\quad{}Simplified control flow}
+\@addtocsec{htoc}{21}{1}{\@print{8.2}\quad{}Data flow analysis framework}
+\@addtocsec{htoc}{22}{1}{\@print{8.3}\quad{}Dominators}
+\@addtocsec{htoc}{23}{1}{\@print{8.4}\quad{}Points-to Analysis}
+\@addtocsec{htoc}{24}{1}{\@print{8.5}\quad{}StackGuard}
+\@addtocsec{htoc}{25}{1}{\@print{8.6}\quad{}Heapify}
+\@addtocsec{htoc}{26}{1}{\@print{8.7}\quad{}One Return}
+\@addtocsec{htoc}{27}{1}{\@print{8.8}\quad{}Partial Evaluation and Constant Folding}
+\@addtocsec{htoc}{28}{1}{\@print{8.9}\quad{}Reaching Definitions}
+\@addtocsec{htoc}{29}{1}{\@print{8.10}\quad{}Available Expressions}
+\@addtocsec{htoc}{30}{1}{\@print{8.11}\quad{}Liveness Analysis}
+\@addtocsec{htoc}{31}{1}{\@print{8.12}\quad{}Dead Code Elimination}
+\@addtocsec{htoc}{32}{1}{\@print{8.13}\quad{}Simple Memory Operations}
+\@addtocsec{htoc}{33}{1}{\@print{8.14}\quad{}Simple Three-Address Code}
+\@addtocsec{htoc}{34}{1}{\@print{8.15}\quad{}Converting C to C++}
+\@addtocsec{htoc}{35}{0}{\@print{9}\quad{}Controlling CIL}
+\@addtocsec{htoc}{36}{0}{\@print{10}\quad{}GCC Extensions}
+\@addtocsec{htoc}{37}{0}{\@print{11}\quad{}CIL Limitations}
+\@addtocsec{htoc}{38}{0}{\@print{12}\quad{}Known Bugs and Limitations}
+\@addtocsec{htoc}{39}{0}{\@print{13}\quad{}Using the merger}
+\newlabel{sec-merger}{{13}{X}}
+\@addtocsec{htoc}{40}{0}{\@print{14}\quad{}Using the patcher}
+\newlabel{sec-patcher}{{14}{X}}
+\@addtocsec{htoc}{41}{0}{\@print{15}\quad{}Debugging support}
+\newlabel{sec-debugger}{{15}{X}}
+\@addtocsec{htoc}{42}{0}{\@print{16}\quad{}Who Says C is Simple?}
+\newlabel{sec-simplec}{{16}{X}}
+\@addtocsec{htoc}{43}{1}{\@print{16.1}\quad{}Standard C}
+\@addtocsec{htoc}{44}{1}{\@print{16.2}\quad{}GCC ugliness}
+\newlabel{sec-ugly-gcc}{{16.2}{X}}
+\@addtocsec{htoc}{45}{1}{\@print{16.3}\quad{}Microsoft VC ugliness}
+\@addtocsec{htoc}{46}{0}{\@print{17}\quad{}Authors}
+\@addtocsec{htoc}{47}{0}{\@print{18}\quad{}License}
+\@addtocsec{htoc}{48}{0}{\@print{19}\quad{}Bug reports}
+\@addtocsec{htoc}{49}{0}{\@print{20}\quad{}Changes}
+\newlabel{sec-changes}{{20}{X}}
diff --git a/cil/doc/cilpp.htoc b/cil/doc/cilpp.htoc
new file mode 100644
index 0000000..d5bc0e5
--- /dev/null
+++ b/cil/doc/cilpp.htoc
@@ -0,0 +1,65 @@
+\begin{tocenv}
+\tocitem \@locref{htoc1}{\begin{@norefs}\@print{1}\quad{}Introduction\end{@norefs}}
+\tocitem \@locref{htoc2}{\begin{@norefs}\@print{2}\quad{}Installation\end{@norefs}}
+\tocitem \@locref{htoc3}{\begin{@norefs}\@print{3}\quad{}Distribution Contents\end{@norefs}}
+\tocitem \@locref{htoc4}{\begin{@norefs}\@print{4}\quad{}Compiling C to CIL\end{@norefs}}
+\tocitem \@locref{htoc5}{\begin{@norefs}\@print{5}\quad{}How to Use CIL\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc6}{\begin{@norefs}\@print{5.1}\quad{}Using \t{cilly}, the CIL driver\end{@norefs}}
+\tocitem \@locref{htoc7}{\begin{@norefs}\@print{5.2}\quad{}Using CIL as a library\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc8}{\begin{@norefs}\@print{6}\quad{}CIL API Documentation\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc9}{\begin{@norefs}\@print{6.1}\quad{}Using the visitor\end{@norefs}}
+\tocitem \@locref{htoc10}{\begin{@norefs}\@print{6.2}\quad{}Interpreted Constructors and Deconstructors\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc11}{\begin{@norefs}\@print{6.2.1}\quad{}Performance considerations for interpreted constructors\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc12}{\begin{@norefs}\@print{6.3}\quad{}Printing and Debugging support\end{@norefs}}
+\tocitem \@locref{htoc13}{\begin{@norefs}\@print{6.4}\quad{}Attributes\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc14}{\begin{@norefs}\@print{7}\quad{}The CIL Driver\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc15}{\begin{@norefs}\@print{7.1}\quad{}\t{cilly} Options\end{@norefs}}
+\tocitem \@locref{htoc16}{\begin{@norefs}\@print{7.2}\quad{}\t{cilly.asm} Options\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc17}{\begin{@norefs}\@print{8}\quad{}Library of CIL Modules\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc18}{\begin{@norefs}\@print{8.1}\quad{}Control-Flow Graphs\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc19}{\begin{@norefs}\@print{8.1.1}\quad{}The CFG module (new in CIL 1.3.5)\end{@norefs}}
+\tocitem \@locref{htoc20}{\begin{@norefs}\@print{8.1.2}\quad{}Simplified control flow\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc21}{\begin{@norefs}\@print{8.2}\quad{}Data flow analysis framework\end{@norefs}}
+\tocitem \@locref{htoc22}{\begin{@norefs}\@print{8.3}\quad{}Dominators\end{@norefs}}
+\tocitem \@locref{htoc23}{\begin{@norefs}\@print{8.4}\quad{}Points-to Analysis\end{@norefs}}
+\tocitem \@locref{htoc24}{\begin{@norefs}\@print{8.5}\quad{}StackGuard\end{@norefs}}
+\tocitem \@locref{htoc25}{\begin{@norefs}\@print{8.6}\quad{}Heapify\end{@norefs}}
+\tocitem \@locref{htoc26}{\begin{@norefs}\@print{8.7}\quad{}One Return\end{@norefs}}
+\tocitem \@locref{htoc27}{\begin{@norefs}\@print{8.8}\quad{}Partial Evaluation and Constant Folding\end{@norefs}}
+\tocitem \@locref{htoc28}{\begin{@norefs}\@print{8.9}\quad{}Reaching Definitions\end{@norefs}}
+\tocitem \@locref{htoc29}{\begin{@norefs}\@print{8.10}\quad{}Available Expressions\end{@norefs}}
+\tocitem \@locref{htoc30}{\begin{@norefs}\@print{8.11}\quad{}Liveness Analysis\end{@norefs}}
+\tocitem \@locref{htoc31}{\begin{@norefs}\@print{8.12}\quad{}Dead Code Elimination\end{@norefs}}
+\tocitem \@locref{htoc32}{\begin{@norefs}\@print{8.13}\quad{}Simple Memory Operations\end{@norefs}}
+\tocitem \@locref{htoc33}{\begin{@norefs}\@print{8.14}\quad{}Simple Three-Address Code\end{@norefs}}
+\tocitem \@locref{htoc34}{\begin{@norefs}\@print{8.15}\quad{}Converting C to C++\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc35}{\begin{@norefs}\@print{9}\quad{}Controlling CIL\end{@norefs}}
+\tocitem \@locref{htoc36}{\begin{@norefs}\@print{10}\quad{}GCC Extensions\end{@norefs}}
+\tocitem \@locref{htoc37}{\begin{@norefs}\@print{11}\quad{}CIL Limitations\end{@norefs}}
+\tocitem \@locref{htoc38}{\begin{@norefs}\@print{12}\quad{}Known Bugs and Limitations\end{@norefs}}
+\tocitem \@locref{htoc39}{\begin{@norefs}\@print{13}\quad{}Using the merger\end{@norefs}}
+\tocitem \@locref{htoc40}{\begin{@norefs}\@print{14}\quad{}Using the patcher\end{@norefs}}
+\tocitem \@locref{htoc41}{\begin{@norefs}\@print{15}\quad{}Debugging support\end{@norefs}}
+\tocitem \@locref{htoc42}{\begin{@norefs}\@print{16}\quad{}Who Says C is Simple?\end{@norefs}}
+\begin{tocenv}
+\tocitem \@locref{htoc43}{\begin{@norefs}\@print{16.1}\quad{}Standard C\end{@norefs}}
+\tocitem \@locref{htoc44}{\begin{@norefs}\@print{16.2}\quad{}GCC ugliness\end{@norefs}}
+\tocitem \@locref{htoc45}{\begin{@norefs}\@print{16.3}\quad{}Microsoft VC ugliness\end{@norefs}}
+\end{tocenv}
+\tocitem \@locref{htoc46}{\begin{@norefs}\@print{17}\quad{}Authors\end{@norefs}}
+\tocitem \@locref{htoc47}{\begin{@norefs}\@print{18}\quad{}License\end{@norefs}}
+\tocitem \@locref{htoc48}{\begin{@norefs}\@print{19}\quad{}Bug reports\end{@norefs}}
+\tocitem \@locref{htoc49}{\begin{@norefs}\@print{20}\quad{}Changes\end{@norefs}}
+\end{tocenv}
diff --git a/cil/doc/ciltoc.html b/cil/doc/ciltoc.html
new file mode 100644
index 0000000..7fe4c80
--- /dev/null
+++ b/cil/doc/ciltoc.html
@@ -0,0 +1,92 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+
+<HEAD>
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+</HEAD>
+
+<BODY >
+<!--HEVEA command line is: /usr/bin/hevea -exec xxdate.exe ../../cilpp -->
+<!--HACHA command line is: /usr/bin/hacha -o ciltoc.html cil.html -->
+
+
+
+<TABLE CLASS="title">
+<TR><TD></TD>
+</TR></TABLE><BR>
+<UL>
+<LI><A HREF="cil001.html">Introduction</A>
+<LI><A HREF="cil002.html">Installation</A>
+<LI><A HREF="cil003.html">Distribution Contents</A>
+<LI><A HREF="cil004.html">Compiling C to CIL</A>
+<LI><A HREF="cilly.html">How to Use CIL</A>
+<UL>
+<LI><A HREF="cilly.html#toc1">Using <TT>cilly</TT>, the CIL driver</A>
+<LI><A HREF="cilly.html#toc2">Using CIL as a library</A>
+</UL>
+<LI><A HREF="cil006.html">CIL API Documentation</A>
+<UL>
+<LI><A HREF="cil006.html#toc3">Using the visitor</A>
+<LI><A HREF="cil006.html#toc4">Interpreted Constructors and Deconstructors</A>
+<LI><A HREF="cil006.html#toc5">Printing and Debugging support</A>
+<LI><A HREF="cil006.html#toc6">Attributes</A>
+</UL>
+<LI><A HREF="cil007.html">The CIL Driver</A>
+<UL>
+<LI><A HREF="cil007.html#toc7"><TT>cilly</TT> Options</A>
+<LI><A HREF="cil007.html#toc8"><TT>cilly.asm</TT> Options</A>
+</UL>
+<LI><A HREF="ext.html">Library of CIL Modules</A>
+<UL>
+<LI><A HREF="ext.html#toc9">Control-Flow Graphs</A>
+<LI><A HREF="ext.html#toc10">Data flow analysis framework</A>
+<LI><A HREF="ext.html#toc11">Dominators</A>
+<LI><A HREF="ext.html#toc12">Points-to Analysis</A>
+<LI><A HREF="ext.html#toc13">StackGuard</A>
+<LI><A HREF="ext.html#toc14">Heapify</A>
+<LI><A HREF="ext.html#toc15">One Return</A>
+<LI><A HREF="ext.html#toc16">Partial Evaluation and Constant Folding</A>
+<LI><A HREF="ext.html#toc17">Reaching Definitions</A>
+<LI><A HREF="ext.html#toc18">Available Expressions</A>
+<LI><A HREF="ext.html#toc19">Liveness Analysis</A>
+<LI><A HREF="ext.html#toc20">Dead Code Elimination</A>
+<LI><A HREF="ext.html#toc21">Simple Memory Operations</A>
+<LI><A HREF="ext.html#toc22">Simple Three-Address Code</A>
+<LI><A HREF="ext.html#toc23">Converting C to C++</A>
+</UL>
+<LI><A HREF="cil009.html">Controlling CIL</A>
+<LI><A HREF="cil010.html">GCC Extensions</A>
+<LI><A HREF="cil011.html">CIL Limitations</A>
+<LI><A HREF="cil012.html">Known Bugs and Limitations</A>
+<LI><A HREF="merger.html">Using the merger</A>
+<LI><A HREF="patcher.html">Using the patcher</A>
+<LI><A HREF="cil015.html">Debugging support</A>
+<LI><A HREF="cil016.html">Who Says C is Simple?</A>
+<UL>
+<LI><A HREF="cil016.html#toc24">Standard C</A>
+<LI><A HREF="cil016.html#toc25">GCC ugliness</A>
+<LI><A HREF="cil016.html#toc26">Microsoft VC ugliness</A>
+</UL>
+<LI><A HREF="cil017.html">Authors</A>
+<LI><A HREF="cil018.html">License</A>
+<LI><A HREF="cil019.html">Bug reports</A>
+<LI><A HREF="changes.html">Changes</A>
+</UL>
+<!--FOOTER-->
+<HR SIZE=2><BLOCKQUOTE CLASS="quote"><EM>This document was translated from L<sup>A</sup>T<sub>E</sub>X by
+</EM><A HREF="http://pauillac.inria.fr/~maranget/hevea/index.html"><EM>H<FONT SIZE=2><sup>E</sup></FONT>V<FONT SIZE=2><sup>E</sup></FONT>A</EM></A><EM>.</EM></BLOCKQUOTE></BODY>
+</HTML>
diff --git a/cil/doc/contents_motif.gif b/cil/doc/contents_motif.gif
new file mode 100644
index 0000000..5d3d016
--- /dev/null
+++ b/cil/doc/contents_motif.gif
Binary files differ
diff --git a/cil/doc/examples/ex1.txt b/cil/doc/examples/ex1.txt
new file mode 100644
index 0000000..2fe6c21
--- /dev/null
+++ b/cil/doc/examples/ex1.txt
@@ -0,0 +1,16 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex1.c"
+long x ;
+#line 3 "cilcode.tmp/ex1.c"
+static long long y ;
+#line 6 "cilcode.tmp/ex1.c"
+int main(void)
+{
+
+ {
+#line 6
+ return ((int )((long long )x + y));
+}
+}
diff --git a/cil/doc/examples/ex10.txt b/cil/doc/examples/ex10.txt
new file mode 100644
index 0000000..7213b4c
--- /dev/null
+++ b/cil/doc/examples/ex10.txt
@@ -0,0 +1,10 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex10.c"
+char foo[13] =
+#line 1
+ { (char )'f', (char )'o', (char )'o', (char )' ',
+ (char )'p', (char )'l', (char )'u', (char )'s',
+ (char )' ', (char )'b', (char )'a', (char )'r',
+ (char )'\000'};
diff --git a/cil/doc/examples/ex11.txt b/cil/doc/examples/ex11.txt
new file mode 100644
index 0000000..683df51
--- /dev/null
+++ b/cil/doc/examples/ex11.txt
@@ -0,0 +1,5 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex11.c"
+char *foo = (char *)"foo plus bar ";
diff --git a/cil/doc/examples/ex12.txt b/cil/doc/examples/ex12.txt
new file mode 100644
index 0000000..d04d83d
--- /dev/null
+++ b/cil/doc/examples/ex12.txt
@@ -0,0 +1,32 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 2 "cilcode.tmp/ex12.c"
+struct foo {
+ int f1 ;
+ int f2 ;
+};
+#line 1 "cilcode.tmp/ex12.c"
+int main(void)
+{ int x ;
+ struct foo a[3] ;
+
+ {
+#line 1
+ x = 5;
+#line 2
+ a[0].f1 = 1;
+#line 2
+ a[0].f2 = 2;
+#line 2
+ a[1].f1 = 3;
+#line 2
+ a[1].f2 = 4;
+#line 2
+ a[2].f1 = 5;
+#line 2
+ a[2].f2 = 0;
+#line 3
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex13.txt b/cil/doc/examples/ex13.txt
new file mode 100644
index 0000000..6486ad6
--- /dev/null
+++ b/cil/doc/examples/ex13.txt
@@ -0,0 +1,21 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex13.c"
+int x = 5;
+#line 2 "cilcode.tmp/ex13.c"
+int main(void)
+{ int x___0 ;
+ int x___1 ;
+
+ {
+#line 3
+ x___0 = 6;
+#line 5
+ x___1 = 7;
+#line 6
+ return (x___1);
+#line 8
+ return (x___0);
+}
+}
diff --git a/cil/doc/examples/ex14.txt b/cil/doc/examples/ex14.txt
new file mode 100644
index 0000000..72fc719
--- /dev/null
+++ b/cil/doc/examples/ex14.txt
@@ -0,0 +1,22 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex14.c"
+int x = 5;
+#line 5
+int main(void) ;
+#line 5 "cilcode.tmp/ex14.c"
+static int x___1 = 7;
+#line 2 "cilcode.tmp/ex14.c"
+int main(void)
+{ int x___0 ;
+
+ {
+#line 3
+ x___0 = 6;
+#line 6
+ return (x___1);
+#line 8
+ return (x___0);
+}
+}
diff --git a/cil/doc/examples/ex15.txt b/cil/doc/examples/ex15.txt
new file mode 100644
index 0000000..4f64ae9
--- /dev/null
+++ b/cil/doc/examples/ex15.txt
@@ -0,0 +1,14 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex15.c"
+int foo(void)
+{ int x ;
+
+ {
+#line 2
+ x = 5;
+#line 3
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex16.txt b/cil/doc/examples/ex16.txt
new file mode 100644
index 0000000..82290c2
--- /dev/null
+++ b/cil/doc/examples/ex16.txt
@@ -0,0 +1,22 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex16.c"
+extern int f(int ) ;
+#line 1 "cilcode.tmp/ex16.c"
+int main(void)
+{ int x ;
+ int tmp ;
+ int tmp___0 ;
+
+ {
+#line 2
+ tmp = x;
+#line 2
+ x ++;
+#line 2
+ tmp___0 = f(x);
+#line 2
+ return (tmp + tmp___0);
+}
+}
diff --git a/cil/doc/examples/ex17.txt b/cil/doc/examples/ex17.txt
new file mode 100644
index 0000000..20bbaa7
--- /dev/null
+++ b/cil/doc/examples/ex17.txt
@@ -0,0 +1,81 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex17.c"
+int main(void)
+{ int x ;
+ int y ;
+ int tmp ;
+ int z ;
+ int tmp___0 ;
+
+ {
+#line 2
+ if (x) {
+#line 2
+ tmp = 2;
+ } else {
+#line 2
+ tmp = 4;
+ }
+#line 2
+ y = tmp;
+#line 3
+ if (x) {
+#line 3
+ tmp___0 = 1;
+ } else {
+#line 3
+ if (y) {
+#line 3
+ tmp___0 = 1;
+ } else {
+#line 3
+ tmp___0 = 0;
+ }
+ }
+#line 3
+ z = tmp___0;
+#line 5
+ if (x) {
+#line 5
+ if (y) {
+#line 5
+ return (0);
+ } else {
+#line 5
+ return (1);
+ }
+ } else {
+#line 5
+ return (1);
+ }
+#line 8
+ if (x) {
+#line 8
+ if (y) {
+ goto _L;
+ } else {
+ goto _L___0;
+ }
+ } else {
+ _L___0: /* CIL Label */
+#line 8
+ if (z) {
+ _L: /* CIL Label */
+#line 8
+ x ++;
+#line 8
+ y ++;
+#line 8
+ z ++;
+#line 8
+ x ++;
+#line 8
+ y ++;
+#line 8
+ return (z);
+ }
+ }
+}
+}
diff --git a/cil/doc/examples/ex18.txt b/cil/doc/examples/ex18.txt
new file mode 100644
index 0000000..bcdb7ef
--- /dev/null
+++ b/cil/doc/examples/ex18.txt
@@ -0,0 +1,20 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex18.c"
+extern int f() ;
+#line 1 "cilcode.tmp/ex18.c"
+int main(void)
+{ int tmp___0 ;
+
+ {
+#line 2
+ tmp___0 = f();
+ if (! tmp___0) {
+#line 2
+ tmp___0 = 4;
+ }
+#line 2
+ return (tmp___0);
+}
+}
diff --git a/cil/doc/examples/ex19.txt b/cil/doc/examples/ex19.txt
new file mode 100644
index 0000000..3b82868
--- /dev/null
+++ b/cil/doc/examples/ex19.txt
@@ -0,0 +1,42 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex19.c"
+int main(void)
+{ int x ;
+ int i ;
+
+ {
+#line 2
+ i = 0;
+#line 2
+ while (i < 5) {
+#line 3
+ if (i == 5) {
+ goto __Cont;
+ }
+#line 4
+ if (i == 4) {
+#line 4
+ break;
+ }
+#line 5
+ i += 2;
+ __Cont: /* CIL Label */
+#line 2
+ i ++;
+ }
+#line 7
+ while (x < 5) {
+#line 8
+ if (x == 3) {
+#line 8
+ continue;
+ }
+#line 9
+ x ++;
+ }
+#line 11
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex2.txt b/cil/doc/examples/ex2.txt
new file mode 100644
index 0000000..2031382
--- /dev/null
+++ b/cil/doc/examples/ex2.txt
@@ -0,0 +1,9 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex2.c"
+struct __anonstruct_s_1 {
+ int x ;
+};
+#line 1 "cilcode.tmp/ex2.c"
+struct __anonstruct_s_1 s ;
diff --git a/cil/doc/examples/ex20.txt b/cil/doc/examples/ex20.txt
new file mode 100644
index 0000000..7a51db3
--- /dev/null
+++ b/cil/doc/examples/ex20.txt
@@ -0,0 +1,26 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex20.c"
+int main(void)
+{ int x ;
+ int y ;
+ int z ;
+
+ {
+#line 1
+ x = 5;
+#line 1
+ y = x;
+#line 2
+ x ++;
+ L:
+#line 2
+ y -= x;
+#line 2
+ z = y;
+ goto L;
+#line 3
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex21.txt b/cil/doc/examples/ex21.txt
new file mode 100644
index 0000000..3f331e4
--- /dev/null
+++ b/cil/doc/examples/ex21.txt
@@ -0,0 +1,25 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex21.c"
+int main(void)
+{ int x ;
+ int y ;
+ int z ;
+ int *tmp ;
+
+ {
+#line 2
+ if (x) {
+#line 2
+ tmp = & y;
+ } else {
+#line 2
+ tmp = & z;
+ }
+#line 2
+ x ++;
+#line 2
+ return (tmp - & x);
+}
+}
diff --git a/cil/doc/examples/ex22.txt b/cil/doc/examples/ex22.txt
new file mode 100644
index 0000000..2224e7c
--- /dev/null
+++ b/cil/doc/examples/ex22.txt
@@ -0,0 +1,16 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 327 "/usr/include/stdio.h"
+extern int printf(char const * __restrict __format , ...) ;
+#line 7 "cilcode.tmp/ex22.c"
+int main(void)
+{
+
+ {
+#line 9
+ printf((char const * __restrict )"Hello world\n");
+#line 10
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex23.txt b/cil/doc/examples/ex23.txt
new file mode 100644
index 0000000..d48a135
--- /dev/null
+++ b/cil/doc/examples/ex23.txt
@@ -0,0 +1,56 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex23.c"
+int foo(int predicate )
+{ int x ;
+
+ {
+#line 2
+ x = 0;
+#line 4
+ if (predicate == 0) {
+ goto switch_0_0;
+ } else {
+#line 5
+ if (predicate == 1) {
+ goto switch_0_1;
+ } else {
+#line 6
+ if (predicate == 2) {
+ goto switch_0_2;
+ } else {
+#line 7
+ if (predicate == 3) {
+ goto switch_0_3;
+ } else {
+ {
+ goto switch_0_default;
+#line 3
+ if (0) {
+ switch_0_0: /* CIL Label */
+#line 4
+ return (111);
+ switch_0_1: /* CIL Label */
+#line 5
+ x ++;
+ switch_0_2: /* CIL Label */
+#line 6
+ return (x + 3);
+ switch_0_3: /* CIL Label */
+ goto switch_0_break;
+ switch_0_default: /* CIL Label */ ;
+#line 8
+ return (222);
+ } else {
+ switch_0_break: /* CIL Label */ ;
+ }
+ }
+ }
+ }
+ }
+ }
+#line 10
+ return (333);
+}
+}
diff --git a/cil/doc/examples/ex24.txt b/cil/doc/examples/ex24.txt
new file mode 100644
index 0000000..587ce67
--- /dev/null
+++ b/cil/doc/examples/ex24.txt
@@ -0,0 +1,59 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+extern void * stackguard_get_ra();
+extern void stackguard_set_ra(void *new_ra);
+/* You must provide an implementation for functions that get and set the
+ * return address. Such code is unfortunately architecture specific.
+ */
+struct stackguard_stack {
+ void * data;
+ struct stackguard_stack * next;
+} * stackguard_stack;
+
+void stackguard_push(void *ra) {
+ void * old = stackguard_stack;
+ stackguard_stack = (struct stackguard_stack *)
+ malloc(sizeof(stackguard_stack));
+ stackguard_stack->data = ra;
+ stackguard_stack->next = old;
+}
+
+void * stackguard_pop() {
+ void * ret = stackguard_stack->data;
+ void * next = stackguard_stack->next;
+ free(stackguard_stack);
+ stackguard_stack->next = next;
+ return ret;
+}
+#line 3 "cilcode.tmp/ex24.c"
+extern int ( /* missing proto */ scanf)() ;
+#line 1 "cilcode.tmp/ex24.c"
+int dangerous(void)
+{ char array[10] ;
+ void *return_address ;
+
+ {
+ return_address = (void *)stackguard_get_ra();
+ stackguard_push(return_address);
+#line 3
+ scanf("%s", array);
+ {
+ return_address = (void *)stackguard_pop();
+ stackguard_set_ra(return_address);
+#line 4
+ return (0);
+ }
+}
+}
+#line 6 "cilcode.tmp/ex24.c"
+int main(void)
+{ int tmp ;
+
+ {
+#line 7
+ tmp = dangerous();
+#line 7
+ return (tmp);
+}
+}
diff --git a/cil/doc/examples/ex25.txt b/cil/doc/examples/ex25.txt
new file mode 100644
index 0000000..88f6902
--- /dev/null
+++ b/cil/doc/examples/ex25.txt
@@ -0,0 +1,40 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 3 "cilcode.tmp/ex25.c"
+extern int ( /* missing proto */ scanf)() ;
+#line 1 "cilcode.tmp/ex25.c"
+struct dangerous_heapify {
+ char array[10] ;
+};
+#line 1 "cilcode.tmp/ex25.c"
+int dangerous(void)
+{ struct dangerous_heapify *dangerous_heapify ;
+ int __cil_tmp3 ;
+
+ {
+#line 1
+ dangerous_heapify = (struct dangerous_heapify *)malloc(sizeof(struct dangerous_heapify ));
+#line 3
+ scanf("%s", dangerous_heapify->array);
+ {
+#line 4
+ __cil_tmp3 = 0;
+#line 4
+ free(dangerous_heapify);
+#line 4
+ return (__cil_tmp3);
+ }
+}
+}
+#line 6 "cilcode.tmp/ex25.c"
+int main(void)
+{ int tmp ;
+
+ {
+#line 7
+ tmp = dangerous();
+#line 7
+ return (tmp);
+}
+}
diff --git a/cil/doc/examples/ex26.txt b/cil/doc/examples/ex26.txt
new file mode 100644
index 0000000..8f5b171
--- /dev/null
+++ b/cil/doc/examples/ex26.txt
@@ -0,0 +1,29 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex26.c"
+int foo(int predicate )
+{ int __retres ;
+
+ {
+#line 2
+ if (predicate <= 0) {
+#line 3
+ __retres = 1;
+ goto return_label;
+ } else {
+#line 5
+ if (predicate > 5) {
+#line 6
+ __retres = 2;
+ goto return_label;
+ }
+#line 7
+ __retres = 3;
+ goto return_label;
+ }
+ return_label: /* CIL Label */
+#line 1
+ return (__retres);
+}
+}
diff --git a/cil/doc/examples/ex27.txt b/cil/doc/examples/ex27.txt
new file mode 100644
index 0000000..6059113
--- /dev/null
+++ b/cil/doc/examples/ex27.txt
@@ -0,0 +1,51 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex27.c"
+int foo(int x , int y )
+{ int unknown ;
+
+ {
+#line 3
+ if (unknown) {
+#line 4
+ return (9);
+ }
+#line 5
+ return (x + 3);
+}
+}
+#line 8 "cilcode.tmp/ex27.c"
+int main(void)
+{ int a ;
+ int b ;
+ int c ;
+ int tmp ;
+ int tmp___0 ;
+
+ {
+ {
+#line 10
+ tmp = foo(5, 7);
+#line 10
+ tmp___0 = foo(6, 7);
+#line 10
+ a = tmp + tmp___0;
+#line 11
+ b = 4;
+#line 12
+ c = 16;
+ }
+ {
+ {
+#line 16
+ return (20);
+ }
+#line 13
+ if (0) {
+#line 14
+ return (b - c);
+ }
+ }
+}
+}
diff --git a/cil/doc/examples/ex28.txt b/cil/doc/examples/ex28.txt
new file mode 100644
index 0000000..098b144
--- /dev/null
+++ b/cil/doc/examples/ex28.txt
@@ -0,0 +1,24 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex28.c"
+int main(void)
+{ int ***three ;
+ int **two ;
+ int **mem_3 ;
+ int *mem_4 ;
+ int *mem_5 ;
+
+ {
+#line 4
+ mem_3 = (*three);
+#line 4
+ mem_4 = (*mem_3);
+#line 4
+ mem_5 = (*two);
+#line 4
+ (*mem_4) = (*mem_5);
+#line 5
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex29.txt b/cil/doc/examples/ex29.txt
new file mode 100644
index 0000000..7df8f68
--- /dev/null
+++ b/cil/doc/examples/ex29.txt
@@ -0,0 +1,53 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 2 "cilcode.tmp/ex29.c"
+struct mystruct {
+ int a ;
+ int b ;
+};
+#line 1 "cilcode.tmp/ex29.c"
+int main(void)
+{ struct mystruct m ;
+ int local ;
+ int arr[3] ;
+ int *ptr ;
+ unsigned int __cil_tmp5 ;
+ unsigned int __cil_tmp6 ;
+ int __cil_tmp7 ;
+ unsigned int __cil_tmp8 ;
+ int *__cil_tmp9 ;
+ int __cil_tmp10 ;
+ unsigned int __cil_tmp11 ;
+ unsigned int __cil_tmp12 ;
+ unsigned int __cil_tmp13 ;
+ int m_b14 ;
+ int m_a15 ;
+
+ {
+#line 10
+ ptr = & local;
+#line 11
+ __cil_tmp5 = 2 * 4U;
+#line 11
+ __cil_tmp6 = (unsigned int )(arr) + __cil_tmp5;
+#line 11
+ __cil_tmp7 = (*((int *)__cil_tmp6));
+#line 11
+ __cil_tmp8 = (unsigned int )__cil_tmp7;
+#line 11
+ __cil_tmp9 = & local;
+#line 11
+ __cil_tmp10 = (*__cil_tmp9);
+#line 11
+ __cil_tmp11 = (unsigned int )__cil_tmp10;
+#line 11
+ __cil_tmp12 = __cil_tmp11 + 8U;
+#line 11
+ __cil_tmp13 = __cil_tmp12 + __cil_tmp8;
+#line 11
+ m_a15 = (int )__cil_tmp13;
+#line 12
+ return (m_a15);
+}
+}
diff --git a/cil/doc/examples/ex3.txt b/cil/doc/examples/ex3.txt
new file mode 100644
index 0000000..2ca8ac9
--- /dev/null
+++ b/cil/doc/examples/ex3.txt
@@ -0,0 +1,20 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex3.c"
+union baz {
+ int x1 ;
+ double x2 ;
+};
+#line 1 "cilcode.tmp/ex3.c"
+struct bar {
+ union baz u1 ;
+ int y ;
+};
+#line 1 "cilcode.tmp/ex3.c"
+struct foo {
+ struct bar s1 ;
+ int z ;
+};
+#line 1 "cilcode.tmp/ex3.c"
+struct foo f ;
diff --git a/cil/doc/examples/ex30.txt b/cil/doc/examples/ex30.txt
new file mode 100644
index 0000000..729cfb0
--- /dev/null
+++ b/cil/doc/examples/ex30.txt
@@ -0,0 +1,12 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex30.c"
+int main(void)
+{ int x ;
+
+ {
+#line 2
+ return (x == (x != 0));
+}
+}
diff --git a/cil/doc/examples/ex31.txt b/cil/doc/examples/ex31.txt
new file mode 100644
index 0000000..ab7d471
--- /dev/null
+++ b/cil/doc/examples/ex31.txt
@@ -0,0 +1,12 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex31.c"
+int main(void)
+{
+
+ {
+#line 1
+ return ((int )((1U - sizeof(int )) >> 32));
+}
+}
diff --git a/cil/doc/examples/ex32.txt b/cil/doc/examples/ex32.txt
new file mode 100644
index 0000000..f2b6b5b
--- /dev/null
+++ b/cil/doc/examples/ex32.txt
@@ -0,0 +1,16 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex32.c"
+int x = 5;
+#line 2 "cilcode.tmp/ex32.c"
+int f(void)
+{ int x___0 ;
+
+ {
+#line 3
+ x___0 = 3;
+#line 6
+ return (x);
+}
+}
diff --git a/cil/doc/examples/ex33.txt b/cil/doc/examples/ex33.txt
new file mode 100644
index 0000000..f73178f
--- /dev/null
+++ b/cil/doc/examples/ex33.txt
@@ -0,0 +1,24 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex33.c"
+int (*pf)(void) ;
+#line 2 "cilcode.tmp/ex33.c"
+int f(void)
+{
+
+ {
+#line 4
+ pf = & f;
+#line 5
+ pf = & f;
+#line 6
+ ((*pf))();
+#line 7
+ ((*pf))();
+#line 8
+ f();
+#line 9
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex34.txt b/cil/doc/examples/ex34.txt
new file mode 100644
index 0000000..494ca91
--- /dev/null
+++ b/cil/doc/examples/ex34.txt
@@ -0,0 +1,15 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex34.c"
+struct __anonstruct_nested_2 {
+ int y ;
+ int z ;
+};
+#line 1 "cilcode.tmp/ex34.c"
+struct __anonstruct_i_1 {
+ int x ;
+ struct __anonstruct_nested_2 nested ;
+};
+#line 1 "cilcode.tmp/ex34.c"
+struct __anonstruct_i_1 i = {1, {2, 6}};
diff --git a/cil/doc/examples/ex35.txt b/cil/doc/examples/ex35.txt
new file mode 100644
index 0000000..1af7447
--- /dev/null
+++ b/cil/doc/examples/ex35.txt
@@ -0,0 +1,32 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex35.c"
+struct __anonstruct_T1_1 {
+ char *key ;
+ char *value ;
+};
+#line 1 "cilcode.tmp/ex35.c"
+typedef struct __anonstruct_T1_1 T1;
+#line 7 "cilcode.tmp/ex35.c"
+struct __anonstruct_T3_2 {
+ long type ;
+ char *value ;
+};
+#line 7 "cilcode.tmp/ex35.c"
+typedef struct __anonstruct_T3_2 T3;
+#line 13 "cilcode.tmp/ex35.c"
+struct __anonstruct_T3_2 __constr_expr_0 = {1L, (char *)1};
+#line 13 "cilcode.tmp/ex35.c"
+T1 a[1] = { {(char *)"", (char *)(& __constr_expr_0)}};
+#line 20 "cilcode.tmp/ex35.c"
+int main(void)
+{ T3 *pt3 ;
+
+ {
+#line 21
+ pt3 = (T3 *)a[0].value;
+#line 22
+ return ((int )pt3->value);
+}
+}
diff --git a/cil/doc/examples/ex36.txt b/cil/doc/examples/ex36.txt
new file mode 100644
index 0000000..adbcdaa
--- /dev/null
+++ b/cil/doc/examples/ex36.txt
@@ -0,0 +1,20 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex36.c"
+int main(void)
+{ int __constr_expr_0[4] ;
+
+ {
+#line 1
+ __constr_expr_0[0] = 1;
+#line 1
+ __constr_expr_0[1] = 2;
+#line 1
+ __constr_expr_0[2] = 3;
+#line 1
+ __constr_expr_0[3] = 4;
+#line 1
+ return (__constr_expr_0[1]);
+}
+}
diff --git a/cil/doc/examples/ex37.txt b/cil/doc/examples/ex37.txt
new file mode 100644
index 0000000..00d6ca4
--- /dev/null
+++ b/cil/doc/examples/ex37.txt
@@ -0,0 +1,14 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 3 "cilcode.tmp/ex37.c"
+int foo(void) ;
+#line 1 "cilcode.tmp/ex37.c"
+int foo(void)
+{
+
+ {
+#line 5
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex38.txt b/cil/doc/examples/ex38.txt
new file mode 100644
index 0000000..706e13d
--- /dev/null
+++ b/cil/doc/examples/ex38.txt
@@ -0,0 +1,12 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex38.c"
+unsigned long foo(void)
+{
+
+ {
+#line 2
+ return (536870911UL);
+}
+}
diff --git a/cil/doc/examples/ex39.txt b/cil/doc/examples/ex39.txt
new file mode 100644
index 0000000..2c8c25f
--- /dev/null
+++ b/cil/doc/examples/ex39.txt
@@ -0,0 +1,25 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex39.c"
+int main(void)
+{ int x ;
+ int y ;
+ int z ;
+ int *tmp ;
+
+ {
+#line 2
+ if (x) {
+#line 2
+ tmp = & y;
+ } else {
+#line 2
+ tmp = & z;
+ }
+#line 2
+ x ++;
+#line 2
+ return (tmp - & x);
+}
+}
diff --git a/cil/doc/examples/ex4.txt b/cil/doc/examples/ex4.txt
new file mode 100644
index 0000000..00a22d3
--- /dev/null
+++ b/cil/doc/examples/ex4.txt
@@ -0,0 +1,16 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 2 "cilcode.tmp/ex4.c"
+struct foo {
+ int x ;
+};
+#line 1 "cilcode.tmp/ex4.c"
+int main(void)
+{ struct foo foo ;
+
+ {
+#line 8
+ return (foo.x);
+}
+}
diff --git a/cil/doc/examples/ex40.txt b/cil/doc/examples/ex40.txt
new file mode 100644
index 0000000..c41496b
--- /dev/null
+++ b/cil/doc/examples/ex40.txt
@@ -0,0 +1,20 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex40.c"
+extern int f() ;
+#line 1 "cilcode.tmp/ex40.c"
+int main(void)
+{ int tmp___0 ;
+
+ {
+#line 2
+ tmp___0 = f();
+ if (! tmp___0) {
+#line 2
+ tmp___0 = -1;
+ }
+#line 2
+ return (tmp___0);
+}
+}
diff --git a/cil/doc/examples/ex41.txt b/cil/doc/examples/ex41.txt
new file mode 100644
index 0000000..f1196f3
--- /dev/null
+++ b/cil/doc/examples/ex41.txt
@@ -0,0 +1,69 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex41.c"
+static void *jtab[2] ;
+#line 4
+static int doit(int x ) ;
+#line 4 "cilcode.tmp/ex41.c"
+static int jtab_init = 0;
+#line 2 "cilcode.tmp/ex41.c"
+static int doit(int x )
+{ unsigned int __compgoto ;
+
+ {
+#line 5
+ if (! jtab_init) {
+#line 6
+ jtab[0] = (void *)0;
+#line 7
+ jtab[1] = (void *)1;
+#line 8
+ jtab_init = 1;
+ }
+#line 10
+ __compgoto = (unsigned int )jtab[x];
+#line 10
+ switch (__compgoto) {
+ case 1:
+ goto lbl2;
+ case 0:
+ goto lbl1;
+ default:
+#line 10
+ (*((int *)0)) = 0;
+ }
+ lbl1:
+#line 12
+ return (0);
+ lbl2:
+#line 14
+ return (1);
+}
+}
+#line 18
+extern int ( /* missing proto */ exit)() ;
+#line 17 "cilcode.tmp/ex41.c"
+int main(void)
+{ int tmp ;
+ int tmp___0 ;
+
+ {
+#line 18
+ tmp = doit(0);
+#line 18
+ if (tmp != 0) {
+#line 18
+ exit(1);
+ }
+#line 19
+ tmp___0 = doit(1);
+#line 19
+ if (tmp___0 != 1) {
+#line 19
+ exit(1);
+ }
+#line 20
+ exit(0);
+}
+}
diff --git a/cil/doc/examples/ex42.txt b/cil/doc/examples/ex42.txt
new file mode 100644
index 0000000..b0f40b8
--- /dev/null
+++ b/cil/doc/examples/ex42.txt
@@ -0,0 +1,22 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex42.c"
+int main(void)
+{ int tmp ;
+
+ {
+ goto L;
+#line 1
+ if (0) {
+ L:
+#line 1
+ tmp = 1;
+ } else {
+#line 1
+ tmp = 0;
+ }
+#line 1
+ return (tmp);
+}
+}
diff --git a/cil/doc/examples/ex43.txt b/cil/doc/examples/ex43.txt
new file mode 100644
index 0000000..4104f79
--- /dev/null
+++ b/cil/doc/examples/ex43.txt
@@ -0,0 +1,46 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex43.c"
+__inline static int foo__extinline(void)
+{
+
+ {
+#line 1
+ return (1);
+}
+}
+#line 2 "cilcode.tmp/ex43.c"
+int firstuse(void)
+{ int tmp ;
+
+ {
+#line 2
+ tmp = foo__extinline();
+#line 2
+ return (tmp);
+}
+}
+#line 5 "cilcode.tmp/ex43.c"
+int foo(void)
+{
+
+ {
+#line 5
+ return (2);
+}
+}
+#line 7 "cilcode.tmp/ex43.c"
+int main(void)
+{ int tmp ;
+ int tmp___0 ;
+
+ {
+#line 8
+ tmp = foo();
+#line 8
+ tmp___0 = firstuse();
+#line 8
+ return (tmp + tmp___0);
+}
+}
diff --git a/cil/doc/examples/ex44.txt b/cil/doc/examples/ex44.txt
new file mode 100644
index 0000000..06f83ba
--- /dev/null
+++ b/cil/doc/examples/ex44.txt
@@ -0,0 +1,31 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex44.c"
+struct s {
+ int i1 ;
+ int i2 ;
+};
+#line 1 "cilcode.tmp/ex44.c"
+union u {
+ int i ;
+ struct s s ;
+};
+#line 8 "cilcode.tmp/ex44.c"
+union u x = {6};
+#line 10 "cilcode.tmp/ex44.c"
+int main(void)
+{ struct s y ;
+ union u z ;
+
+ {
+#line 11
+ y.i1 = 1;
+#line 11
+ y.i2 = 2;
+#line 12
+ z.s = y;
+#line 13
+ return (0);
+}
+}
diff --git a/cil/doc/examples/ex45.txt b/cil/doc/examples/ex45.txt
new file mode 100644
index 0000000..aaafca3
--- /dev/null
+++ b/cil/doc/examples/ex45.txt
@@ -0,0 +1,11 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex45.c"
+char i8 ;
+#line 2 "cilcode.tmp/ex45.c"
+short i16 ;
+#line 3 "cilcode.tmp/ex45.c"
+int i32 ;
+#line 4 "cilcode.tmp/ex45.c"
+long long i64 ;
diff --git a/cil/doc/examples/ex46.txt b/cil/doc/examples/ex46.txt
new file mode 100644
index 0000000..1f87ec2
--- /dev/null
+++ b/cil/doc/examples/ex46.txt
@@ -0,0 +1,23 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex46.c"
+static int bar(int x , char y )
+{
+
+ {
+#line 2
+ return (x + (int )y);
+}
+}
+#line 6 "cilcode.tmp/ex46.c"
+int foo(int x , char y )
+{ int tmp ;
+
+ {
+#line 6
+ tmp = bar(x, y);
+#line 6
+ return (tmp);
+}
+}
diff --git a/cil/doc/examples/ex47.txt b/cil/doc/examples/ex47.txt
new file mode 100644
index 0000000..cc5c306
--- /dev/null
+++ b/cil/doc/examples/ex47.txt
@@ -0,0 +1,28 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex47.c"
+struct __anonstruct____missing_field_name_3 {
+ int u ;
+ int v ;
+};
+#line 1 "cilcode.tmp/ex47.c"
+struct __anonstruct____missing_field_name_2 {
+ int y ;
+ int z ;
+ struct __anonstruct____missing_field_name_3 __annonCompField1 ;
+};
+#line 1 "cilcode.tmp/ex47.c"
+struct __anonstruct_a_1 {
+ int x ;
+ struct __anonstruct____missing_field_name_2 __annonCompField2 ;
+};
+#line 1 "cilcode.tmp/ex47.c"
+int main(void)
+{ struct __anonstruct_a_1 a ;
+
+ {
+#line 10
+ return ((((a.x + a.__annonCompField2.y) + a.__annonCompField2.z) + a.__annonCompField2.__annonCompField1.u) + a.__annonCompField2.__annonCompField1.v);
+}
+}
diff --git a/cil/doc/examples/ex5.txt b/cil/doc/examples/ex5.txt
new file mode 100644
index 0000000..d750bb5
--- /dev/null
+++ b/cil/doc/examples/ex5.txt
@@ -0,0 +1,27 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex5.c"
+int f(double x ) ;
+#line 3
+int g(double x ) ;
+#line 2 "cilcode.tmp/ex5.c"
+int f(double x )
+{ int tmp ;
+
+ {
+#line 3
+ tmp = g(x);
+#line 3
+ return (tmp);
+}
+}
+#line 5 "cilcode.tmp/ex5.c"
+int g(double x )
+{
+
+ {
+#line 6
+ return ((int )x);
+}
+}
diff --git a/cil/doc/examples/ex6.txt b/cil/doc/examples/ex6.txt
new file mode 100644
index 0000000..c33eb9e
--- /dev/null
+++ b/cil/doc/examples/ex6.txt
@@ -0,0 +1,7 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex6.c"
+int a1[3] = { 1, 2, 3};
+#line 2 "cilcode.tmp/ex6.c"
+int a2[8] ;
diff --git a/cil/doc/examples/ex7.txt b/cil/doc/examples/ex7.txt
new file mode 100644
index 0000000..55434c7
--- /dev/null
+++ b/cil/doc/examples/ex7.txt
@@ -0,0 +1,22 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 2 "cilcode.tmp/ex7.c"
+enum __anonenum_x_1 {
+ FIVE = 5,
+ SIX = 6,
+ SEVEN = 7,
+ FOUR = 4,
+ EIGHT = 8
+} ;
+#line 1 "cilcode.tmp/ex7.c"
+int main(void)
+{ enum __anonenum_x_1 x ;
+
+ {
+#line 2
+ x = 5;
+#line 8
+ return ((int )x);
+}
+}
diff --git a/cil/doc/examples/ex8.txt b/cil/doc/examples/ex8.txt
new file mode 100644
index 0000000..323a41e
--- /dev/null
+++ b/cil/doc/examples/ex8.txt
@@ -0,0 +1,13 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 2 "cilcode.tmp/ex8.c"
+struct foo {
+ int x ;
+ int y ;
+};
+#line 1 "cilcode.tmp/ex8.c"
+int a1[5] = { 1, 2, 3, 0,
+ 0};
+#line 2 "cilcode.tmp/ex8.c"
+struct foo s1 = {4, 0};
diff --git a/cil/doc/examples/ex9.txt b/cil/doc/examples/ex9.txt
new file mode 100644
index 0000000..22e976c
--- /dev/null
+++ b/cil/doc/examples/ex9.txt
@@ -0,0 +1,16 @@
+/* Generated by CIL v. 1.3.5 */
+/* print_CIL_Input is true */
+
+#line 1 "cilcode.tmp/ex9.c"
+struct inner {
+ int z ;
+};
+#line 1 "cilcode.tmp/ex9.c"
+struct foo {
+ int x ;
+ int y ;
+ int a[5] ;
+ struct inner inner ;
+};
+#line 1 "cilcode.tmp/ex9.c"
+struct foo s = {0, 8, {0, 5, 5, 4, 0}, {3}};
diff --git a/cil/doc/ext.html b/cil/doc/ext.html
new file mode 100644
index 0000000..532e225
--- /dev/null
+++ b/cil/doc/ext.html
@@ -0,0 +1,506 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Library of CIL Modules
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil007.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil009.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc17">8</A>&nbsp;&nbsp;Library of CIL Modules</H2> <A NAME="sec-Extension"></A><BR>
+<BR>
+We are developing a suite of modules that use CIL for program analyses and
+transformations that we have found useful. You can use these modules directly
+on your code, or generally as inspiration for writing similar modules. A
+particularly big and complex application written on top of CIL is CCured
+(<A HREF="../ccured/index.html"><TT>../ccured/index.html</TT></A>).<BR>
+<BR>
+<A NAME="toc9"></A>
+<H3 CLASS="subsection"><A NAME="htoc18">8.1</A>&nbsp;&nbsp;Control-Flow Graphs</H3> <A NAME="sec-cfg"></A>
+The <A HREF="api/Cil.html#TYPEstmt">Cil.stmt</A> datatype includes fields for intraprocedural
+control-flow information: the predecessor and successor statements of
+the current statement. This information is not computed by default.
+If you want to use the control-flow graph, or any of the extensions in
+this section that require it, you have to explicitly ask CIL to
+compute the CFG.<BR>
+<BR>
+
+<H4 CLASS="subsubsection"><A NAME="htoc19">8.1.1</A>&nbsp;&nbsp;The CFG module (new in CIL 1.3.5)</H4>
+The best way to compute the CFG is with the CFG module. Just invoke
+<A HREF="api/Cfg.html#VALcomputeFileCFG">Cfg.computeFileCFG</A> on your file. The <A HREF="api/Cfg.html">Cfg</A> API
+describes the rest of actions you can take with this module, including
+computing the CFG for one function at a time, or printing the CFG in
+<TT>dot</TT> form.<BR>
+<BR>
+
+<H4 CLASS="subsubsection"><A NAME="htoc20">8.1.2</A>&nbsp;&nbsp;Simplified control flow</H4>
+CIL can reduce high-level C control-flow constructs like <TT>switch</TT> and
+<TT>continue</TT> to lower-level <TT>goto</TT>s. This completely eliminates some
+possible classes of statements from the program and may make the result
+easier to analyze (e.g., it simplifies data-flow analysis).<BR>
+<BR>
+You can invoke this transformation on the command line with
+<TT>--domakeCFG</TT> or programatically with <A HREF="api/Cil.html#VALprepareCFG">Cil.prepareCFG</A>.
+After calling Cil.prepareCFG, you can use <A HREF="api/Cil.html#VALcomputeCFGInfo">Cil.computeCFGInfo</A>
+to compute the CFG information and find the successor and predecessor
+of each statement.<BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --domakeCFG</TT>
+transforms the following code (note the fall-through in case 1):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo (int predicate) {
+ int x = 0;
+ switch (predicate) {
+ case 0: return 111;
+ case 1: x = x + 1;
+ case 2: return (x+3);
+ case 3: break;
+ default: return 222;
+ }
+ return 333;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex23.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc10"></A>
+<H3 CLASS="subsection"><A NAME="htoc21">8.2</A>&nbsp;&nbsp;Data flow analysis framework</H3>
+The <A HREF="api/Dataflow.html">Dataflow</A> module (click for the ocamldoc) contains a
+parameterized framework for forward and backward data flow
+analyses. You provide the transfer functions and this module does the
+analysis. You must compute control-flow information (Section&nbsp;<A HREF="#sec-cfg">8.1</A>)
+before invoking the Dataflow module.<BR>
+<BR>
+<A NAME="toc11"></A>
+<H3 CLASS="subsection"><A NAME="htoc22">8.3</A>&nbsp;&nbsp;Dominators</H3>
+The module <A HREF="api/Dominators.html">Dominators</A> contains the computation of immediate
+ dominators. It uses the <A HREF="api/Dataflow.html">Dataflow</A> module. <BR>
+<BR>
+<A NAME="toc12"></A>
+<H3 CLASS="subsection"><A NAME="htoc23">8.4</A>&nbsp;&nbsp;Points-to Analysis</H3>
+The module <TT>ptranal.ml</TT> contains two interprocedural points-to
+analyses for CIL: <TT>Olf</TT> and <TT>Golf</TT>. <TT>Olf</TT> is the default.
+(Switching from <TT>olf.ml</TT> to <TT>golf.ml</TT> requires a change in
+<TT>Ptranal</TT> and a recompiling <TT>cilly</TT>.)<BR>
+<BR>
+The analyses have the following characteristics:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+Not based on C types (inferred pointer relationships are sound
+ despite most kinds of C casts)
+<LI CLASS="li-itemize">One level of subtyping
+<LI CLASS="li-itemize">One level of context sensitivity (Golf only)
+<LI CLASS="li-itemize">Monomorphic type structures
+<LI CLASS="li-itemize">Field insensitive (fields of structs are conflated)
+<LI CLASS="li-itemize">Demand-driven (points-to queries are solved on demand)
+<LI CLASS="li-itemize">Handle function pointers
+</UL>
+The analysis itself is factored into two components: <TT>Ptranal</TT>,
+which walks over the CIL file and generates constraints, and <TT>Olf</TT>
+or <TT>Golf</TT>, which solve the constraints. The analysis is invoked
+with the function <TT>Ptranal.analyze_file: Cil.file -&gt;
+ unit</TT>. This function builds the points-to graph for the CIL file
+and stores it internally. There is currently no facility for clearing
+internal state, so <TT>Ptranal.analyze_file</TT> should only be called
+once.<BR>
+<BR>
+The constructed points-to graph supports several kinds of queries,
+including alias queries (may two expressions be aliased?) and
+points-to queries (to what set of locations may an expression point?).<BR>
+<BR>
+The main interface with the alias analysis is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>Ptranal.may_alias: Cil.exp -&gt; Cil.exp -&gt; bool</TT>. If
+ <TT>true</TT>, the two expressions may have the same value.
+<LI CLASS="li-itemize"><TT>Ptranal.resolve_lval: Cil.lval -&gt; (Cil.varinfo
+ list)</TT>. Returns the list of variables to which the given
+ left-hand value may point.
+<LI CLASS="li-itemize"><TT>Ptranal.resolve_exp: Cil.exp -&gt; (Cil.varinfo list)</TT>.
+ Returns the list of variables to which the given expression may
+ point.
+<LI CLASS="li-itemize"><TT>Ptranal.resolve_funptr: Cil.exp -&gt; (Cil.fundec
+ list)</TT>. Returns the list of functions to which the given
+ expression may point.
+</UL>
+The precision of the analysis can be customized by changing the values
+of several flags:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>Ptranal.no_sub: bool ref</TT>.
+ If <TT>true</TT>, subtyping is disabled. Associated commandline option:
+ <B>--ptr_unify</B>.
+<LI CLASS="li-itemize"><TT>Ptranal.analyze_mono: bool ref</TT>.
+ (Golf only) If <TT>true</TT>, context sensitivity is disabled and the
+ analysis is effectively monomorphic. Commandline option:
+ <B>--ptr_mono</B>.
+<LI CLASS="li-itemize"><TT>Ptranal.smart_aliases: bool ref</TT>.
+ (Golf only) If <TT>true</TT>, &#8220;smart&#8221; disambiguation of aliases is
+ enabled. Otherwise, aliases are computed by intersecting points-to
+ sets. This is an experimental feature.
+<LI CLASS="li-itemize"><TT>Ptranal.model_strings: bool ref</TT>.
+ Make the alias analysis model string constants by treating them as
+ pointers to chars. Commandline option: <B>--ptr_model_strings</B>
+<LI CLASS="li-itemize"><TT>Ptranal.conservative_undefineds: bool ref</TT>.
+ Make the most pessimistic assumptions about globals if an undefined
+ function is present. Such a function can write to every global
+ variable. Commandline option: <B>--ptr_conservative</B>
+</UL>
+In practice, the best precision/efficiency tradeoff is achieved by
+setting <TT>Ptranal.no_sub</TT> to <TT>false</TT>, <TT>Ptranal.analyze_mono</TT> to
+<TT>true</TT>, and <TT>Ptranal.smart_aliases</TT> to <TT>false</TT>. These are the
+default values of the flags.<BR>
+<BR>
+There are also a few flags that can be used to inspect or serialize
+the results of the analysis.
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>Ptranal.debug_may_aliases</TT>.
+ Print the may-alias relationship of each pair of expressions in the
+ program. Commandline option: <B>--ptr_may_aliases</B>.
+<LI CLASS="li-itemize"><TT>Ptranal.print_constraints: bool ref</TT>.
+ If <TT>true</TT>, the analysis will print each constraint as it is
+ generated.
+<LI CLASS="li-itemize"><TT>Ptranal.print_types: bool ref</TT>.
+ If <TT>true</TT>, the analysis will print the inferred type of each
+ variable in the program.<BR>
+<BR>
+If <TT>Ptranal.analyze_mono</TT> and <TT>Ptranal.no_sub</TT> are both
+ <TT>true</TT>, this output is sufficient to reconstruct the points-to
+ graph. One nice feature is that there is a pretty printer for
+ recursive types, so the print routine does not loop.
+<LI CLASS="li-itemize"><TT>Ptranal.compute_results: bool ref</TT>.
+ If <TT>true</TT>, the analysis will print out the points-to set of each
+ variable in the program. This will essentially serialize the
+ points-to graph.
+</UL>
+<A NAME="toc13"></A>
+<H3 CLASS="subsection"><A NAME="htoc24">8.5</A>&nbsp;&nbsp;StackGuard</H3>
+The module <TT>heapify.ml</TT> contains a transformation similar to the one
+described in &#8220;StackGuard: Automatic Adaptive Detection and Prevention of
+Buffer-Overflow Attacks&#8221;, <EM>Proceedings of the 7th USENIX Security
+Conference</EM>. In essence it modifies the program to maintain a separate
+stack for return addresses. Even if a buffer overrun attack occurs the
+actual correct return address will be taken from the special stack. <BR>
+<BR>
+Although it does work, this CIL module is provided mainly as an example of
+how to perform a simple source-to-source program analysis and
+transformation. As an optimization only functions that contain a dangerous
+local array make use of the special return address stack. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dostackGuard</TT>
+transforms the following dangerous code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int dangerous() {
+ char array[10];
+ scanf("%s",array); // possible buffer overrun!
+ }
+
+ int main () {
+ return dangerous();
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex24.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc14"></A>
+<H3 CLASS="subsection"><A NAME="htoc25">8.6</A>&nbsp;&nbsp;Heapify</H3>
+The module <TT>heapify.ml</TT> also contains a transformation that moves all
+dangerous local arrays to the heap. This also prevents a number of buffer
+overruns. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --doheapify</TT>
+transforms the following dangerous code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int dangerous() {
+ char array[10];
+ scanf("%s",array); // possible buffer overrun!
+ }
+
+ int main () {
+ return dangerous();
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex25.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc15"></A>
+<H3 CLASS="subsection"><A NAME="htoc26">8.7</A>&nbsp;&nbsp;One Return</H3>
+The module <TT>oneret.ml</TT> contains a transformation the ensures that all
+function bodies have at most one return statement. This simplifies a number
+of analyses by providing a canonical exit-point. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dooneRet</TT>
+transforms the following code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo (int predicate) {
+ if (predicate &lt;= 0) {
+ return 1;
+ } else {
+ if (predicate &gt; 5)
+ return 2;
+ return 3;
+ }
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex26.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc16"></A>
+<H3 CLASS="subsection"><A NAME="htoc27">8.8</A>&nbsp;&nbsp;Partial Evaluation and Constant Folding</H3>
+The <TT>partial.ml</TT> module provides a simple interprocedural partial
+evaluation and constant folding data-flow analysis and transformation. This
+transformation requires the <TT>--domakeCFG</TT> option. <BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --domakeCFG --dopartial</TT>
+transforms the following code (note the eliminated <TT>if</TT> branch and the
+partial optimization of <TT>foo</TT>):
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int foo(int x, int y) {
+ int unknown;
+ if (unknown)
+ return y+2;
+ return x+3;
+ }
+
+ int main () {
+ int a,b,c;
+ a = foo(5,7) + foo(6,7);
+ b = 4;
+ c = b * b;
+ if (b &gt; c)
+ return b-c;
+ else
+ return b+c;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex27.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc17"></A>
+<H3 CLASS="subsection"><A NAME="htoc28">8.9</A>&nbsp;&nbsp;Reaching Definitions</H3>
+The <TT>reachingdefs.ml</TT> module uses the dataflow framework and CFG
+information to calculate the definitions that reach each
+statement. After computing the CFG (Section&nbsp;<A HREF="#sec-cfg">8.1</A>) and calling
+<TT>computeRDs</TT> on a
+function declaration, <TT>ReachingDef.stmtStartData</TT> will contain a
+mapping from statement IDs to data about which definitions reach each
+statement. In particular, it is a mapping from statement IDs to a
+triple the first two members of which are used internally. The third
+member is a mapping from variable IDs to Sets of integer options. If
+the set contains <TT>Some(i)</TT>, then the definition of that variable
+with ID <TT>i</TT> reaches that statement. If the set contains <TT>None</TT>,
+then there is a path to that statement on which there is no definition
+of that variable. Also, if the variable ID is unmapped at a
+statement, then no definition of that variable reaches that statement.<BR>
+<BR>
+To summarize, reachingdefs.ml has the following interface:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>computeRDs</TT> &ndash; Computes reaching definitions. Requires that
+CFG information has already been computed for each statement.
+<LI CLASS="li-itemize"><TT>ReachingDef.stmtStartData</TT> &ndash; contains reaching
+definition data after <TT>computeRDs</TT> is called.
+<LI CLASS="li-itemize"><TT>ReachingDef.defIdStmtHash</TT> &ndash; Contains a mapping
+from definition IDs to the ID of the statement in which
+the definition occurs.
+<LI CLASS="li-itemize"><TT>getRDs</TT> &ndash; Takes a statement ID and returns
+reaching definition data for that statement.
+<LI CLASS="li-itemize"><TT>instrRDs</TT> &ndash; Takes a list of instructions and the
+definitions that reach the first instruction, and for
+each instruction calculates the definitions that reach
+either into or out of that instruction.
+<LI CLASS="li-itemize"><TT>rdVisitorClass</TT> &ndash; A subclass of nopCilVisitor that
+can be extended such that the current reaching definition
+data is available when expressions are visited through
+the <TT>get_cur_iosh</TT> method of the class.
+</UL>
+<A NAME="toc18"></A>
+<H3 CLASS="subsection"><A NAME="htoc29">8.10</A>&nbsp;&nbsp;Available Expressions</H3>
+The <TT>availexps.ml</TT> module uses the dataflow framework and CFG
+information to calculate something similar to a traditional available
+expressions analysis. After <TT>computeAEs</TT> is called following a CFG
+calculation (Section&nbsp;<A HREF="#sec-cfg">8.1</A>), <TT>AvailableExps.stmtStartData</TT> will
+contain a mapping
+from statement IDs to data about what expressions are available at
+that statement. The data for each statement is a mapping for each
+variable ID to the whole expression available at that point(in the
+traditional sense) which the variable was last defined to be. So,
+this differs from a traditional available expressions analysis in that
+only whole expressions from a variable definition are considered rather
+than all expressions.<BR>
+<BR>
+The interface is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>computeAEs</TT> &ndash; Computes available expressions. Requires
+that CFG information has already been comptued for each statement.
+<LI CLASS="li-itemize"><TT>AvailableExps.stmtStartData</TT> &ndash; Contains available
+expressions data for each statement after <TT>computeAEs</TT> has been
+called.
+<LI CLASS="li-itemize"><TT>getAEs</TT> &ndash; Takes a statement ID and returns
+available expression data for that statement.
+<LI CLASS="li-itemize"><TT>instrAEs</TT> &ndash; Takes a list of instructions and
+the availalbe expressions at the first instruction, and
+for each instruction calculates the expressions available
+on entering or exiting each instruction.
+<LI CLASS="li-itemize"><TT>aeVisitorClass</TT> &ndash; A subclass of nopCilVisitor that
+can be extended such that the current available expressions
+data is available when expressions are visited through the
+<TT>get_cur_eh</TT> method of the class.
+</UL>
+<A NAME="toc19"></A>
+<H3 CLASS="subsection"><A NAME="htoc30">8.11</A>&nbsp;&nbsp;Liveness Analysis</H3>
+The <TT>liveness.ml</TT> module uses the dataflow framework and
+CFG information to calculate which variables are live at
+each program point. After <TT>computeLiveness</TT> is called
+following a CFG calculation (Section&nbsp;<A HREF="#sec-cfg">8.1</A>), <TT>LiveFlow.stmtStartData</TT> will
+contain a mapping for each statement ID to a set of <TT>varinfo</TT>s
+for varialbes live at that program point.<BR>
+<BR>
+The interface is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>computeLiveness</TT> &ndash; Computes live variables. Requires
+that CFG information has already been computed for each statement.
+<LI CLASS="li-itemize"><TT>LiveFlow.stmtStartData</TT> &ndash; Contains live variable data
+for each statement after <TT>computeLiveness</TT> has been called.
+</UL>
+Also included in this module is a command line interface that
+will cause liveness data to be printed to standard out for
+a particular function or label.
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>&ndash;doliveness</TT> &ndash; Instructs cilly to comptue liveness
+information and to print on standard out the variables live
+at the points specified by <TT>&ndash;live_func</TT> and <TT>live_label</TT>.
+If both are ommitted, then nothing is printed.
+<LI CLASS="li-itemize"><TT>&ndash;live_func</TT> &ndash; The name of the function whose
+liveness data is of interest. If <TT>&ndash;live_label</TT> is ommitted,
+then data for each statement is printed.
+<LI CLASS="li-itemize"><TT>&ndash;live_label</TT> &ndash; The name of the label at which
+the liveness data will be printed.
+</UL>
+<A NAME="toc20"></A>
+<H3 CLASS="subsection"><A NAME="htoc31">8.12</A>&nbsp;&nbsp;Dead Code Elimination</H3>
+The module <TT>deadcodeelim.ml</TT> uses the reaching definitions
+analysis to eliminate assignment instructions whose results
+are not used. The interface is as follows:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>elim_dead_code</TT> &ndash; Performs dead code elimination
+on a function. Requires that CFG information has already
+been computed (Section&nbsp;<A HREF="#sec-cfg">8.1</A>).
+<LI CLASS="li-itemize"><TT>dce</TT> &ndash; Performs dead code elimination on an
+entire file. Requires that CFG information has already
+been computed.
+</UL>
+<A NAME="toc21"></A>
+<H3 CLASS="subsection"><A NAME="htoc32">8.13</A>&nbsp;&nbsp;Simple Memory Operations</H3>
+The <TT>simplemem.ml</TT> module allows CIL lvalues that contain memory
+accesses to be even futher simplified via the introduction of
+well-typed temporaries. After this transformation all lvalues involve
+at most one memory reference.<BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dosimpleMem</TT>
+transforms the following code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int main () {
+ int ***three;
+ int **two;
+ ***three = **two;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex28.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc22"></A>
+<H3 CLASS="subsection"><A NAME="htoc33">8.14</A>&nbsp;&nbsp;Simple Three-Address Code</H3>
+The <TT>simplify.ml</TT> module further reduces the complexity of program
+expressions and gives you a form of three-address code. After this
+transformation all expressions will adhere to the following grammar:
+<PRE CLASS="verbatim">
+ basic::=
+ Const _
+ Addrof(Var v, NoOffset)
+ StartOf(Var v, NoOffset)
+ Lval(Var v, off), where v is a variable whose address is not taken
+ and off contains only "basic"
+
+ exp::=
+ basic
+ Lval(Mem basic, NoOffset)
+ BinOp(bop, basic, basic)
+ UnOp(uop, basic)
+ CastE(t, basic)
+
+ lval ::=
+ Mem basic, NoOffset
+ Var v, off, where v is a variable whose address is not taken and off
+ contains only "basic"
+</PRE>In addition, all <TT>sizeof</TT> and <TT>alignof</TT> forms are turned into
+constants. Accesses to arrays and variables whose address is taken are
+turned into "Mem" accesses. All field and index computations are turned
+into address arithmetic.<BR>
+<BR>
+For a concrete example, you can see how <TT>cilly --dosimplify</TT>
+transforms the following code:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+ int main() {
+ struct mystruct {
+ int a;
+ int b;
+ } m;
+ int local;
+ int arr[3];
+ int *ptr;
+
+ ptr = &amp;local;
+ m.a = local + sizeof(m) + arr[2];
+ return m.a;
+ }
+</FONT></PRE>
+See the <A HREF="examples/ex29.txt">CIL output</A> for this
+code fragment<BR>
+<BR>
+<A NAME="toc23"></A>
+<H3 CLASS="subsection"><A NAME="htoc34">8.15</A>&nbsp;&nbsp;Converting C to C++</H3>
+The module canonicalize.ml performs several transformations to correct
+differences between C and C++, so that the output is (hopefully) valid
+C++ code. This may be incomplete &mdash; certain fixes which are necessary
+for some programs are not yet implemented.<BR>
+<BR>
+Using the <TT>--doCanonicalize</TT> option with CIL will perform the
+following changes to your program:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Any variables that use C++ keywords as identifiers are renamed.
+<LI CLASS="li-enumerate">C allows global variables to have multiple declarations and
+ multiple (equivalent) definitions. This transformation removes
+ all but one declaration and all but one definition.
+<LI CLASS="li-enumerate"><TT>__inline</TT> is #defined to <TT>inline</TT>, and <TT>__restrict</TT>
+ is #defined to nothing.
+<LI CLASS="li-enumerate">C allows function pointers with no specified arguments to be used on
+ any argument list. To make C++ accept this code, we insert a cast
+ from the function pointer to a type that matches the arguments. Of
+ course, this does nothing to guarantee that the pointer actually has
+ that type.
+<LI CLASS="li-enumerate">Makes casts from int to enum types explicit. (CIL changes enum
+ constants to int constants, but doesn't use a cast.)
+</OL>
+<HR>
+<A HREF="cil007.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil009.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/header.html b/cil/doc/header.html
new file mode 100644
index 0000000..cfedee9
--- /dev/null
+++ b/cil/doc/header.html
@@ -0,0 +1,18 @@
+<html>
+
+<head>
+<meta http-equiv="Content-Language" content="en-us">
+<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
+<meta name="ProgId" content="FrontPage.Editor.Document">
+<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
+<title>CIL Documentation (v. 1.3.5)</title>
+<base target="contents">
+</head>
+
+<body>
+
+<h1 align="center">CIL - Infrastructure for C Program Analysis and Transformation (v. 1.3.5)</h1>
+
+</body>
+
+</html>
diff --git a/cil/doc/index.html b/cil/doc/index.html
new file mode 100644
index 0000000..77ec160
--- /dev/null
+++ b/cil/doc/index.html
@@ -0,0 +1,26 @@
+<html>
+
+<head>
+<meta name="GENERATOR" content="Microsoft FrontPage 5.0">
+<meta name="ProgId" content="FrontPage.Editor.Document">
+<base target="main">
+<title>CIL Documentation (v. 1.3.5)</title>
+</head>
+
+<frameset rows="64,*">
+ <frame name="banner" scrolling="auto" noresize target="contents"
+ src="header.html">
+ <frameset cols="267,*">
+ <frame name="contents" target="main" src="ciltoc.html" scrolling="auto">
+ <frame name="main" src="cil001.html" scrolling="auto">
+ </frameset>
+ <noframes>
+ <body>
+
+ <p>This page uses frames, but your browser doesn't support them.</p>
+
+ </body>
+ </noframes>
+</frameset>
+
+</html> \ No newline at end of file
diff --git a/cil/doc/merger.html b/cil/doc/merger.html
new file mode 100644
index 0000000..636dd2a
--- /dev/null
+++ b/cil/doc/merger.html
@@ -0,0 +1,167 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Using the merger
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="cil012.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="patcher.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc39">13</A>&nbsp;&nbsp;Using the merger</H2><A NAME="sec-merger"></A><BR>
+<BR>
+There are many program analyses that are more effective when
+done on the whole program.<BR>
+<BR>
+The merger is a tool that combines all of the C source files in a project
+into a single C file. There are two tasks that a merger must perform:
+<OL CLASS="enumerate" type=1><LI CLASS="li-enumerate">
+Detect what are all the sources that make a project and with what
+compiler arguments they are compiled.<BR>
+<BR>
+<LI CLASS="li-enumerate">Merge all of the source files into a single file.
+</OL>
+For the first task the merger impersonates a compiler and a linker (both a
+GCC and a Microsoft Visual C mode are supported) and it expects to be invoked
+(from a build script or a Makefile) on all sources of the project. When
+invoked to compile a source the merger just preprocesses the source and saves
+the result using the name of the requested object file. By preprocessing at
+this time the merger is able to take into account variations in the command
+line arguments that affect preprocessing of different source files.<BR>
+<BR>
+When the merger is invoked to link a number of object files it collects the
+preprocessed sources that were stored with the names of the object files, and
+invokes the merger proper. Note that arguments that affect the compilation or
+linking must be the same for all source files.<BR>
+<BR>
+For the second task, the merger essentially concatenates the preprocessed
+sources with care to rename conflicting file-local declarations (we call this
+process alpha-conversion of a file). The merger also attempts to remove
+duplicate global declarations and definitions. Specifically the following
+actions are taken:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+File-scope names (<TT>static</TT> globals, names of types defined with
+<TT>typedef</TT>, and structure/union/enumeration tags) are given new names if they
+conflict with declarations from previously processed sources. The new name is
+formed by appending the suffix <TT>___n</TT>, where <TT>n</TT> is a unique integer
+identifier. Then the new names are applied to their occurrences in the file. <BR>
+<BR>
+<LI CLASS="li-itemize">Non-static declarations and definitions of globals are never renamed.
+But we try to remove duplicate ones. Equality of globals is detected by
+comparing the printed form of the global (ignoring the line number directives)
+after the body has been alpha-converted. This process is intended to remove
+those declarations (e.g. function prototypes) that originate from the same
+include file. Similarly, we try to eliminate duplicate definitions of
+<TT>inline</TT> functions, since these occasionally appear in include files.<BR>
+<BR>
+<LI CLASS="li-itemize">The types of all global declarations with the same name from all files
+are compared for type isomorphism. During this process, the merger detects all
+those isomorphisms between structures and type definitions that are <B>required</B> for the merged program to be legal. Such structure tags and
+typenames are coalesced and given the same name. <BR>
+<BR>
+<LI CLASS="li-itemize">Besides the structure tags and type names that are required to be
+isomorphic, the merger also tries to coalesce definitions of structures and
+types with the same name from different file. However, in this case the merger
+will not give an error if such definitions are not isomorphic; it will just
+use different names for them. <BR>
+<BR>
+<LI CLASS="li-itemize">In rare situations, it can happen that a file-local global in
+encountered first and it is not renamed, only to discover later when
+processing another file that there is an external symbol with the same name.
+In this case, a second pass is made over the merged file to rename the
+file-local symbol.
+</UL>
+Here is an example of using the merger:<BR>
+<BR>
+The contents of <TT>file1.c</TT> is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct foo; // Forward declaration
+extern struct foo *global;
+</FONT></PRE>
+The contents of <TT>file2.c</TT> is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+struct bar {
+ int x;
+ struct bar *next;
+};
+extern struct bar *global;
+struct foo {
+ int y;
+};
+extern struct foo another;
+void main() {
+}
+</FONT></PRE>
+There are several ways in which one might create an executable from these
+files:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<PRE CLASS="verbatim">
+gcc file1.c file2.c -o a.out
+</PRE><BR>
+<BR>
+<LI CLASS="li-itemize"><PRE CLASS="verbatim">
+gcc -c file1.c -o file1.o
+gcc -c file2.c -o file2.o
+ld file1.o file2.o -o a.out
+</PRE><BR>
+<BR>
+<LI CLASS="li-itemize"><PRE CLASS="verbatim">
+gcc -c file1.c -o file1.o
+gcc -c file2.c -o file2.o
+ar r libfile2.a file2.o
+gcc file1.o libfile2.a -o a.out
+</PRE><BR>
+<BR>
+<LI CLASS="li-itemize"><PRE CLASS="verbatim">
+gcc -c file1.c -o file1.o
+gcc -c file2.c -o file2.o
+ar r libfile2.a file2.o
+gcc file1.o -lfile2 -o a.out
+</PRE></UL>
+In each of the cases above you must replace all occurrences of <TT>gcc</TT> and
+<TT>ld</TT> with <TT>cilly --merge</TT>, and all occurrences of <TT>ar</TT> with <TT>cilly
+--merge --mode=AR</TT>. It is very important that the <TT>--merge</TT> flag be used
+throughout the build process. If you want to see the merged source file you
+must also pass the <TT>--keepmerged</TT> flag to the linking phase. <BR>
+<BR>
+The result of merging file1.c and file2.c is:
+<PRE CLASS="verbatim"><FONT COLOR=blue>
+// from file1.c
+struct foo; // Forward declaration
+extern struct foo *global;
+
+// from file2.c
+struct foo {
+ int x;
+ struct foo *next;
+};
+struct foo___1 {
+ int y;
+};
+extern struct foo___1 another;
+</FONT></PRE>
+<HR>
+<A HREF="cil012.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="patcher.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/next_motif.gif b/cil/doc/next_motif.gif
new file mode 100644
index 0000000..3f84bac
--- /dev/null
+++ b/cil/doc/next_motif.gif
Binary files differ
diff --git a/cil/doc/patcher.html b/cil/doc/patcher.html
new file mode 100644
index 0000000..2c727e2
--- /dev/null
+++ b/cil/doc/patcher.html
@@ -0,0 +1,126 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
+ "http://www.w3.org/TR/REC-html40/loose.dtd">
+<HTML>
+<HEAD>
+
+
+
+<META http-equiv="Content-Type" content="text/html; charset=ANSI_X3.4-1968">
+<META name="GENERATOR" content="hevea 1.08">
+
+<base target="main">
+<script language="JavaScript">
+<!-- Begin
+function loadTop(url) {
+ parent.location.href= url;
+}
+// -->
+</script>
+<LINK rel="stylesheet" type="text/css" href="cil.css">
+<TITLE>
+Using the patcher
+</TITLE>
+</HEAD>
+<BODY >
+<A HREF="merger.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil015.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+<HR>
+
+<H2 CLASS="section"><A NAME="htoc40">14</A>&nbsp;&nbsp;Using the patcher</H2><A NAME="sec-patcher"></A><BR>
+<BR>
+Occasionally we have needed to modify slightly the standard include files.
+So, we developed a simple mechanism that allows us to create modified copies
+of the include files and use them instead of the standard ones. For this
+purpose we specify a patch file and we run a program caller Patcher which
+makes modified copies of include files and applies the patch.<BR>
+<BR>
+The patcher is invoked as follows:
+<PRE CLASS="verbatim">
+bin/patcher [options]
+
+Options:
+ --help Prints this help message
+ --verbose Prints a lot of information about what is being done
+ --mode=xxx What tool to emulate:
+ GNUCC - GNU CC
+ MSVC - MS VC cl compiler
+
+ --dest=xxx The destination directory. Will make one if it does not exist
+ --patch=xxx Patch file (can be specified multiple times)
+ --ppargs=xxx An argument to be passed to the preprocessor (can be specified
+ multiple times)
+
+ --ufile=xxx A user-include file to be patched (treated as \#include "xxx")
+ --sfile=xxx A system-include file to be patched (treated as \#include &lt;xxx&gt;)
+
+ --clean Remove all files in the destination directory
+ --dumpversion Print the version name used for the current compiler
+
+ All of the other arguments are passed to the preprocessor. You should pass
+ enough arguments (e.g., include directories) so that the patcher can find the
+ right include files to be patched.
+</PRE>
+ Based on the given <TT>mode</TT> and the current version of the compiler (which
+the patcher can print when given the <TT>dumpversion</TT> argument) the patcher
+will create a subdirectory of the <TT>dest</TT> directory (say <TT>/usr/home/necula/cil/include</TT>), such as:
+<PRE CLASS="verbatim">
+/usr/home/necula/cil/include/gcc_2.95.3-5
+</PRE>
+ In that file the patcher will copy the modified versions of the include files
+specified with the <TT>ufile</TT> and <TT>sfile</TT> options. Each of these options can
+be specified multiple times. <BR>
+<BR>
+The patch file (specified with the <TT>patch</TT> option) has a format inspired by
+the Unix <TT>patch</TT> tool. The file has the following grammar:
+<PRE CLASS="verbatim">
+&lt;&lt;&lt; flags
+patterns
+===
+replacement
+&gt;&gt;&gt;
+</PRE>
+ The flags are a comma separated, case-sensitive, sequence of keywords or
+keyword = value. The following flags are supported:
+<UL CLASS="itemize"><LI CLASS="li-itemize">
+<TT>file=foo.h</TT> - will only apply the patch on files whose name is
+ <TT>foo.h</TT>.
+<LI CLASS="li-itemize"><TT>optional</TT> - this means that it is Ok if the current patch does not
+match any of the processed files.
+<LI CLASS="li-itemize"><TT>group=foo</TT> - will add this patch to the named group. If this is not
+specified then a unique group is created to contain just the current patch.
+When all files specified in the command line have been patched, an error
+message is generated for all groups for whom no member patch was used. We use
+this mechanism to receive notice when the patch triggers are out-dated with
+respect to the new include files.
+<LI CLASS="li-itemize"><TT>system=sysname</TT> - will only consider this pattern on a given
+operating system. The &#8220;sysname&#8221; is reported by the &#8220;$Ô&#8221; variable in
+Perl, except that Windows is always considered to have sysname
+&#8220;cygwin.&#8221; For Linux use &#8220;linux&#8221; (capitalization matters).
+<LI CLASS="li-itemize"><TT>ateof</TT> - In this case the patterns are ignored and the replacement
+text is placed at the end of the patched file. Use the <TT>file</TT> flag if you
+want to restrict the files in which this replacement is performed.
+<LI CLASS="li-itemize"><TT>atsof</TT> - The patterns are ignored and the replacement text is placed
+at the start of the patched file. Uf the <TT>file</TT> flag to restrict the
+application of this patch to a certain file.
+<LI CLASS="li-itemize"><TT>disabled</TT> - Use this flag if you want to disable the pattern.
+</UL>
+The patterns can consist of several groups of lines separated by the <TT>|||</TT>
+marker. Each of these group of lines is a multi-line pattern that if found in
+the file will be replaced with the text given at the end of the block. <BR>
+<BR>
+The matching is space-insensitive.<BR>
+<BR>
+All of the markers <TT>&lt;&lt;&lt;</TT>, <TT>|||</TT>, <TT>===</TT> and <TT>&gt;&gt;&gt;</TT> must appear at the
+beginning of a line but they can be followed by arbitrary text (which is
+ignored).<BR>
+<BR>
+The replacement text can contain the special keyword <TT>@__pattern__@</TT>,
+which is substituted with the pattern that matched. <BR>
+<BR>
+<HR>
+<A HREF="merger.html"><IMG SRC ="previous_motif.gif" ALT="Previous"></A>
+<A HREF="ciltoc.html"><IMG SRC ="contents_motif.gif" ALT="Up"></A>
+<A HREF="cil015.html"><IMG SRC ="next_motif.gif" ALT="Next"></A>
+</BODY>
+</HTML>
diff --git a/cil/doc/previous_motif.gif b/cil/doc/previous_motif.gif
new file mode 100644
index 0000000..8c8a3e6
--- /dev/null
+++ b/cil/doc/previous_motif.gif
Binary files differ
diff --git a/cil/install-sh b/cil/install-sh
new file mode 100644
index 0000000..e9de238
--- /dev/null
+++ b/cil/install-sh
@@ -0,0 +1,251 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# Calling this script install-sh is preferred over install.sh, to prevent
+# `make' implicit rules from creating a file called install from it
+# when there is no Makefile.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch. It can only install one file at a time, a restriction
+# shared with many OS's install programs.
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+mkdirprog="${MKDIRPROG-mkdir}"
+
+transformbasename=""
+transform_arg=""
+instcmd="$mvprog"
+chmodcmd="$chmodprog 0755"
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+dir_arg=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -d) dir_arg=true
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ -t=*) transformarg=`echo $1 | sed 's/-t=//'`
+ shift
+ continue;;
+
+ -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ # this colon is to work around a 386BSD /bin/sh bug
+ :
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+else
+ true
+fi
+
+if [ x"$dir_arg" != x ]; then
+ dst=$src
+ src=""
+
+ if [ -d $dst ]; then
+ instcmd=:
+ chmodcmd=""
+ else
+ instcmd=mkdir
+ fi
+else
+
+# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
+# might cause directories to be created, which would be especially bad
+# if $src (and thus $dsttmp) contains '*'.
+
+ if [ -f $src -o -d $src ]
+ then
+ true
+ else
+ echo "install: $src does not exist"
+ exit 1
+ fi
+
+ if [ x"$dst" = x ]
+ then
+ echo "install: no destination specified"
+ exit 1
+ else
+ true
+ fi
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+ if [ -d $dst ]
+ then
+ dst="$dst"/`basename $src`
+ else
+ true
+ fi
+fi
+
+## this sed command emulates the dirname command
+dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
+
+# Make sure that the destination directory exists.
+# this part is taken from Noah Friedman's mkinstalldirs script
+
+# Skip lots of stat calls in the usual case.
+if [ ! -d "$dstdir" ]; then
+defaultIFS='
+'
+IFS="${IFS-${defaultIFS}}"
+
+oIFS="${IFS}"
+# Some sh's can't handle IFS=/ for some reason.
+IFS='%'
+set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
+IFS="${oIFS}"
+
+pathcomp=''
+
+while [ $# -ne 0 ] ; do
+ pathcomp="${pathcomp}${1}"
+ shift
+
+ if [ ! -d "${pathcomp}" ] ;
+ then
+ $mkdirprog "${pathcomp}"
+ else
+ true
+ fi
+
+ pathcomp="${pathcomp}/"
+done
+fi
+
+if [ x"$dir_arg" != x ]
+then
+ $doit $instcmd $dst &&
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
+else
+
+# If we're going to rename the final executable, determine the name now.
+
+ if [ x"$transformarg" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ dstfile=`basename $dst $transformbasename |
+ sed $transformarg`$transformbasename
+ fi
+
+# don't allow the sed command to completely eliminate the filename
+
+ if [ x"$dstfile" = x ]
+ then
+ dstfile=`basename $dst`
+ else
+ true
+ fi
+
+# Make a temp file name in the proper directory.
+
+ dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+ $doit $instcmd $src $dsttmp &&
+
+ trap "rm -f ${dsttmp}" 0 &&
+
+# and set any options; do chmod last to preserve setuid bits
+
+# If any of these fail, we abort the whole thing. If we want to
+# ignore errors from any of these, just make sure not to ignore
+# errors from the above "$doit $instcmd $src $dsttmp" command.
+
+ if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
+ if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
+ if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
+ if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
+
+# Now rename the file to the real destination.
+
+ $doit $rmcmd -f $dstdir/$dstfile &&
+ $doit $mvcmd $dsttmp $dstdir/$dstfile
+
+fi &&
+
+
+exit 0
diff --git a/cil/lib/Cilly.pm b/cil/lib/Cilly.pm
new file mode 100644
index 0000000..fa7aa53
--- /dev/null
+++ b/cil/lib/Cilly.pm
@@ -0,0 +1,2137 @@
+#
+#
+# Copyright (c) 2001-2002,
+# George C. Necula <necula@cs.berkeley.edu>
+# Scott McPeak <smcpeak@cs.berkeley.edu>
+# Wes Weimer <weimer@cs.berkeley.edu>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# 3. The names of the contributors may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#
+
+
+
+# This module implements a compiler stub that parses the command line
+# arguments of gcc and Microsoft Visual C (along with some arguments for the
+# script itself) and gives hooks into preprocessing, compilation and linking.
+
+
+$::cilbin = 'bin';
+
+package Cilly;
+@ISA = ();
+
+use strict;
+use File::Basename;
+use File::Copy;
+use File::Spec;
+use Data::Dumper;
+use Carp;
+use Text::ParseWords;
+
+use KeptFile;
+use OutputFile;
+use TempFile;
+
+$Cilly::savedSourceExt = "_saved.c";
+
+# Pass to new a list of command arguments
+sub new {
+ my ($proto, @args) = @_;
+
+ my $class = ref($proto) || $proto;
+
+ my $ref =
+ { CFILES => [], # C input files
+ SFILES => [], # Assembly language files
+ OFILES => [], # Other input files
+ IFILES => [], # Already preprocessed files
+ EARLY_PPARGS => [], # Preprocessor args, first (pre-CIL) pass only
+ PPARGS => [], # Preprocessor args
+ CCARGS => [], # Compiler args
+ LINKARGS => [], # Linker args
+ NATIVECAML => 1, # this causes the native code boxer to be used
+ RELEASELIB => 0, # if true, use the release runtime library (if any)
+ # IDASHI => 1, # if true, pass "-I-" to gcc's preprocessor
+ IDASHDOT => 1, # if true, pass "-I." to gcc's preprocessor
+ VERBOSE => 0, # when true, print extra detail
+ TRACE_COMMANDS => 1, # when true, echo commands being run
+ SEPARATE => ! $::default_is_merge,
+ LIBDIR => [],
+ OPERATION => 'TOEXE', # This is the default for all compilers
+ };
+ my $self = bless $ref, $class;
+
+ if(! @args) {
+ print "No arguments passed\n";
+ $self->printHelp();
+ exit 0;
+ }
+ # Look for the --mode argument first. If not found it is GCC
+ my $mode = $::default_mode;
+ {
+ my @args1 = ();
+ foreach my $arg (@args) {
+ if($arg =~ m|--mode=(.+)$|) {
+ $mode = $1;
+ } else {
+ push @args1, $arg;
+ }
+ }
+ @args = @args1; # These are the argument after we extracted the --mode
+
+ }
+ if(defined $self->{MODENAME} && $self->{MODENAME} ne $mode) {
+ die "Cannot re-specify the compiler";
+ }
+ {
+ my $compiler;
+ if($mode eq "MSVC") {
+ unshift @Cilly::ISA, qw(MSVC);
+ $compiler = MSVC->new($self);
+ } elsif($mode eq "GNUCC") {
+ unshift @Cilly::ISA, qw(GNUCC);
+ $compiler = GNUCC->new($self);
+ } elsif($mode eq "MSLINK") {
+ unshift @Cilly::ISA, qw(MSLINK);
+ $compiler = MSLINK->new($self);
+ } elsif($mode eq "MSLIB") {
+ unshift @Cilly::ISA, qw(MSLIB);
+ $compiler = MSLIB->new($self);
+ } elsif($mode eq "AR") {
+ unshift @Cilly::ISA, qw(AR);
+ $compiler = AR->new($self);
+ } else {
+ die "Don't know about compiler $mode\n";
+ }
+ # Now grab the fields from the compiler and put them inside self
+ my $key;
+ foreach $key (keys %{$compiler}) {
+ $self->{$key} = $compiler->{$key};
+ }
+
+ # For MSVC we have to use --save-temps because otherwise the
+ # temporary files get deleted somehow before CL gets at them !
+ if($mode ne "GNUCC" && $mode ne "AR") {
+ $self->{SAVE_TEMPS} = '.';
+ }
+ }
+
+ # Scan and process the arguments
+ $self->setDefaultArguments;
+ collectArgumentList($self, @args);
+
+ # sm: if an environment variable is set, then do not merge; this
+ # is intended for use in ./configure scripts, where merging delays
+ # the reporting of errors that the script is expecting
+ if (defined($ENV{"CILLY_NOMERGE"})) {
+ $self->{SEPARATE} = 1;
+ if($self->{VERBOSE}) { print STDERR "Merging disabled by CILLY_NOMERGE\n"; }
+ }
+
+# print Dumper($self);
+
+ return $self;
+}
+
+# Hook to let subclasses set/override default arguments
+sub setDefaultArguments {
+}
+
+# work through an array of arguments, processing each one
+sub collectArgumentList {
+ my ($self, @args) = @_;
+
+ # Scan and process the arguments
+ while($#args >= 0) {
+ my $arg = $self->fetchNextArg(\@args);
+
+ if(! defined($arg)) {
+ last;
+ }
+ if($arg eq "") { next; }
+
+ #print("arg: $arg\n");
+#
+# my $arg = shift @args; # Grab the next one
+ if(! $self->collectOneArgument($arg, \@args)) {
+ print "Warning: Unknown argument $arg\n";
+ push @{$self->{CCARGS}}, $arg;
+ }
+ }
+}
+
+# Grab the next argument
+sub fetchNextArg {
+ my ($self, $pargs) = @_;
+ return shift @{$pargs};
+}
+
+# Collecting arguments. Take a look at one argument. If we understand it then
+# we return 1. Otherwise we return 0. Might pop some more arguments from pargs.
+sub collectOneArgument {
+ my($self, $arg, $pargs) = @_;
+ my $res;
+ # Maybe it is a compiler option or a source file
+ if($self->compilerArgument($self->{OPTIONS}, $arg, $pargs)) { return 1; }
+
+ if($arg eq "--help" || $arg eq "-help") {
+ $self->printVersion();
+ $self->printHelp();
+ exit 1;
+ }
+ if($arg eq "--version" || $arg eq "-version") {
+ $self->printVersion(); exit 0;
+ }
+ if($arg eq "--verbose") {
+ $self->{VERBOSE} = 1; return 1;
+ }
+ if($arg eq "--flatten_linker_scripts") {
+ $self->{FLATTEN_LINKER_SCRIPTS} = 1; return 1;
+ }
+ if($arg eq '--nomerge') {
+ $self->{SEPARATE} = 1;
+ return 1;
+ }
+ if($arg eq '--merge') {
+ $self->{SEPARATE} = 0;
+ return 1;
+ }
+ if($arg =~ "--ccargs=(.+)\$") {
+ push @{$self->{CCARGS}}, $1;
+ return 1;
+ }
+ if($arg eq '--trueobj') {
+ $self->{TRUEOBJ} = 1;
+ return 1;
+ }
+ # zf: force curing when linking to a lib
+ if ($arg eq '--truelib') {
+ $self->{TRUELIB} = 1;
+ return 1;
+ }
+ if($arg eq '--keepmerged') {
+ $self->{KEEPMERGED} = 1;
+ return 1;
+ }
+ if($arg eq '--stdoutpp') {
+ $self->{STDOUTPP} = 1;
+ return 1;
+ }
+ if($arg =~ m|--save-temps=(.+)$|) {
+ if(! -d $1) {
+ die "Cannot find directory $1";
+ }
+ $self->{SAVE_TEMPS} = $1;
+ return 1;
+ }
+ if($arg eq '--save-temps') {
+ $self->{SAVE_TEMPS} = '.';
+ return 1;
+ }
+ if($arg =~ m|--leavealone=(.+)$|) {
+ push @{$self->{LEAVEALONE}}, $1;
+ return 1;
+ }
+ if($arg =~ m|--includedir=(.+)$|) {
+ push @{$self->{INCLUDEDIR}}, $1; return 1;
+ }
+ if($arg =~ m|--stages|) {
+ $self->{SHOWSTAGES} = 1;
+ push @{$self->{CILARGS}}, $arg;
+ return 1;
+ }
+ if($arg eq "--bytecode") {
+ $self->{NATIVECAML} = 0; return 1;
+ }
+# if($arg eq "--no-idashi") {
+# $self->{IDASHI} = 0; return 1;
+# }
+ if($arg eq "--no-idashdot") {
+ $self->{IDASHDOT} = 0; return 1;
+ }
+
+ # sm: response file
+ if($arg =~ m|-@(.+)$| ||
+ (($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") && $arg =~ m|@(.+)$|)) {
+ my $fname = $1; # name of response file
+ &classifyArgDebug("processing response file: $fname\n");
+
+ # read the lines into an array
+ if (!open(RF, "<$fname")) {
+ die("cannot open response file $fname: $!\n");
+ }
+ my @respArgs = ();
+ while(<RF>) {
+ # Drop spaces and empty lines
+ my ($middle) = ($_ =~ m|\s*(\S.*\S)\s*|);
+ if($middle ne "") {
+ # Sometimes we have multiple arguments in one line :-()
+ if($middle =~ m|\s| &&
+ $middle !~ m|[\"]|) {
+ # Contains spaces and no quotes
+ my @middles = split(/\s+/, $middle);
+ push @respArgs, @middles;
+ } else {
+ push @respArgs, $middle;
+ }
+# print "Arg:$middle\n";
+ }
+ }
+ close(RF) or die;
+
+
+ # Scan and process the arguments
+ collectArgumentList($self, @respArgs);
+
+ #print("done with response file: $fname\n");
+ return 1; # argument undestood
+ }
+ if($arg eq "-@" || ($self->{MODENAME} eq "MSVC" && $arg eq "@")) {
+ # sm: I didn't implement the case where it takes the next argument
+ # because I wasn't sure how to grab add'l args (none of the
+ # cases above do..)
+ die("For ccured/cilly, please don't separate the -@ from the\n",
+ "response file name. e.g., use -@", "respfile.\n");
+ }
+
+ # Intercept the --out argument
+ if($arg =~ m|^--out=(\S+)$|) {
+ $self->{CILLY_OUT} = $1;
+ push @{$self->{CILARGS}}, "--out", $1;
+ return 1;
+ }
+ # All other arguments starting with -- are passed to CIL
+ if($arg =~ m|^--|) {
+ # Split the ==
+ if($arg =~ m|^(--\S+)=(.+)$|) {
+ push @{$self->{CILARGS}}, $1, $2; return 1;
+ } else {
+ push @{$self->{CILARGS}}, $arg; return 1;
+ }
+ }
+ return 0;
+}
+
+
+sub printVersion {
+ system ($CilCompiler::compiler, '--version');
+}
+
+sub printHelp {
+ my($self) = @_;
+ $self->usage();
+ print <<EOF;
+
+Options:
+ --mode=xxx What tool to emulate:
+ GNUCC - GNU gcc
+ AR - GNU ar
+ MSVC - MS VC cl compiler
+ MSLINK - MS VC link linker
+ MSLIB - MS VC lib linker
+ This option must be the first one! If it is not found there
+ then GNUCC mode is assumed.
+ --help (or -help) Prints this help message.
+ --verbose Prints a lot of information about what is being done.
+ --save-temps Keep temporary files in the current directory.
+ --save-temps=xxx Keep temporary files in the given directory.
+
+ --nomerge Apply CIL separately to each source file as they are compiled.
+ By default CIL is applied to the whole program during linking.
+ --merge Apply CIL to the merged program.
+ --keepmerged Save the merged file. Only useful if --nomerge is not given.
+ --trueobj Do not write preprocessed sources in .obj/.o files but
+ create some other files (e.g. foo.o_saved.c).
+ --truelib When linking to a library (with -r or -i), output real
+ object files instead of preprocessed sources. This only
+ works for GCC right now.
+ --leavealone=xxx Leave alone files whose base name is xxx. This means
+ they are not merged and not processed with CIL.
+ --includedir=xxx Adds a new include directory to replace existing ones
+ --bytecode Invoke the bytecode (as opposed to native code) system
+
+EOF
+# --no-idashi Do not use '-I-' with the gcc preprocessor.
+ $self->helpMessage();
+}
+
+# For printing the first line of the help message
+sub usage {
+ my ($self) = @_;
+ print "<No usage is defined>";
+}
+
+# The rest of the help message
+sub helpMessage {
+ my ($self) = @_;
+ print <<EOF;
+Send bugs to necula\@cs.berkeley.edu.
+EOF
+}
+
+
+#
+# Normalize a file name to always use slashes
+#
+sub normalizeFileName {
+ my($f) = @_;
+ $f =~ s|\\|/|g;
+ return $f;
+}
+
+#
+# The basic routines: for ech source file preprocess, compile, then link
+# everything
+#
+#
+
+
+# LINKING into a library (with COMPILATION and PREPROCESSING)
+sub straight_linktolib {
+ my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ my @sources = ref($psrcs) ? @{$psrcs} : ($psrcs);
+ my @dest = $dest eq "" ? () : ($self->{OUTLIB} . $dest);
+ # Pass the linkargs last because some libraries must be passed after
+ # the sources
+ my @cmd = (@{$self->{LDLIB}}, @dest, @{$ppargs}, @{$ccargs}, @sources, @{$ldargs});
+ return $self->runShell(@cmd);
+}
+
+# Customize the linking into libraries
+sub linktolib {
+ my($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ if($self->{VERBOSE}) { print STDERR "Linking into library $dest\n"; }
+
+ # Now collect the files to be merged
+ my ($tomerge, $trueobjs, $ccargs) =
+ $self->separateTrueObjects($psrcs, $ccargs);
+
+ if($self->{SEPARATE} || @{$tomerge} == 0) {
+ # Not merging. Regular linking.
+
+ return $self->straight_linktolib($psrcs, $dest,
+ $ppargs, $ccargs, $ldargs);
+ }
+ # We are merging. Merge all the files into a single one
+
+ if(@{$trueobjs} > 0) {
+ # We have some true objects. Save them into an additional file
+ my $trueobjs_file = "$dest" . "_trueobjs";
+ if($self->{VERBOSE}) {
+ print STDERR
+ "Saving additional true object files in $trueobjs_file\n";
+ }
+ open(TRUEOBJS, ">$trueobjs_file") || die "Cannot write $trueobjs_file";
+ foreach my $true (@{$trueobjs}) {
+ my $abs = File::Spec->rel2abs($true);
+ print TRUEOBJS "$abs\n";
+ }
+ close(TRUEOBJS);
+ }
+ if(@{$tomerge} == 1) { # Just copy the file over
+ (!system('cp', '-f', ${$tomerge}[0], $dest))
+ || die "Cannot copy ${$tomerge}[0] to $dest\n";
+ return ;
+ }
+ #
+ # We must do real merging
+ #
+ # Prepare the name of the CIL output file based on dest
+ my ($base, $dir, $ext) = fileparse($dest, "(\\.[^.]+)");
+
+ # Now prepare the command line for invoking cilly
+ my ($aftercil, @cmd) = $self->MergeCommand ($psrcs, $dir, $base);
+ die unless $cmd[0];
+
+ if($self->{MODENAME} eq "MSVC") {
+ push @cmd, "--MSVC";
+ }
+ if($self->{VERBOSE}) {
+ push @cmd, "--verbose";
+ }
+ if(defined $self->{CILARGS}) {
+ push @cmd, @{$self->{CILARGS}};
+ }
+ # Eliminate duplicates
+
+ # Add the arguments
+ if(@{$tomerge} > 20) {
+ my $extraFile = "___extra_files";
+ open(TOMERGE, ">$extraFile") || die $!;
+ #FRANJO added the following on February 15th, 2005
+ #REASON: extrafiles was TempFIle=HASH(0x12345678)
+ # instead of actual filename
+ my @normalized = @{$tomerge} ;
+ $_ = (ref $_ ? $_->filename : $_) foreach @normalized;
+ foreach my $fl (@normalized) {
+ print TOMERGE "$fl\n";
+ }
+ close(TOMERGE);
+ push @cmd, '--extrafiles', $extraFile;
+ } else {
+ push @cmd, @{$tomerge};
+ }
+ push @cmd, "--mergedout", $dest;
+ # Now run cilly
+ return $self->runShell(@cmd);
+}
+
+############
+############ PREPROCESSING
+############
+#
+# All flavors of preprocessing return the destination file
+#
+
+# THIS IS THE ENTRY POINT FOR COMPILING SOURCE FILES
+sub preprocess_compile {
+ my ($self, $src, $dest, $early_ppargs, $ppargs, $ccargs) = @_;
+ &mydebug("preprocess_compile(src=$src, dest=$dest)\n");
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+
+ my ($base, $dir, $ext) = fileparse($src, "\\.[^.]+");
+ if($ext eq ".c" || $ext eq ".cpp" || $ext eq ".cc") {
+ if($self->leaveAlone($src)) {
+ print "Leaving alone $src\n";
+ # We leave this alone. So just compile as usual
+ return $self->straight_compile($src, $dest, $early_ppargs, $ppargs, $ccargs);
+ }
+ my $out = $self->preprocessOutputFile($src);
+ $out = $self->preprocess($src, $out,
+ [@{$early_ppargs}, @{$ppargs},
+ "$self->{DEFARG}CIL=1"]);
+ return $self->compile($out, $dest, $ppargs, $ccargs);
+ }
+ if($ext eq ".i") {
+ return $self->compile($src, $dest, $ppargs, $ccargs);
+ }
+ if($ext eq ".$::cilbin") {
+ return $self->compile($src, $dest, $ppargs, $ccargs);
+ }
+}
+
+# THIS IS THE ENTRY POINT FOR JUST PREPROCESSING A FILE
+sub preprocess {
+ my($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ return $self->preprocess_before_cil($src, $dest, $ppargs);
+}
+
+# Find the name of the preprocessed file before CIL processing
+sub preprocessOutputFile {
+ my($self, $src) = @_;
+ return $self->outputFile($src, 'i');
+}
+
+# Find the name of the preprocessed file after CIL processing
+sub preprocessAfterOutputFile {
+ my($self, $src) = @_;
+ return $self->outputFile($src, 'cil.i');
+}
+
+# When we use CIL we have two separate preprocessing stages. First is the
+# preprocessing before the CIL sees the code and the is the preprocessing
+# after CIL sees the code
+
+sub preprocess_before_cil {
+ my ($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ my @args = @{$ppargs};
+
+ # See if we must force some includes
+ if(defined $self->{INCLUDEDIR} && !defined($ENV{"CILLY_NOCURE"})) {
+ # And force the other includes. Put them at the begining
+ if(($self->{MODENAME} eq 'GNUCC') &&
+ # sm: m88k doesn't work if I pass -I.
+ $self->{IDASHDOT}) {
+ unshift @args, "-I.";
+ }
+ if(! defined($self->{VERSION})) {
+ $self->setVersion();
+ }
+ unshift @args,
+ map { my $dir = $_;
+ $self->{INCARG} . $dir . "/" . $self->{VERSION} }
+ @{$self->{INCLUDEDIR}};
+ #matth: include the main include dir as well as the compiler-specific directory
+ unshift @args,
+ map { my $dir = $_;
+ $self->{INCARG} . $dir }
+ @{$self->{INCLUDEDIR}};
+ if($self->{MODENAME} eq 'GNUCC') {
+ # sm: this is incompatible with wu-ftpd, but is apparently needed
+ # for apache.. more investigation is needed
+ # update: now when I try it, apache works without -I- also.. but
+ # I'll make this into a switchable flag anyway
+ # matth: this breaks other tests. Let's try without.
+# if ($self->{IDASHI}) {
+# unshift @args, "-I-";
+# }
+ }
+ }
+
+ return $self->straight_preprocess($src, $dest, \@args);
+}
+
+# Preprocessing after CIL
+sub preprocess_after_cil {
+ my ($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ return $self->straight_preprocess($src, $dest, $ppargs);
+}
+
+#
+# This is intended to be the true invocation of the underlying preprocessor
+# You should not override this method
+sub straight_preprocess {
+ my ($self, $src, $dest, $ppargs) = @_;
+ Carp::confess "bad dest: $dest" unless $dest->isa('OutputFile');
+ if($self->{VERBOSE}) {
+ my $srcname = ref $src ? $src->filename : $src;
+ print STDERR "Preprocessing $srcname\n";
+ }
+ if($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") {
+ $self->MSVC::msvc_preprocess($src, $dest, $ppargs);
+ } else {
+# print Dumper($self);
+ my @cmd = (@{$self->{CPP}}, @{$ppargs},
+ $src, $self->makeOutArguments($self->{OUTCPP}, $dest));
+ $self->runShell(@cmd);
+
+ }
+ return $dest;
+}
+
+
+#
+#
+#
+# COMPILATION
+#
+#
+
+sub compile {
+ my($self, $src, $dest, $ppargs, $ccargs) = @_;
+ &mydebug("Cilly.compile(src=$src, dest=$dest->{filename})\n");
+ Carp::confess "bad dest: $dest->{filename}"
+ unless $dest->isa('OutputFile');
+
+ if($self->{SEPARATE}) {
+ # Now invoke CIL and compile afterwards
+ return $self->applyCilAndCompile([$src], $dest, $ppargs, $ccargs);
+ }
+ # We are merging
+ # If we are merging then we just save the preprocessed source
+ my ($mtime, $res, $outfile);
+ if(! $self->{TRUEOBJ}) {
+ $outfile = $dest->{filename}; $mtime = 0; $res = $dest;
+ } else {
+ # Do the real compilation
+ $res = $self->straight_compile($src, $dest, $ppargs, $ccargs);
+ # Now stat the result
+ my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime_1,$ctime,$blksize,$blocks) = stat($dest->{filename});
+ if(! defined($mtime_1)) {
+ die "Cannot stat the result of compilation $dest->{filename}";
+ }
+ $mtime = $mtime_1;
+ $outfile = $dest->{filename} . $Cilly::savedSourceExt;
+ }
+ my $srcname = ref $src ? $src->filename : $src;
+ if($self->{VERBOSE}) {
+ print STDERR "Saving source $srcname into $outfile\n";
+ }
+ open(OUT, ">$outfile") || die "Cannot create $outfile";
+ my $toprintsrc = $srcname;
+ $toprintsrc =~ s|\\|/|g;
+ print OUT "#pragma merger($mtime,\"$toprintsrc\",\"" .
+ join(',', @{$ccargs}), "\")\n";
+ open(IN, '<', $srcname) || die "Cannot read $srcname";
+ while(<IN>) {
+ print OUT $_;
+ }
+ close(OUT);
+ close(IN);
+ return $res;
+}
+
+sub makeOutArguments {
+ my ($self, $which, $dest) = @_;
+ $dest = $dest->{filename} if ref $dest;
+ if($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") {
+ # A single argument
+ return ("$which$dest");
+ } else {
+ return ($which, $dest);
+ }
+}
+# This is the actual invocation of the underlying compiler. You should not
+# override this
+sub straight_compile {
+ my ($self, $src, $dest, $ppargs, $ccargs) = @_;
+ if($self->{VERBOSE}) {
+ print STDERR 'Compiling ', ref $src ? $src->filename : $src, ' into ',
+ $dest->filename, "\n";
+ }
+ my @dest =
+ $dest eq "" ? () : $self->makeOutArguments($self->{OUTOBJ}, $dest);
+ my @forcec = @{$self->{FORCECSOURCE}};
+ my @cmd = (@{$self->{CC}}, @{$ppargs}, @{$ccargs},
+ @dest, @forcec, $src);
+ return $self->runShell(@cmd);
+}
+
+# This is compilation after CIL
+sub compile_cil {
+ my ($self, $src, $dest, $ppargs, $ccargs) = @_;
+ return $self->straight_compile($src, $dest, $ppargs, $ccargs);
+}
+
+
+
+# THIS IS THE ENTRY POINT FOR JUST ASSEMBLING FILES
+sub assemble {
+ my ($self, $src, $dest, $ppargs, $ccargs) = @_;
+ if($self->{VERBOSE}) { print STDERR "Assembling $src\n"; }
+ my @dest =
+ $dest eq "" ? () : $self->makeOutArguments($self->{OUTOBJ}, $dest);
+ my @cmd = (@{$self->{CC}}, @{$ppargs}, @{$ccargs},
+ @dest, $src);
+ return $self->runShell(@cmd);
+}
+
+
+
+#
+# This is intended to be the true invocation of the underlying linker
+# You should not override this method
+sub straight_link {
+ my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ my @sources = ref($psrcs) ? @{$psrcs} : ($psrcs);
+ my @dest =
+ $dest eq "" ? () : $self->makeOutArguments($self->{OUTEXE}, $dest);
+ # Pass the linkargs last because some libraries must be passed after
+ # the sources
+ my @cmd = (@{$self->{LD}}, @dest,
+ @{$ppargs}, @{$ccargs}, @sources, @{$ldargs});
+ return $self->runShell(@cmd);
+}
+
+#
+# See if some libraries are actually lists of files
+sub expandLibraries {
+ my ($self) = @_;
+
+ my @tolink = @{$self->{OFILES}};
+
+ # Go through the sources and replace all libraries with the files that
+ # they contain
+ my @tolink1 = ();
+ while($#tolink >= 0) {
+ my $src = shift @tolink;
+# print "Looking at $src\n";
+ # See if the source is a library. Then maybe we should get instead the
+ # list of files
+ if($src =~ m|\.$self->{LIBEXT}$| && -f "$src.files") {
+ open(FILES, "<$src.files") || die "Cannot read $src.files";
+ while(<FILES>) {
+ # Put them back in the "tolink" to process them recursively
+ while($_ =~ m|[\r\n]$|) {
+ chop;
+ }
+ unshift @tolink, $_;
+ }
+ close(FILES);
+ next;
+ }
+ # This is not for us
+ push @tolink1, $src;
+ next;
+ }
+ $self->{OFILES} = \@tolink1;
+}
+
+# Go over a list of object files and separate them into those that are
+# actually sources to be merged, and the true object files
+#
+sub separateTrueObjects {
+ my ($self, $psrcs, $ccargs) = @_;
+
+ my @sources = @{$psrcs};
+# print "Sources are @sources\n";
+ my @tomerge = ();
+ my @othersources = ();
+
+ my @ccmerged = @{$ccargs};
+ foreach my $src (@sources) {
+ my ($combsrc, $combsrcname, $mtime);
+ my $srcname = ref $src ? $src->filename : $src;
+ if(! $self->{TRUEOBJ}) {
+ # We are using the object file itself to save the sources
+ $combsrcname = $srcname;
+ $combsrc = $src;
+ $mtime = 0;
+ } else {
+ $combsrcname = $srcname . $Cilly::savedSourceExt;
+ $combsrc = $combsrcname;
+ if(-f $combsrcname) {
+ my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime_1,$ctime,$blksize,$blocks) = stat($srcname);
+ $mtime = $mtime_1;
+ } else {
+ $mtime = 0;
+ }
+ }
+ # Look inside and see if it is one of the files created by us
+ open(IN, "<$combsrcname") || die "Cannot read $combsrcname";
+ my $fstline = <IN>;
+ close(IN);
+ if($fstline =~ m|CIL|) {
+ goto ToMerge;
+ }
+ if($fstline =~ m|^\#pragma merger\((\d+),\".*\",\"(.*)\"\)$|) {
+ my $mymtime = $1;
+ # Get the CC flags
+ my @thisccargs = split(/,/, $2);
+ foreach my $arg (@thisccargs) {
+ # print "Looking at $arg\n ccmerged=@ccmerged\n";
+ if(! grep(/$arg/, @ccmerged)) {
+ # print " adding it\n";
+ push @ccmerged, $arg
+ }
+ }
+ ToMerge:
+ if($mymtime == $mtime) { # It is ours
+ # See if we have this already
+ if(! grep { $_ eq $srcname } @tomerge) { # It is ours
+ push @tomerge, $combsrc;
+ # See if there is a a trueobjs file also
+ my $trueobjs = $combsrcname . "_trueobjs";
+ if(-f $trueobjs) {
+ open(TRUEOBJS, "<$trueobjs")
+ || die "Cannot read $trueobjs";
+ while(<TRUEOBJS>) {
+ chop;
+ push @othersources, $_;
+ }
+ close(TRUEOBJS);
+ }
+ }
+ next;
+ }
+ }
+ push @othersources, $combsrc;
+ }
+ # If we are merging, turn off "warnings are errors" flag
+ if(grep(/$self->{WARNISERROR}/, @ccmerged)) {
+ @ccmerged = grep(!/$self->{WARNISERROR}/, @ccmerged);
+ print STDERR "Turning off warn-is-error flag $self->{WARNISERROR}\n";
+ }
+
+ return (\@tomerge, \@othersources, \@ccmerged);
+}
+
+
+# Customize the linking
+sub link {
+ my($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ my $destname = ref $dest ? $dest->filename : $dest;
+ if($self->{SEPARATE}) {
+ if (!defined($ENV{CILLY_DONT_LINK_AFTER_MERGE})) {
+ if($self->{VERBOSE}) { print STDERR "Linking into $destname\n"; }
+ # Not merging. Regular linking.
+ return $self->link_after_cil($psrcs, $dest,
+ $ppargs, $ccargs, $ldargs);
+ }
+ else {
+ return 0; # sm: is this value used??
+ }
+ }
+ my $mergedobj = new OutputFile($destname,
+ "${destname}_comb.$self->{OBJEXT}");
+
+ # We must merge
+ if($self->{VERBOSE}) {
+ print STDERR "Merging saved sources into $mergedobj->{filename} (in process of linking $destname)\n";
+ }
+
+ # Now collect the files to be merged
+
+ my ($tomerge, $trueobjs, $ccargs) =
+ $self->separateTrueObjects($psrcs, $ccargs);
+
+ if($self->{VERBOSE}) {
+ print STDERR "Will merge the following: ",
+ join(' ', @{$tomerge}), "\n";
+ print STDERR "Will just link the genuine object files: ",
+ join(' ', @{$trueobjs}), "\n";
+ print STDERR "After merge compile flags: @{$ccargs}\n";
+ }
+ # Check the modification times and see if we can just use the combined
+ # file instead of merging all over again
+ if(@{$tomerge} > 1 && $self->{KEEPMERGED}) {
+ my $canReuse = 1;
+ my $combFile = new OutputFile($destname,
+ "${destname}_comb.c");
+ my @tmp = stat($combFile);
+ my $combFileMtime = $tmp[9] || 0;
+ foreach my $mrg (@{$tomerge}) {
+ my @tmp = stat($mrg); my $mtime = $tmp[9];
+ if($mtime >= $combFileMtime) { goto DoMerge; }
+ }
+ if($self->{VERBOSE}) {
+ print STDERR "Reusing merged file $combFile\n";
+ }
+ $self->applyCilAndCompile([$combFile], $mergedobj, $ppargs, $ccargs);
+ } else {
+ DoMerge:
+ $self->applyCilAndCompile($tomerge, $mergedobj, $ppargs, $ccargs);
+ }
+
+ # Put the merged OBJ at the beginning because maybe some of the trueobjs
+ # are libraries which like to be at the end
+ unshift @{$trueobjs}, $mergedobj;
+
+ # And finally link
+ # zf: hack for linking linux stuff
+ if ($self->{TRUELIB}) {
+ my @cmd = (@{$self->{LDLIB}}, ($dest),
+ @{$ppargs}, @{$ccargs}, @{$trueobjs}, @{$ldargs});
+ return $self->runShell(@cmd);
+ }
+
+ # sm: hack: made this conditional for dsw
+ if (!defined($ENV{CILLY_DONT_LINK_AFTER_MERGE})) {
+ $self->link_after_cil($trueobjs, $dest, $ppargs, $ccargs, $ldargs);
+ }
+
+}
+
+sub applyCil {
+ my ($self, $ppsrc, $dest) = @_;
+
+ # The input files
+ my @srcs = @{$ppsrc};
+
+ # Now prepare the command line for invoking cilly
+ my ($aftercil, @cmd) = $self->CillyCommand ($ppsrc, $dest);
+ Carp::confess "$self produced bad output file: $aftercil"
+ unless $aftercil->isa('OutputFile');
+
+ if($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB") {
+ push @cmd, '--MSVC';
+ }
+ if($self->{VERBOSE}) {
+ push @cmd, '--verbose';
+ }
+ if(defined $self->{CILARGS}) {
+ push @cmd, @{$self->{CILARGS}};
+ }
+
+ # Add the arguments
+ if(@srcs > 20) {
+ my $extraFile = "___extra_files";
+ open(TOMERGE, ">$extraFile") || die $!;
+ foreach my $fl (@srcs) {
+ my $fname = ref $fl ? $fl->filename : $fl;
+ print TOMERGE "$fname\n";
+ }
+ close(TOMERGE);
+ push @cmd, '--extrafiles', $extraFile;
+ } else {
+ push @cmd, @srcs;
+ }
+ if(@srcs > 1 && $self->{KEEPMERGED}) {
+ my ($base, $dir, undef) = fileparse($dest->filename, qr{\.[^.]+});
+ push @cmd, '--mergedout', "$dir$base" . '.c';
+ }
+ # Now run cilly
+ $self->runShell(@cmd);
+
+ # Tell the caller where we put the output
+ return $aftercil;
+}
+
+
+sub applyCilAndCompile {
+ my ($self, $ppsrc, $dest, $ppargs, $ccargs) = @_;
+ Carp::confess "$self produced bad destination file: $dest"
+ unless $dest->isa('OutputFile');
+
+ # The input files
+ my @srcs = @{$ppsrc};
+ &mydebug("Cilly.PM.applyCilAndCompile(srcs=[",join(',',@{$ppsrc}),"])\n");
+
+ # Now run cilly
+ my $aftercil = $self->applyCil($ppsrc, $dest);
+ Carp::confess "$self produced bad output file: $aftercil"
+ unless $aftercil->isa('OutputFile');
+
+ # Now preprocess
+ my $aftercilpp = $self->preprocessAfterOutputFile($aftercil);
+ $self->preprocess_after_cil($aftercil, $aftercilpp, $ppargs);
+
+ if (!defined($ENV{CILLY_DONT_COMPILE_AFTER_MERGE})) {
+ # Now compile
+ return $self->compile_cil($aftercilpp, $dest, $ppargs, $ccargs);
+ }
+}
+
+# Linking after CIL
+sub link_after_cil {
+ my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_;
+ if (!defined($ENV{CILLY_DONT_COMPILE_AFTER_MERGE})) {
+ return $self->straight_link($psrcs, $dest, $ppargs, $ccargs, $ldargs);
+ }
+}
+
+# See if we must merge this one
+sub leaveAlone {
+ my($self, $filename) = @_;
+ my ($base, $dir, $ext) = fileparse($filename, "(\\.[^.]+)");
+ if(grep { $_ eq $base } @{$self->{LEAVEALONE}}) {
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+
+# DO EVERYTHING
+sub doit {
+ my ($self) = @_;
+ my $file;
+ my $out;
+
+# print Dumper($self);
+
+ # Maybe we must preprocess only
+ if($self->{OPERATION} eq "TOI" || $self->{OPERATION} eq 'SPECIAL') {
+ # Then we do not do anything
+ my @cmd = (@{$self->{CPP}},
+ @{$self->{EARLY_PPARGS}},
+ @{$self->{PPARGS}}, @{$self->{CCARGS}},
+ @{$self->{CFILES}}, @{$self->{SFILES}});
+ push @cmd, @{$self->{OUTARG}} if defined $self->{OUTARG};
+
+ return $self->runShell(@cmd);
+ }
+ # We expand some libraries names. Maybe they just contain some
+ # new object files
+ $self->expandLibraries();
+
+ # Try to guess whether to run in the separate mode. In that case
+ # we can go ahead with the compilation, without having to save
+ # files
+ if(! $self->{SEPARATE} && # Not already separate mode
+ $self->{OPERATION} eq "TOEXE" && # We are linking to an executable
+ @{$self->{CFILES}} + @{$self->{IFILES}} <= 1) { # At most one source
+ # If we have object files, we should keep merging if at least one
+ # object file is a disguised source
+ my $turnOffMerging = 0;
+ if(@{$self->{OFILES}}) {
+ my ($tomerge, $trueobjs, $mergedccargs) =
+ $self->separateTrueObjects($self->{OFILES}, $self->{CCARGS});
+ $self->{CCARGS} = $mergedccargs;
+ $turnOffMerging = (@{$tomerge} == 0);
+ } else {
+ $turnOffMerging = 1;
+ }
+ if($turnOffMerging) {
+ if($self->{VERBOSE}) {
+ print STDERR
+ "Turn off merging because the program contains one file\n";
+ }
+ $self->{SEPARATE} = 1;
+ }
+ }
+
+ # Turn everything into OBJ files
+ my @tolink = ();
+
+ foreach $file (@{$self->{IFILES}}, @{$self->{CFILES}}) {
+ $out = $self->compileOutputFile($file);
+ $self->preprocess_compile($file, $out,
+ $self->{EARLY_PPARGS},
+ $self->{PPARGS}, $self->{CCARGS});
+ push @tolink, $out;
+ }
+ # Now do the assembly language file
+ foreach $file (@{$self->{SFILES}}) {
+ $out = $self->assembleOutputFile($file);
+ $self->assemble($file, $out, $self->{PPARGS}, $self->{CCARGS});
+ push @tolink, $out;
+ }
+ # Now add the original object files. Put them last because libraries like
+ # to be last.
+ push @tolink, @{$self->{OFILES}};
+
+ # See if we must stop after compilation
+ if($self->{OPERATION} eq "TOOBJ") {
+ return;
+ }
+
+ # See if we must create a library only
+ if($self->{OPERATION} eq "TOLIB") {
+ if (!$self->{TRUELIB}) {
+ # zf: Creating a library containing merged source
+ $out = $self->linkOutputFile(@tolink);
+ $self->linktolib(\@tolink, $out,
+ $self->{PPARGS}, $self->{CCARGS},
+ $self->{LINKARGS});
+ return;
+ } else {
+ # zf: Linking to a true library. Do real curing.
+ # Only difference from TOEXE is that we use "partial linking" of the
+ # underlying linker
+ if ($self->{VERBOSE}) {
+ print STDERR "Linking to a true library!";
+ }
+ push @{$self->{CCARGS}}, "-r";
+ $out = $self->linkOutputFile(@tolink);
+ $self->link(\@tolink, $out,
+ $self->{PPARGS}, $self->{CCARGS}, $self->{LINKARGS});
+ return;
+ }
+
+ }
+
+ # Now link all of the files into an executable
+ if($self->{OPERATION} eq "TOEXE") {
+ $out = $self->linkOutputFile(@tolink);
+ $self->link(\@tolink, $out,
+ $self->{PPARGS}, $self->{CCARGS}, $self->{LINKARGS});
+ return;
+ }
+
+ die "I don't understand OPERATION:$self->{OPERATION}\n";
+}
+
+sub classifyArgDebug {
+ if(0) { print @_; }
+}
+
+sub mydebug {
+ if(0) { print @_; }
+}
+
+sub compilerArgument {
+ my($self, $options, $arg, $pargs) = @_;
+ &classifyArgDebug("Classifying arg: $arg\n");
+ my $idx = 0;
+ for($idx=0; $idx < $#$options; $idx += 2) {
+ my $key = ${$options}[$idx];
+ my $action = ${$options}[$idx + 1];
+ &classifyArgDebug("Try match with $key\n");
+ if($arg =~ m|^$key|) {
+ &classifyArgDebug(" match with $key\n");
+ my @fullarg = ($arg);
+ my $onemore;
+ if(defined $action->{'ONEMORE'}) {
+ &classifyArgDebug(" expecting one more\n");
+ # Maybe the next arg is attached
+ my $realarg;
+ ($realarg, $onemore) = ($arg =~ m|^($key)(.+)$|);
+ if(! defined $onemore) {
+ # Grab the next argument
+ $onemore = $self->fetchNextArg($pargs);
+ $onemore = &quoteIfNecessary($onemore);
+ push @fullarg, $onemore;
+ } else {
+ $onemore = &quoteIfNecessary($onemore);
+ }
+ &classifyArgDebug(" onemore=$onemore\n");
+ }
+ # Now see what action we must perform
+ my $argument_done = 1;
+ if(defined $action->{'RUN'}) {
+ &{$action->{'RUN'}}($self, @fullarg, $onemore, $pargs);
+ $argument_done = 1;
+ }
+ # Quote special SHELL caracters
+ @fullarg = map { $_ =~ s%([<>;&|])%'$1'%g; $_ } @fullarg;
+ # print "fullarg = ", @fullarg, "\n";
+ if(defined $action->{'TYPE'}) {
+ &classifyArgDebug(" type=$action->{TYPE}\n");
+ if($action->{TYPE} eq 'EARLY_PREPROC') {
+ push @{$self->{EARLY_PPARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "PREPROC") {
+ push @{$self->{PPARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq 'SPECIAL') {
+ push @{$self->{PPARGS}}, @fullarg;
+ $self->{OPERATION} = 'SPECIAL';
+ return 1;
+ }
+ elsif($action->{TYPE} eq "CC") {
+ push @{$self->{CCARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "LINKCC") {
+ push @{$self->{CCARGS}}, @fullarg;
+ push @{$self->{LINKARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "ALLARGS") {
+ push @{$self->{PPARGS}}, @fullarg;
+ push @{$self->{CCARGS}}, @fullarg;
+ push @{$self->{LINKARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "LINK") {
+ push @{$self->{LINKARGS}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "CSOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{CFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "ASMSOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{SFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "OSOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{OFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq "ISOURCE") {
+ OutputFile->protect(@fullarg);
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ push @{$self->{IFILES}}, @fullarg; return 1;
+ }
+ elsif($action->{TYPE} eq 'OUT') {
+ if(defined($self->{OUTARG})) {
+ print "Warning: output file is multiply defined: @{$self->{OUTARG}} and @fullarg\n";
+ }
+ $fullarg[0] = &normalizeFileName($fullarg[0]);
+ $self->{OUTARG} = [@fullarg]; return 1;
+ }
+ print " Do not understand TYPE\n"; return 1;
+ }
+ if($argument_done) { return 1; }
+ print "Don't know what to do with option $arg\n";
+ return 0;
+ }
+ }
+ return 0;
+}
+
+
+sub runShell {
+ my ($self, @cmd) = @_;
+
+ my $msvcFriends =
+ ($self->{MODENAME} eq "MSVC" ||
+ $self->{MODENAME} eq "MSLINK" ||
+ $self->{MODENAME} eq "MSLIB");
+
+ foreach (@cmd) {
+ $_ = $_->filename if ref;
+ # If we are in MSVC mode then we might have to convert the files
+ # from cygwin names to the actual Windows names
+ if($msvcFriends && $^O eq "cygwin") {
+ my $arg = $_;
+ if ($arg =~ m|^/| && -f $arg) {
+ my $mname = `cygpath -m $arg`;
+ chop $mname;
+ if($mname ne "") { $_ = $mname; }
+ }
+ }
+ }
+
+ # sm: I want this printed to stderr instead of stdout
+ # because the rest of 'make' output goes there and this
+ # way I can capture to a coherent file
+ # sm: removed conditional on verbose since there's already
+ # so much noise in the output, and this is the *one* piece
+ # of information I *always* end up digging around for..
+ if($self->{TRACE_COMMANDS}) { print STDERR "@cmd\n"; }
+
+ # weimer: let's have a sanity check
+ my $code = system { $cmd[0] } @cmd;
+ if ($code != 0) {
+ # sm: now that we always print, don't echo the command again,
+ # since that makes the output more confusing
+ #die "Possible error with @cmd!\n";
+ $code >>= 8; # extract exit code portion
+
+ exit $code;
+ }
+ return $code;
+}
+
+sub quoteIfNecessary {
+ my($arg) = @_;
+ # If it contains spaces or "" then it must be quoted
+ if($arg =~ m|\s| || $arg =~ m|\"|) {
+ return "\'$arg\'";
+ } else {
+ return $arg;
+ }
+}
+
+
+sub cilOutputFile {
+ Carp::croak 'bad argument count' unless @_ == 3;
+ my ($self, $basis, $suffix) = @_;
+
+ if (defined $self->{SAVE_TEMPS}) {
+ return new KeptFile($basis, $suffix, $self->{SAVE_TEMPS});
+ } else {
+ return $self->outputFile($basis, $suffix);
+ }
+}
+
+
+sub outputFile {
+ Carp::confess 'bad argument count' unless @_ == 3;
+ my ($self, $basis, $suffix) = @_;
+
+ if (defined $self->{SAVE_TEMPS}) {
+ return new KeptFile($basis, $suffix, $self->{SAVE_TEMPS});
+ } else {
+ return new TempFile($basis, $suffix);
+ }
+}
+
+
+###########################################################################
+####
+#### MS CL specific code
+####
+package MSVC;
+
+use strict;
+use File::Basename;
+use Data::Dumper;
+
+# For MSVC we remember which was the first source, because we use that to
+# determine the name of the output file
+sub setFirstSource {
+ my ($self, $src) = @_;
+
+ if(! defined ($self->{FIRST_SOURCE})) {
+ $self->{FIRST_SOURCE} = $src;
+ }
+}
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+ # Create $self
+
+ my $self =
+ { NAME => 'Microsoft cl compiler',
+ MODENAME => 'MSVC',
+ CC => ['cl', '/nologo', '/D_MSVC', '/c'],
+ CPP => ['cl', '/nologo', '/D_MSVC', '/P'],
+ LD => ['cl', '/nologo', '/D_MSVC'],
+ DEFARG => "/D",
+ INCARG => "/I",
+ DEBUGARG => ['/Zi', '/MLd', '/DEBUG'],
+ OPTIMARG => ['/Ox', '/G6'],
+ OBJEXT => "obj",
+ LIBEXT => "lib", # Library extension (without the .)
+ EXEEXT => ".exe", # Executable extension (with the .)
+ OUTOBJ => "/Fo",
+ OUTEXE => "/Fe",
+ WARNISERROR => "/WX",
+ FORCECSOURCE => ['/Tc'],
+ LINEPATTERN => "^#line\\s+(\\d+)\\s+\"(.+)\"",
+
+ OPTIONS =>
+# Describe the compiler options as a list of patterns and associated actions.
+# The patterns are matched in order against the _begining_ of the argument.
+#
+# If the action contains ONEMORE => 1 then the argument is expected to be
+# parameterized by a following word. The word can be attached immediately to
+# the end of the argument or in a separate word.
+#
+# If the action contains TYPE => "..." then the argument is put into
+# one of several lists, as follows: "PREPROC" in ppargs; "CC" in
+# ccargs; "LINK" in linkargs; "LINKCC" both in ccargs and linkargs;
+# "ALLARGS" in ppargs, ccargs, and linkargs; "CSOURCE" in cfiles;
+# "ASMSOURCE" in sfiles; "OSOURCE" in ofiles; "ISOURCE" in ifiles;
+# "OUT" in outarg. "SPECIAL" flags indicate that the compiler should
+# be run directly so that it can perform some special action other
+# than generating code (e.g. printing out version or configuration
+# information).
+#
+# If the TYPE is not defined but the RUN => sub { ... } is defined then the
+# given subroutine is invoked with the self, the argument and the (possibly
+# empty) additional word and a pointer to the list of remaining arguments
+#
+ ["^[^/\\-@].*\\.($::cilbin|c|cpp|cc)\$" =>
+ { TYPE => 'CSOURCE',
+ RUN => sub { &MSVC::setFirstSource(@_); } },
+ "[^/].*\\.(asm)\$" => { TYPE => 'ASMSOURCE' },
+ "[^/].*\\.i\$" => { TYPE => 'ISOURCE' },
+ "[^/\\-@]" => { TYPE => "OSOURCE" },
+ "[/\\-]O" => { TYPE => "CC" },
+ "[/\\-][DI]" => { TYPE => "PREPROC"},
+ "[/\\-]EH" => { TYPE => "CC" },
+ "[/\\-]G" => { TYPE => "CC" },
+ "[/\\-]F[aA]" => { TYPE => 'CC' },
+ "[/\\-]Fo" => { TYPE => 'OUT' },
+ "/Fe" => { TYPE => 'OUT',
+ RUN => sub { $stub->{OPERATION} = "TOEXE" }},
+ "[/\\-]F[dprR]" => { TYPE => "CC" },
+ "[/\\-]FI" => { TYPE => "PREPROC" },
+ "[/\\-][CXu]" => { TYPE => "PREPROC" },
+ "[/\\-]U" => { ONEMORE => 1, TYPE => "PREPROC" },
+ "[/\\-](E|EP|P)" => { RUN => sub { push @{$stub->{PPARGS}}, $_[1];
+ $stub->{OPERATION} = "PREPROC"; }},
+ "[/\\-]c" => { RUN => sub { $stub->{OPERATION} = "TOOBJ"; }},
+ "[/\\-](Q|Z|J|nologo|w|W|Zm)" => { TYPE => "CC" },
+ "[/\\-]Y(u|c|d|l|X)" => { TYPE => "CC" },
+ "[/\\-]T(C|P)" => { TYPE => "PREPROC" },
+ "[/\\-]Tc(.+)\$" =>
+ { RUN => sub {
+ my $arg = $_[1];
+ my ($fname) = ($arg =~ m|[/\\-]Tc(.+)$|);
+ $fname = &normalizeFileName($fname);
+ push @{$stub->{CFILES}}, $fname;
+ }},
+ "[/\\-]v(d|m)" => { TYPE => "CC" },
+ "[/\\-]F" => { TYPE => "CC" },
+ "[/\\-]M" => { TYPE => 'LINKCC' },
+ "/link" => { RUN => sub { push @{$stub->{LINKARGS}}, "/link",
+ @{$_[3]};
+ @{$_[3]} = (); } },
+ "-cbstring" => { TYPE => "CC" },
+ "/" => { RUN =>
+ sub { print "Unimplemented MSVC argument $_[1]\n";}},
+ ],
+ };
+ bless $self, $class;
+ return $self;
+}
+
+
+sub msvc_preprocess {
+ my($self, $src, $dest, $ppargs) = @_;
+ my $res;
+ my $srcname = ref $src ? $src->filename : $src;
+ my ($sbase, $sdir, $sext) =
+ fileparse($srcname,
+ "(\\.c)|(\\.cc)|(\\.cpp)|(\\.i)");
+ # If this is a .cpp file we still hope it is C. Pass the /Tc argument to
+ # cl to force this file to be interpreted as a C one
+ my @cmd = @{$ppargs};
+
+ if($sext eq ".cpp") {
+ push @cmd, "/Tc";
+ }
+ # MSVC cannot be told where to put the output. But we know that it
+ # puts it in the current directory
+ my $msvcout = "./$sbase.i";
+ if($self->{STDOUTPP}) {
+ @cmd = ('cmd', '/c', 'cl', '/nologo', '/E', ">$msvcout", '/D_MSVC',
+ @cmd);
+
+ } else {
+ @cmd = ('cl', '/nologo', '/P', '/D_MSVC', @cmd);
+ }
+ $res = $self->runShell(@cmd, $srcname);
+ # Check file equivalence by making sure that all elements of the stat
+ # structure are the same, except for the access time.
+ my @st1 = stat $msvcout; $st1[8] = 0;
+ my @st2 = stat $dest->{filename}; $st2[8] = 0;
+ # print Dumper(\@st1, \@st2);
+ if($msvcout ne $dest->{filename}) {
+ while($#st1 >= 0) {
+ if(shift @st1 != shift @st2) {
+# print "$msvcout is NOT the same as $afterpp\n";
+ if($self->{VERBOSE}) {
+ print STDERR "Copying $msvcout to $dest->{filename} (MSVC_preprocess)\n";
+ }
+ unlink $dest;
+ File::Copy::copy($msvcout, $dest->filename);
+ unlink $msvcout;
+ return $res;
+ }
+ }
+ }
+ return $res;
+}
+
+sub forceIncludeArg {
+ my($self, $what) = @_;
+ return "/FI$what";
+}
+
+
+ # MSVC does not understand the extension .i, so we tell it it is a C file
+sub fixupCsources {
+ my (@csources) = @_;
+ my @mod_csources = ();
+ my $src;
+ foreach $src (@csources) {
+ my ($sbase, $sdir, $sext) = fileparse($src,
+ "\\.[^.]+");
+ if($sext eq ".i") {
+ push @mod_csources, "/Tc";
+ }
+ push @mod_csources, $src;
+ }
+ return @mod_csources;
+}
+
+
+# Emit a line # directive
+sub lineDirective {
+ my ($self, $fileName, $lineno) = @_;
+ return "#line $lineno \"$fileName\"\n";
+}
+
+# The name of the output file
+sub compileOutputFile {
+ my($self, $src) = @_;
+
+ die "compileOutputFile: not a C source file: $src\n"
+ unless $src =~ /\.($::cilbin|c|cc|cpp|i|asm)$/;
+
+ Carp::carp ("compileOutputFile: $self->{OPERATION}, $src",
+ Dumper($self->{OUTARG})) if 0;
+ if ($self->{OPERATION} eq 'TOOBJ') {
+ if(defined $self->{OUTARG}
+ && "@{$self->{OUTARG}}" =~ m|[/\\-]Fo(.+)|) {
+ my $dest = $1;
+ # Perhaps $dest is a directory
+ if(-d $dest) {
+ return new KeptFile($src, $self->{OBJEXT}, $dest);
+ } else {
+ return new OutputFile($src, $1);
+ }
+ } else {
+ return new KeptFile($src, $self->{OBJEXT}, '.');
+ }
+ } else {
+# die "compileOutputfile: operation is not TOOBJ";
+ return $self->outputFile($src, $self->{OBJEXT});
+ }
+}
+
+sub assembleOutputFile {
+ my($self, $src) = @_;
+ return $self->compileOutputFile($src);
+}
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+ $src = $src->filename if ref $src;
+ if(defined $self->{OUTARG} && "@{$self->{OUTARG}}" =~ m|/Fe(.+)|) {
+ return $1;
+ }
+ # Use the name of the first source file, in the current directory
+ my ($base, $dir, $ext) = fileparse ($src, "\\.[^.]+");
+ return "./$base.exe";
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "cl 2>&1|") || die "Cannot start Microsoft CL\n";
+ while(<VER>) {
+ if($_ =~ m|Compiler Version (\S+) |) {
+ $cversion = "cl_$1";
+ close(VER);
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find Microsoft CL version\n";
+}
+
+########################################################################
+##
+## MS LINK specific code
+##
+###
+package MSLINK;
+
+use strict;
+
+use File::Basename;
+use Data::Dumper;
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+
+ # Create a MSVC compiler object
+ my $msvc = MSVC->new($stub);
+
+ # Create $self
+
+ my $self =
+ { NAME => 'Microsoft linker',
+ MODENAME => 'MSLINK',
+ CC => $msvc->{CC},
+ CPP => $msvc->{CPP},
+ LD => ['link'],
+ DEFARG => $msvc->{DEFARG},
+ INCARG => $msvc->{INCARG},
+ DEBUGARG => ['/DEBUG'],
+ OPTIMARG => [],
+ LDLIB => ['lib'],
+ OBJEXT => "obj",
+ LIBEXT => "lib", # Library extension (without the .)
+ EXEEXT => ".exe", # Executable extension (with the .)
+ OUTOBJ => $msvc->{OUTOBJ},
+ OUTEXE => "-out:", # Keep this form because build.exe looks for it
+ WARNISERROR => "/WX",
+ LINEPATTERN => "",
+ FORCECSOURCE => $msvc->{FORCECSOURCE},
+
+ MSVC => $msvc,
+
+ OPTIONS =>
+ ["[^/\\-@]" => { TYPE => 'OSOURCE' },
+ "[/\\-](OUT|out):" => { TYPE => 'OUT' },
+ "^((/)|(\\-[^\\-]))" => { TYPE => 'LINK' },
+ ],
+ };
+ bless $self, $class;
+ return $self;
+}
+
+
+sub forceIncludeArg { # Same as for CL
+ my($self, $what) = @_;
+ return "/FI$what";
+}
+
+
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+# print Dumper($self);
+ Carp::confess "Cannot compute the linker output file"
+ if ! defined $self->{OUTARG};
+
+ if("@{$self->{OUTARG}}" =~ m|.+:(.+)|) {
+ return $1;
+ }
+ die "I do not know what is the link output file\n";
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "link 2>&1|") || die "Cannot start Microsoft LINK\n";
+ while(<VER>) {
+ if($_ =~ m|Linker Version (\S+)|) {
+ $cversion = "link_$1";
+ close(VER);
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find Microsoft LINK version\n";
+}
+
+########################################################################
+##
+## MS LIB specific code
+##
+###
+package MSLIB;
+
+our @ISA = qw(MSLINK);
+
+use strict;
+
+use File::Basename;
+use Data::Dumper;
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+
+ # Create a MSVC linker object
+ my $self = MSLINK->new($stub);
+
+ $self->{NAME} = 'Microsoft librarian';
+ $self->{MODENAME} = 'MSLIB';
+ $self->{OPERATION} = "TOLIB";
+ $self->{LDLIB} = ['lib'];
+ bless $self, $class;
+ return $self;
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "lib 2>&1|") || die "Cannot start Microsoft LIB\n";
+ while(<VER>) {
+ if($_ =~ m|Library Manager Version (\S+)|) {
+ $cversion = "lib_$1";
+ close(VER);
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find Microsoft LINK version\n";
+}
+
+########################################################################
+##
+## GNU ar specific code
+##
+###
+package AR;
+
+use strict;
+
+use File::Basename;
+use Data::Dumper;
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+ # Create $self
+
+ my $self =
+ { NAME => 'Archiver',
+ MODENAME => 'ar',
+ CC => ['no_compiler_in_ar_mode'],
+ CPP => ['no_compiler_in_ar_mode'],
+ LDLIB => ['ar', 'crv'],
+ DEFARG => "??DEFARG",
+ INCARG => '??INCARG',
+ DEBUGARG => ['??DEBUGARG'],
+ OPTIMARG => [],
+ OBJEXT => "o",
+ LIBEXT => "a", # Library extension (without the .)
+ EXEEXT => "", # Executable extension (with the .)
+ OUTOBJ => "??OUTOBJ",
+ OUTLIB => "", # But better be first
+ LINEPATTERN => "",
+
+ OPTIONS =>
+ ["^[^-]" => { RUN => \&arArguments } ]
+
+ };
+ bless $self, $class;
+ return $self;
+}
+
+# We handle arguments in a special way for AR
+sub arArguments {
+ my ($self, $arg, $onemore, $pargs) = @_;
+ # If the first argument starts with -- pass it on
+ if($arg =~ m|^--|) {
+ return 0;
+ }
+ # We got here for the first non -- argument.
+ # Will handle all arguments at once
+ if($self->{VERBOSE}) {
+ print "AR called with $arg @{$pargs}\n";
+ }
+
+ #The r flag is required:
+ if($arg !~ m|r| || $#{$pargs} < 0) {
+ die "Error: CCured's AR mode implements only the r and cr operations.";
+ }
+ if($arg =~ /[^crvus]/) {
+ die "Error: CCured's AR mode supports only the c, r, u, s, and v flags.";
+ }
+ if($arg =~ /v/) {
+ $self->{VERBOSE} = 1;
+ }
+
+ if($arg =~ /c/)
+ {
+ # Command is "cr":
+ # Get the name of the library
+ my $out = shift @{$pargs};
+ $self->{OUTARG} = [$out];
+ unlink $out;
+ }
+ else
+ {
+ # if the command is "r" alone, we should add to the current library,
+ # not replace it, unless the library does not exist
+
+ # Get the name of the library
+ my $out = shift @{$pargs};
+ $self->{OUTARG} = [$out];
+
+ #The library is both an input and an output.
+ #To avoid problems with reading and writing the same file, move the
+ #current version of the library out of the way first.
+ if(-f $out) {
+
+ my $temp_name = $out . "_old.a";
+ if($self->{VERBOSE}) {
+ print "Copying $out to $temp_name so we can add "
+ . "to it.\n";
+ }
+ if(-f $temp_name) {
+ unlink $temp_name;
+ }
+ rename $out, $temp_name;
+
+ #now use $temp_name as the input. $self->{OUTARG} will,
+ # as usual, be the output.
+ push @{$self->{OFILES}}, $temp_name;
+ } else {
+ warn "Library $out not found; creating.";
+ }
+
+ }
+
+ # The rest of the arguments must be object files
+ push @{$self->{OFILES}}, @{$pargs};
+ $self->{OPERATION} = 'TOLIB';
+ @{$pargs} = ();
+# print Dumper($self);
+ return 1;
+}
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+ if(defined $self->{OUTARG}) {
+ return "@{$self->{OUTARG}}";
+ }
+ die "I do not know what is the link output file\n";
+}
+
+sub setVersion {
+ # sm: bin/cilly wants this for all "compilers"
+}
+
+
+#########################################################################
+##
+## GNUCC specific code
+##
+package GNUCC;
+
+use strict;
+
+use File::Basename;
+
+# The variable $::cc is inherited from the main script!!
+
+sub new {
+ my ($proto, $stub) = @_;
+ my $class = ref($proto) || $proto;
+ # Create $self
+
+ my @native_cc = Text::ParseWords::shellwords($ENV{CILLY_NATIVE_CC} || $::cc);
+
+ my $self =
+ { NAME => 'GNU CC',
+ MODENAME => 'GNUCC', # do not change this since it is used in code
+ # sm: added -O since it's needed for inlines to be merged instead of causing link errors
+ # sm: removed -O to ease debugging; will address "inline extern" elsewhere
+ CC => [@native_cc, '-D_GNUCC', '-c'],
+ LD => [@native_cc, '-D_GNUCC'],
+ LDLIB => ['ld', '-r', '-o'],
+ CPP => [@native_cc, '-D_GNUCC', '-E'],
+ DEFARG => "-D",
+ INCARG => "-I",
+ DEBUGARG => ['-g', '-ggdb'],
+ OPTIMARG => ['-O4'],
+ CPROFILEARG => '-pg',
+ LPROFILEARG => '-pg',
+ OBJEXT => "o",
+ LIBEXT => "a",
+ EXEEXT => "",
+ OUTOBJ => '-o',
+ OUTEXE => '-o',
+ OUTCPP => '-o',
+ WARNISERROR => "-Werror",
+ FORCECSOURCE => [],
+ LINEPATTERN => "^#\\s+(\\d+)\\s+\"(.+)\"",
+
+ OPTIONS =>
+ [ "[^-].*\\.($::cilbin|c|cpp|cc)\$" => { TYPE => 'CSOURCE' },
+ "[^-].*\\.(s|S)\$" => { TYPE => 'ASMSOURCE' },
+ "[^-].*\\.i\$" => { TYPE => 'ISOURCE' },
+ # .o files can be linker scripts
+ "[^-]" => { RUN => sub { &GNUCC::parseLinkerScript(@_); }},
+ "-E" => { RUN => sub { $stub->{OPERATION} = "TOI"; }},
+ "-pipe\$" => { TYPE => 'ALLARGS' },
+ "-[DIU]" => { ONEMORE => 1, TYPE => "PREPROC" },
+ "-isystem" => { ONEMORE => 1, TYPE => "PREPROC" },
+ '-undef$' => { TYPE => 'PREPROC' },
+ '-w$' => { TYPE => 'PREPROC' },
+ '-M$' => { TYPE => 'SPECIAL' },
+ '-MM$' => { TYPE => 'SPECIAL' },
+ '-MF$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
+ '-C$' => { TYPE => 'EARLY_PREPROC'}, # zra
+ '-MG$' => { TYPE => 'EARLY_PREPROC' },
+ '-MP$' => { TYPE => 'EARLY_PREPROC' },
+ '-MT$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
+ '-MQ$' => { TYPE => 'EARLY_PREPROC', ONEMORE => 1 },
+ '-MD$' => { TYPE => 'EARLY_PREPROC' },
+ '-MMD$' => { TYPE => 'EARLY_PREPROC' },
+ "-include" => { ONEMORE => 1, TYPE => "PREPROC" }, # sm
+ "-iwithprefix" => { ONEMORE => 1, TYPE => "PREPROC" },
+ '-Wp,' => { TYPE => 'PREPROC' },
+ "-ansi" => { TYPE => 'ALLARGS' },
+ "-c" => { RUN => sub { $stub->{OPERATION} = "TOOBJ"; }},
+ "-x" => { ONEMORE => 1, TYPE => "CC" },
+ "-v" => { TYPE => 'ALLARGS',
+ RUN => sub { $stub->{TRACE_COMMANDS} = 1; } },
+ "^-e\$" => { ONEMORE => 1, TYPE => 'LINK' },
+ "^-T\$" => { ONEMORE => 1, TYPE => 'LINK' },
+ # GCC defines some more macros if the optimization is On so pass
+ # the -O to the preprocessor and the compiler
+ '-O' => { TYPE => 'ALLARGS' },
+ "-S" => { RUN => sub { $stub->{OPERATION} = "TOOBJ";
+ push @{$stub->{CCARGS}}, $_[1]; }},
+ "-o" => { ONEMORE => 1, TYPE => 'OUT' },
+ "-p\$" => { TYPE => 'LINKCC' },
+ "-pg" => { TYPE => 'LINKCC' },
+ "-a" => { TYPE => 'LINKCC' },
+ "-pedantic\$" => { TYPE => 'ALLARGS' },
+ "-Wall" => { TYPE => 'CC',
+ RUN => sub { push @{$stub->{CILARGS}},"--warnall";}},
+ "-W[-a-z]*\$" => { TYPE => 'CC' },
+ '-g' => { TYPE => 'ALLARGS' },
+ "-save-temps" => { TYPE => 'ALLARGS',
+ RUN => sub { if(! defined $stub->{SAVE_TEMPS}) {
+ $stub->{SAVE_TEMPS} = '.'; } }},
+ '--?print-' => { TYPE => 'SPECIAL' },
+ '-dump' => { TYPE => 'SPECIAL' },
+ "-l" =>
+ { RUN => sub {
+ my ($libname) = ($_[1] =~ m|-l(.+)$|);
+ # See if we can find this library in the LIBDIR
+ my @libdirs = @{$stub->{LIBDIR}};
+ if($#libdirs == -1) {
+ push @libdirs, '.';
+ }
+ foreach my $d (@libdirs) {
+ if(-f "$d/lib$libname.a") {
+ # Pretend that we had a straight argument
+ push @{$stub->{OFILES}}, "$d/lib$libname.a";
+ return;
+ }
+ }
+ # We get here when we cannot find the library in the LIBDIR
+ push @{$stub->{LINKARGS}}, $_[1];
+ }},
+ "-L" =>
+ { RUN => sub {
+ # Remember these directories in LIBDIR
+ my ($dir) = ($_[1] =~ m|-L(.+)$|);
+ push @{$stub->{LIBDIR}}, $dir;
+ push @{$stub->{LINKARGS}}, $_[1];
+ }},
+ "-f" => { TYPE => 'LINKCC' },
+ "-r\$" => { RUN => sub { $stub->{OPERATION} = "TOLIB"; }},
+ "-i\$" => { RUN => sub { $stub->{OPERATION} = "TOLIB"; }},
+ "-m" => { TYPE => 'LINKCC', ONEMORE => 1 },
+ "-s\$" => { TYPE => 'LINKCC' },
+ "-Xlinker" => { ONEMORE => 1, TYPE => 'LINK' },
+ "-nostdlib" => { TYPE => 'LINK' },
+ "-nostdinc" => { TYPE => 'PREPROC' },
+ '-rdynamic$' => { TYPE => 'LINK' },
+ "-static" => { TYPE => 'LINK' },
+ "-shared" => { TYPE => 'LINK' },
+ "-static-libgcc" => { TYPE => 'LINK' },
+ "-shared-libgcc" => { TYPE => 'LINK' },
+ '-Wl,--(no-)?whole-archive$' => { TYPE => 'OSOURCE' },
+ '-Wl,' => { TYPE => 'LINK' },
+ "-traditional" => { TYPE => 'PREPROC' },
+ '-std=' => { TYPE => 'ALLARGS' },
+ "--start-group" => { RUN => sub { } },
+ "--end-group" => { RUN => sub { }},
+ "-pthread\$" => { TYPE => 'ALLARGS' },
+ ],
+
+ };
+ bless $self, $class;
+ return $self;
+}
+# '
+
+my $linker_script_debug = 0;
+sub parseLinkerScript {
+ my($self, $filename, $onemore, $pargs) = @_;
+
+ if(! defined($self->{FLATTEN_LINKER_SCRIPTS}) ||
+ $filename !~ /\.o$/) {
+ NotAScript:
+ warn "$filename is not a linker script\n" if $linker_script_debug;
+ push @{$self->{OFILES}}, $filename;
+ return 1;
+ }
+ warn "parsing OBJECT FILE:$filename ****************\n" if
+ $linker_script_debug;
+ open OBJFILE, $filename or die $!;
+ my $line = <OBJFILE>;
+ if ($line !~ /^INPUT/) {
+ close OBJFILE or die $!;
+ goto NotAScript;
+ }
+ warn "\tYES an INPUT file.\n" if $linker_script_debug;
+ my @lines = <OBJFILE>; # Read it all and close it
+ unshift @lines, $line;
+ close OBJFILE or die $!;
+ # Process recursively each line from the file
+ my @tokens = ();
+ my $incomment = 0; # Whether we are in a comment
+ foreach my $line (@lines) {
+ chomp $line;
+ if($incomment) {
+ # See where the comment ends
+ my $endcomment = index($line, "*/");
+ if($endcomment < 0) { # No end on this line
+ next; # next line
+ } else {
+ $line = substr($line, $endcomment + 2);
+ $incomment = 0;
+ }
+ }
+ # Drop the comments that are on a single line
+ $line =~ s|/\*.*\*/| |g;
+ # Here if outside comment. See if a comment starts
+ my $startcomment = index($line, "/*");
+ if($startcomment >= 0) {
+ $incomment = 1;
+ $line = substr($line, 0, $startcomment);
+ }
+ # Split the line into tokens. Sicne we use parentheses in the pattern
+ # the separators will be tokens as well
+ push @tokens, split(/([(),\s])/, $line);
+ }
+ print "Found tokens:", join(':', @tokens), "\n"
+ if $linker_script_debug;
+ # Now parse the file
+ my $state = 0;
+ foreach my $token (@tokens) {
+ if($token eq "" || $token =~ /\s+/) { next; } # Skip spaces
+ if($state == 0) {
+ if($token eq "INPUT") { $state = 1; next; }
+ else { die "Error in script: expecting INPUT"; }
+ }
+ if($state == 1) {
+ if($token eq "(") { $state = 2; next; }
+ else { die "Error in script: expecting ( after INPUT"; }
+ }
+ if($state == 2) {
+ if($token eq ")") { $state = 0; next; }
+ if($token eq ",") { next; } # Comma could be a separator
+ # Now we better see a filename
+ if(! -f $token) {
+ warn "Linker script mentions inexistent file:$token.Ignoring\n";
+ next;
+ }
+ # Process it recursively because it could be a script itself
+ warn "LISTED FILE:$token.\n" if $linker_script_debug;
+ $self->parseLinkerScript($token, $onemore, $pargs);
+ next;
+ }
+ die "Invalid linker script parser state\n";
+
+ }
+}
+
+sub forceIncludeArg {
+ my($self, $what) = @_;
+ return ('-include', $what);
+}
+
+
+# Emit a line # directive
+sub lineDirective {
+ my ($self, $fileName, $lineno) = @_;
+ return "# $lineno \"$fileName\"\n";
+}
+
+# The name of the output file
+sub compileOutputFile {
+ my($self, $src) = @_;
+
+ die "objectOutputFile: not a C source file: $src\n"
+ unless $src =~ /\.($::cilbin|c|cc|cpp|i|s|S)$/;
+
+ if ($self->{OPERATION} eq 'TOOBJ') {
+ if (defined $self->{OUTARG}
+ && "@{$self->{OUTARG}}" =~ m|^-o\s*(\S.+)$|) {
+ return new OutputFile($src, $1);
+ } else {
+ return new KeptFile($src, $self->{OBJEXT}, '.');
+ }
+ } else {
+ return $self->outputFile($src, $self->{OBJEXT});
+ }
+}
+
+sub assembleOutputFile {
+ my($self, $src) = @_;
+ return $self->compileOutputFile($src);
+}
+
+sub linkOutputFile {
+ my($self, $src) = @_;
+ if(defined $self->{OUTARG} && "@{$self->{OUTARG}}" =~ m|-o\s*(\S.+)|) {
+ return $1;
+ }
+ return "a.out";
+}
+
+sub setVersion {
+ my($self) = @_;
+ my $cversion = "";
+ open(VER, "@{$self->{CC}} -dumpversion "
+ . join(' ', @{$self->{PPARGS}}) ." |")
+ || die "Cannot start GNUCC";
+ while(<VER>) {
+ if($_ =~ m|^(\d+\S+)| || $_ =~ m|^(egcs-\d+\S+)|) {
+ $cversion = "gcc_$1";
+ close(VER) || die "Cannot start GNUCC\n";
+ $self->{VERSION} = $cversion;
+ return;
+ }
+ }
+ die "Cannot find GNUCC version\n";
+}
+
+1;
+
+
+__END__
+
+
+
diff --git a/cil/lib/KeptFile.pm b/cil/lib/KeptFile.pm
new file mode 100644
index 0000000..904b514
--- /dev/null
+++ b/cil/lib/KeptFile.pm
@@ -0,0 +1,88 @@
+package KeptFile;
+use OutputFile;
+@ISA = (OutputFile);
+
+use strict;
+use Carp;
+use File::Basename;
+use File::Spec;
+
+
+########################################################################
+
+
+sub new {
+ croak 'bad argument count' unless @_ == 4;
+ my ($proto, $basis, $suffix, $dir) = @_;
+ my $class = ref($proto) || $proto;
+
+ $basis = $basis->basis if ref $basis;
+ my ($basename, undef, $basefix) = fileparse($basis, qr{\.[^.]+});
+ my $filename = File::Spec->catfile($dir, "$basename.$suffix");
+
+ my $self = $class->SUPER::new($basis, $filename);
+ return $self;
+}
+
+
+########################################################################
+
+
+1;
+
+__END__
+
+
+=head1 Name
+
+KeptFile - persistent compiler output files
+
+=head1 Synopsis
+
+ use KeptFile;
+
+ my $cppOut = new KeptFile ('code.c', 'i', '/output/directory');
+ system 'cpp', 'code.c', '-o', $cppOut->filename;
+
+=head2 Description
+
+C<KeptFile> represents an intermediate output file generated by some
+stage of a C<Cilly>-based compiler that should be retained after
+compilation. It is a concrete subclass of L<OutputFile|OutputFile>.
+Use C<KeptFile> when the user has asked for intermediate files to be
+retained, such as via gcc's C<-save-temps> flag.
+
+=head2 Public Methods
+
+=over
+
+=item new
+
+C<new KeptFile ($basis, $suffix, $dir)> constructs a new C<KeptFile>
+instance. The new file name is constructed using the base file name
+of C<$basis> with its suffix replaced by C<$suffix> and its path given
+by C<$dir>. For example,
+
+ new KeptFile ('/foo/code.c', 'i', '/bar')
+
+yields a C<KeptFile> with file name F</bar/code.i>.
+
+C<$basis> may be either absolute or relative; only the trailing file
+name is used. C<$basis> can also be an C<OutputFile> instance, in
+which case C<< $basis->basis >> is used as the actual basis. See
+L<OutputFile/"basis"> for more information on basis flattening.
+
+C<$suffix> should not include a leading dot; this will be added
+automatically.
+
+C<$dir> may be either absolute or relative. It is common to use F<.>
+as the directory, which puts the C<KeptFile> in the current working
+directory.
+
+=back
+
+=head1 See Also
+
+L<OutputFile>, L<TempFile>.
+
+=cut
diff --git a/cil/lib/OutputFile.pm b/cil/lib/OutputFile.pm
new file mode 100644
index 0000000..8f02ba2
--- /dev/null
+++ b/cil/lib/OutputFile.pm
@@ -0,0 +1,213 @@
+package OutputFile;
+@ISA = ();
+
+use strict;
+use Carp;
+use File::Basename;
+use File::Spec;
+
+
+########################################################################
+
+
+my $debug = 0;
+
+
+sub new {
+ croak 'bad argument count' unless @_ == 3;
+ my ($proto, $basis, $filename) = @_;
+ my $class = ref($proto) || $proto;
+
+ $basis = $basis->basis if ref $basis;
+ my $ref = { filename => $filename,
+ basis => $basis };
+ my $self = bless $ref, $class;
+
+ $self->checkRef($filename);
+ $self->checkRef($basis);
+ $self->checkProtected();
+ $self->checkTemporary();
+
+ Carp::cluck "OutputFile: filename == $filename, basis == $basis" if $debug;
+ return $self;
+}
+
+
+sub filename {
+ my ($self) = @_;
+ return $self->{filename};
+}
+
+
+sub basis {
+ my ($self) = @_;
+ return $self->{basis};
+}
+
+
+########################################################################
+
+
+sub checkRef {
+ my ($self, $filename) = @_;
+ confess "ref found where string expected: $filename" if ref $filename;
+ confess "stringified ref found where string expected: $filename" if $filename =~ /\w+=HASH\(0x[0-9a-f]+\)/;
+}
+
+
+sub checkTemporary {
+ my ($self) = @_;
+ my ($basename, $path) = fileparse $self->filename;
+ return if $path eq File::Spec->tmpdir . '/';
+ confess "found temporary file in wrong directory: ", $self->filename
+ if $basename =~ /^cil-[a-zA-Z0-9]{8}\./;
+}
+
+
+########################################################################
+
+
+my @protected = ();
+
+
+sub checkProtected {
+ my ($self) = @_;
+ my $abs = File::Spec->rel2abs($self->filename);
+
+ foreach (@protected) {
+ confess "caught attempt to overwrite protected file: ", $self->filename
+ if $_ eq $abs;
+ }
+}
+
+
+sub protect {
+ my ($self, @precious) = @_;
+ push @protected, File::Spec->rel2abs($_)
+ foreach @precious;
+}
+
+
+########################################################################
+
+
+1;
+
+__END__
+
+
+=head1 Name
+
+OutputFile - base class for intermediate compiler output files
+
+=head1 Description
+
+C<OutputFile> represents an intermediate output file generated by some
+stage of a C<Cilly>-based compiler. This is an abstract base class
+and should never be instantiated directly. It provides common
+behaviors used by concrete subclasses L<KeptFile|KeptFile> and
+L<TempFile|TempFile>.
+
+=head2 Public Methods
+
+=over
+
+=item filename
+
+An C<OutputFile> instance is a smart wrapper around a file name. C<<
+$out->filename >> returns the name of the file represented by
+C<OutputFile> instance C<$out>. When building a command line, this is
+the string to use for the file. For example:
+
+ my $out = ... ; # some OutputFile subclass
+ my @argv = ('gcc', '-E', '-o', $out->filename, 'input.c');
+ system @argv;
+
+C<Cilly> often creates command vectors with a mix of strings and
+C<OutputFile> objects. This is fine, but before using a mixed vector
+as a command line, you must replace all C<OutputFile> objects with
+their corresponding file names:
+
+ my @mixed = (...); # mix of strings and objects
+ my @normalized = @mixed;
+ $_ = (ref $_ ? $_->filename : $_) foreach @normalized;
+ system @normalized;
+
+Common utility methods like C<Cilly::runShell> already do exactly this
+normalization, but you may need to do it yourself if you are running
+external commands on your own.
+
+=item protect
+
+C<OutputFile> contains safety interlocks that help it avoid stomping
+on user input files. C<< OutputFile->protect($precious) >> marks
+C<$precious> as a protected input file which should not be
+overwritten. If any C<OutputFile> tries to claim this same file name,
+an error will be raised. In theory, this never happens. In practice,
+scripts can have bugs, and it's better to be safe than sorry.
+
+C<Cilly> uses this method to register input files that it discovers
+during command line processing. If you add special command line
+processing of your own, or if you identify input files through other
+means, we highly recommend using this method as well. Otherwise,
+there is some risk that a buggy client script could mistakenly create
+an output file that destroys the user's source code.
+
+Note that C<protect> is a class method: call it on the C<OutputFile>
+module, rather than on a specific instance.
+
+=back
+
+=head2 Internal Methods
+
+The following methods are used within C<OutputFile> or by
+C<OutputFile> subclasses. They are not intended for use by outside
+scripts.
+
+=over
+
+=item basis
+
+In addition to L<its own file name|/"filename">, each C<OutputFile>
+instance records a second file name: its I<basis>. The basis file
+name is initialized and used differently by different subclasses, but
+typically represents the input file from which this output file is
+derived. C<< $out->basis >> returns the basis file name for instance
+C<$out>.
+
+When instantiating an C<OutputFile>, the caller can provide either a
+file name string as the basis or another C<OutputFile> instance.
+However, basis file names are not chained: if C<< $a->basis >> is
+F<foo.c>, and C<$b> is constructed with C<$a> as its basis, C<<
+$b->basis >> will return F<foo.c>, not C<$a> or C<< $a->filename >>.
+This flattening is done at construction time.
+
+See L<KeptFile/"new"> and L<TempFile/"new"> for more details on how
+basis file names are used.
+
+=item checkRef
+
+C<< OutputFile->checkRef($filename) >> raises an error if C<$filename>
+is an object reference, or looks like the string representation of an
+object reference. Used to sanity check arguments to various methods.
+
+=item checkTemporary
+
+C<< $out->checkTemporary >> raises an error if C<< $out->filename >>
+looks like a temporary file name but is not in the system temporary
+directory. Used to sanity check arguments in various methods.
+
+=item checkProtected
+
+C<< $out->checkProtected >> raises an error if C<< $out->filename >>
+is listed as a protected file. This check, performed at construction
+time, implements a safety interlock to prevent overwriting of user
+input files. Protected files are registered using L<"protect">.
+
+=back
+
+=head1 See Also
+
+L<KeptFile>, L<TempFile>.
+
+=cut
diff --git a/cil/lib/TempFile.pm b/cil/lib/TempFile.pm
new file mode 100644
index 0000000..608713c
--- /dev/null
+++ b/cil/lib/TempFile.pm
@@ -0,0 +1,90 @@
+package TempFile;
+use OutputFile;
+@ISA = (OutputFile);
+
+use strict;
+use Carp;
+use File::Temp qw(tempfile);
+
+
+########################################################################
+
+
+sub new {
+ croak 'bad argument count' unless @_ == 3;
+ my ($proto, $basis, $suffix) = @_;
+ my $class = ref($proto) || $proto;
+
+ my (undef, $filename) = tempfile('cil-XXXXXXXX',
+ DIR => File::Spec->tmpdir,
+ SUFFIX => ".$suffix",
+ UNLINK => 1);
+
+ my $self = $class->SUPER::new($basis, $filename);
+ return $self;
+}
+
+
+########################################################################
+
+
+1;
+
+__END__
+
+
+=head1 Name
+
+TempFile - transitory compiler output files
+
+=head1 Synopsis
+
+ use TempFile;
+
+ my $cppOut = new TempFile ('code.c', 'i');
+ system 'cpp', 'code.c', '-o', $cppOut->filename;
+
+=head2 Description
+
+C<TempFile> represents an intermediate output file generated by some
+stage of a C<Cilly>-based compiler that should be removed after
+compilation. It is a concrete subclass of L<OutputFile|OutputFile>.
+Use C<TempFile> when the user has asked not for intermediate files to
+be retained.
+
+All C<TempFile> files are removed when the script terminates. This
+cleanup happens for both normal exits as well as fatal errors.
+However, the standard L<Perl exec function|perlfun/exec> does not
+perform cleanups, and therefore should be avoided in scripts that use
+C<TempFile>.
+
+=head2 Public Methods
+
+=over
+
+=item new
+
+C<new TempFile ($basis, $suffix)> constructs a new C<TempFile>
+instance. The new file name is constructed in some system-specific
+temporary directory with a randomly generated file name that ends with
+C<$suffix>. For example,
+
+ new TempFile ('/foo/code.c', 'i')
+
+might yield a C<TempFile> with file name F</var/tmp/cil-x9GyA93R.i>.
+
+C<$basis> gives the basis file name for this instance. The file name
+is not used directly, but is retained in case this instance is later
+passed as the basis for some other C<OutputFile>. See
+L<OutputFile/"basis"> for more information on basis flattening.
+
+C<$suffix> should not include a leading dot; this will be added
+automatically.
+
+=back
+
+=head1 See Also
+
+L<OutputFile>, L<TempFile>.
+
+=cut
diff --git a/cil/ocamlutil/Makefile.ocaml b/cil/ocamlutil/Makefile.ocaml
new file mode 100644
index 0000000..1d0673f
--- /dev/null
+++ b/cil/ocamlutil/Makefile.ocaml
@@ -0,0 +1,395 @@
+# -*- Mode: makefile -*-
+# Copyright (c) 2001-2002,
+# George C. Necula <necula@cs.berkeley.edu>
+# Scott McPeak <smcpeak@cs.berkeley.edu>
+# Wes Weimer <weimer@cs.berkeley.edu>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# 3. The names of the contributors may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+ # Generic Makefile for Ocaml projects
+ # Written by necula@cs.berkeley.edu
+ #
+ # Features:
+ # - keeps byproducts of building in a separate directory
+ # - handles dependencies automatically
+ # - user specifies just what modules go into a project and
+ # everything else is done automatically
+ # - you can use one Makefile for several Ocaml projects
+ #
+ # You must include this file in your Makefile. Before the include point
+ # you must defined the following variables (which are glob al for all Ocaml
+ # projects specified in one Makefile):
+ #
+ # CAMLDIR - the directory where to get the ocaml executables from.
+ # Must be empty (defaul) or end with a /
+ # OBJDIR - the directory where to put all object files. This directory
+ # must exist (default obj)
+ # DEPENDDIR - the directory where to put dependency files. This directory
+ # must exist. (default obj/.depend)
+ # NATIVECAML - if set then will use the native compiler
+ # UNSAFE - if set then will turn off safety checks (only with NATIVECAML)
+ # PROFILE - if set then it will compile and link with "gprof" profiling
+ # support (NATIVECAML mode only)
+ # ASSEMBLY - if set then it will keep assembly files
+ # STATIC - if set then it will compile and link statically
+ # (NATIVECAML mode only)
+ # PREPROC - the preprocessor command
+
+ # MODULES - a list of all modules for all projects defined in the
+ # Makefile. Give only the basenames (no directory,
+ # no extension). This is used to create the dependencies.
+ # SOURCEDIRS - a list of all directories containing sources for all
+ # projects defined in a Makefile. This is used to set vpath.
+ # MLLS - a list of all .mll (ocamllex input) files for all
+ # projects defined in the Makefile.
+ # MLYS - a list of all .mly (ocamlyacc input) files for all
+ # projects defined in the Makefile.
+ # ECHO - if specifically set to nothing then it will print
+ # all of the commands issued. Set this in the command line
+ # if you want to see what is going on.
+ #
+ # COMPILEFLAGS - if defined, then it is passed as argument to ocamlc
+ # and ocamlopt
+ # LINKFLAGS - if defined, then it is passed as argument to
+ # ocamlc and ocamlopt, when linking (at start of
+ # command line)
+ #
+ # CAML_CFLAGS - flags used only for the compilation of C files.
+ # e.g. '-ccopt <gcc flag>'
+ #
+ #
+ # After you set all of the above you must do the following for EACH separate
+ # executable that you want to build.
+ #
+ # Define the following:
+ # PROJECT_EXECUTABLE - the name of the executable you want to build. To take
+ # advantage of the naming scheme that separates the
+ # bytecode version and the native version, use the
+ # $(EXE) variable which is defined to either .byte.exe
+ # or .asm.exe. I typically put the executable in
+ # $(OBJDIR) as well.
+ # PROJECT_MODULES - the base names of the modules that make this
+ # executable in the order in which they must be
+ # passed to the linker. Make sure that all of
+ # the names mentioned here are also mentioned in
+ # MODULES.
+ # PROJECT_CMODULES - same as modules but for the C modules. These
+ # do not need to be mentioned in MODULES. There must be
+ # no name clashes with MODULES
+ # PROJECT_LIBS - the base names of the libraries that you
+ # want to link in the executable.
+ #
+ #
+ # Then include Makefile.ocaml.build to generate a customized
+ # rule for making your executable.
+ #
+ # Example:
+ #
+ # OBJDIR = obj
+ # DEPENDDIR = obj/.depend
+ # SOURCEDIRS = src src/special
+ # MLLS = mylex
+ # MLYS = myparse
+ #
+ # MODULES = mod11 mod12 mod21 modcommon
+ #
+ # # Rules for project 1
+ # PROJECT_EXECUTABLE = $(OBJDIR)/proj1$(EXE)
+ # PROJECT_MODULES = mod11 mod12 modcommon
+ # PROJECT_CMODULES =
+ # PROJEC_LIBS = unix
+ # include Makefile.ocaml.build
+ #
+ #
+ # # Rules for project 2
+ # PROJECT_EXECUTABLE = $(OBJDIR)/proj2$(EXE)
+ # PROJECT_MODULES = mod21 modcommon
+ # PROJECT_CMODULES =
+ # PROJEC_LIBS = unix str
+ # include Makefile.ocaml.build
+
+
+CAMLLEX = ocamllex
+CAMLYACC= ocamlyacc -v
+CAMLDEP = ocamldep
+
+COMPILEFLAGS += -I $(OBJDIR)
+
+# sm: two styles for echoing compilation progress:
+# style 1, by George:
+# - print English descriptions of what's happening
+# - set ECHO to "" to see *everything*
+# style 2, by Scott:
+# - do not print English descriptions
+# - print every shell command that is executed which has a side effect,
+# so that they could be pasted into a shell to reproduce manually
+# - omit some of the details of dependency generation
+#
+# to be able to choose which style, several variables are used:
+# @$(NARRATIVE) - put this before English descriptions for style 1
+# @$(COMMAND) - put this before shell commands which are to be
+# printed for style 2; the command is *not* executed
+# $(AT) - put this before shell commands which are to be executed,
+# and also printed in style 2
+# $(ECHO) - use in place of '@' for things not printed in either style
+ifdef ECHOSTYLE_SCOTT
+ # 'true' silently consumes its arguments, whereas 'echo' prints them
+ NARRATIVE := true
+ COMMAND := echo
+ AT :=
+ ECHO := @
+else
+ NARRATIVE := echo
+ COMMAND := true
+ # change these next two definitions to <empty> to echo everything,
+ # or leave as @ to suppress echoing
+ AT := @
+ ECHO := @
+endif
+
+ifdef PREPROC
+ COMPILEFLAGS += -pp "$(PREPROC)$"
+ DEPFLAGS += -pp "$(PREPROC)"
+endif
+
+COMPILEMSG=
+LINKMSG=
+
+ifdef WIN32
+OBJ = obj
+else
+OBJ = o
+endif
+EXE = $(EXEEXT).exe
+
+
+export EXE
+
+ifdef NATIVECAML
+ ifdef PROFILE
+ COMPILEFLAGS += -p
+ LINKFLAGS += -p
+ COMPILEMSG += (profile)
+ LINKMSG += (profile)
+ endif
+ ifdef ASSEMBLY
+ COMPILEFLAGS += -S
+ endif
+ ifdef STATIC
+ COMPILEFLAGS += -ccopt -static
+ LINKFLAGS += -ccopt -static
+ endif
+ #foo := $(shell echo "I am in NATIVECAML mode" >&2; echo whatever)
+ ifdef WIN32
+ COMPILEFLAGS += -ccopt /Ox
+ else
+ COMPILEFLAGS += -ccopt -O3
+ endif
+ CAMLC = $(CAMLDIR)ocamlopt $(COMPILEFLAGS)
+ CAMLLINK = $(CAMLDIR)ocamlopt $(LINKFLAGS)
+ CMO = cmx
+ CMC = opt.$(OBJ) # compiled (and optimized) C
+ CMXA = cmxa
+ EXEEXT = .asm
+ MOVEAFTERCAMLC = cmi cmx $(OBJ)
+ COMPILETOWHAT = native code
+ # sm: by adding -native in native mode, we prevent spurious
+ # dependencies on .cmo files which were causing lots of
+ # extra recompilation
+ CAMLDEP = $(CAMLDIR)ocamldep -native
+else
+ CMO = cmo
+ CMXA = cma
+ CMC = $(OBJ)
+ EXEEXT = .byte
+ MOVEAFTERCAMLC = cmi cmo
+ COMPILETOWHAT = bytecode
+ ifdef WIN32
+ COMPILEFLAGS += -ccopt /Zi -ccopt /Od
+ LINKFLAGS += -ccopt /Zi -ccopt /Od
+ else
+ COMPILEFLAGS += -g -ccopt -g
+ LINKFLAGS += -g -ccopt -g
+ endif
+ CAMLC = $(CAMLDIR)ocamlc -g $(COMPILEFLAGS)
+ CAMLLINK = $(CAMLDIR)ocamlc -custom $(LINKFLAGS)
+endif
+
+
+ifdef UNSAFE
+ CAMLC := $(CAMLC) -unsafe -noassert
+endif
+
+
+
+
+ # Allow searching for .ml and .mli
+vpath %.mll $(SOURCEDIRS)
+vpath %.mly $(SOURCEDIRS)
+vpath %.ml $(SOURCEDIRS) $(OBJDIR)
+vpath %.mli $(SOURCEDIRS) $(OBJDIR)
+vpath %.c $(SOURCEDIRS)
+
+
+# Secondaries are intermediates that we don't want make to delete
+# By giving the right names to secondary files we tell make where to make
+# them if they are not already made. VERY USEFUL!!
+.SECONDARY : $(MLLS:%.mll=$(OBJDIR)/%.ml) $(MLYS:%.mly=$(OBJDIR)/%.ml) \
+ $(MLYS:%.mly=$(OBJDIR)/%.mli)
+
+ # Run the lexer generator
+ # Move the result to the OBJDIR directory
+ # If there is a .mli file in the same directory with .mll then
+ # copy it to OBJDIR (where the .ml) file will live.
+$(OBJDIR)/%.ml: %.mll
+ $(CAMLLEX) $<
+ $(AT)mv -f $(basename $<).ml $(OBJDIR)/
+ $(ECHO)if test -f $(basename $<).mli ;then \
+ $(COMMAND) cp -f $(basename $<).mli $(OBJDIR)/; \
+ cp -f $(basename $<).mli $(OBJDIR)/ \
+ ;fi
+
+ # Run the parser generator
+ # Move the result to the $(OBJDIR) directory.
+$(OBJDIR)/%.ml $(OBJDIR)/%.mli: %.mly
+ $(CAMLYACC) $(CAMLYACCFLAGS) $<
+ $(AT)mv -f $(basename $<).ml $(basename $<).mli $(OBJDIR)/
+
+ # Compile an MLI file. After compilation move the result to OBJDIR
+$(OBJDIR)/%.cmi: %.mli
+ @$(NARRATIVE) Compiling interface $<
+ $(AT)$(CAMLC) $(COMPILEFLAGS) -c $<
+ $(ECHO)if test $(OBJDIR) != $(<D) ;then \
+ $(COMMAND) mv -f $(basename $<).cmi $(OBJDIR)/; \
+ mv -f $(basename $<).cmi $(OBJDIR)/ \
+ ;fi
+
+ # Compile an ML file. After compilation we
+ # copy to $(OBJDIR) the .cmi and the result of compilation.
+$(OBJDIR)/%.$(CMO): %.ml
+ @$(NARRATIVE) "Compiling $< to $(COMPILETOWHAT) $(COMPILEMSG)"
+# $(ECHO)#if test $(OBJDIR) != $(<D) -a -f $(OBJDIR)/$(basename $(<F)).cmi ;then \
+# $(COMMAND) mv -f $(OBJDIR)/$(basename $(<F)).cmi $(<D); \
+# mv -f $(OBJDIR)/$(basename $(<F)).cmi $(<D); \
+# fi
+ @$(COMMAND) $(CAMLC) $(COMPILEFLAGS) -c $<
+ $(ECHO)$(CAMLC) $(COMPILEFLAGS) -c $< ; res=$$?; \
+ if test $(OBJDIR) != $(<D) ;then \
+ for ext in $(MOVEAFTERCAMLC); do \
+ if test -f $(basename $<).$$ext ;then \
+ $(COMMAND) mv -f $(basename $<).$$ext $(OBJDIR)/; \
+ mv -f $(basename $<).$$ext $(OBJDIR)/; \
+ fi; \
+ done; \
+ fi; exit $$res
+
+ # Compile C files
+ # They appear to be left in the current directory as .o files
+$(OBJDIR)/%.$(CMC): %.c
+ @$(NARRATIVE) "Compiling C file $< $(COMPILEMSG)"
+ $(AT)$(CAMLC) $(COMPILEFLAGS) $(CAML_CFLAGS) -c $< -o $@
+ $(AT)mv -f $(basename $(notdir $<)).$(OBJ) $@
+
+ # Special rule for profile.c
+CAMLC_NOPROF=$(subst -p,,$(CAMLC))
+$(OBJDIR)/profile.$(CMC): profile.c
+ @$(NARRATIVE) "Compiling C file $<"
+ $(AT)$(CAMLC_NOPROF) $(COMPILEFLAGS) $(CAML_CFLAGS) -c $< -o $@
+ $(AT)mv -f $(basename $(notdir $<)).$(OBJ) $@
+
+
+# Phonies should be "remade" even if someone mistakenly creates them
+.PHONY: cleancaml
+cleancaml:
+ -rm -f $(OBJDIR)/*.cmi
+ -rm -f $(OBJDIR)/*.cmo
+ -rm -f $(OBJDIR)/*.cmx
+ -rm -f $(OBJDIR)/*.cma
+ -rm -f $(OBJDIR)/*.cmxa
+ -rm -f $(OBJDIR)/*.exe
+ -rm -f $(OBJDIR)/*.obj
+ -rm -f $(OBJDIR)/*.o
+ -rm -f $(OBJDIR)/*.obj
+ -rm -f $(OBJDIR)/*.o
+ -rm -f $(OBJDIR)/*.lib
+ -rm -f $(OBJDIR)/*.a
+ -rm -f $(OBJDIR)/*.mli
+ -rm -f $(OBJDIR)/*.ml
+ -rm -f $(DEPENDDIR)/*.d $(DEPENDDIR)/*.di
+ -rm -f $(MLLS:%.mll=$(OBJDIR)/%.ml) \
+ $(MLLS:%.mll=$(OBJDIR)/%.mli) \
+ $(MLYS:%.mly=$(OBJDIR)/%.ml) \
+ $(MLYS:%.mly=$(OBJDIR)/%.mli)
+
+
+# Automatic dependency generation (see GNU info for details)
+#
+# Each .ml file has a .d (dependency file) which is automatically
+# generated and included by the rules below. The perl script replaces
+# directory paths with $(OBJDIR)/
+#
+# Dependencies for .mli files reside in corresponding .di files.
+#
+
+# Replace the directories in the dependency rules with $(OBJDIR)/, since
+# we'll move .cmo/.cmx files there.
+# 1. Strip any text followed by / or \. The / case even strips slashes that
+# are preceded by whitespace, to account for unix absolute paths.
+# The \ case does not strip slashes that come immediately after whitespace,
+# to preserve the trailing \ at the end of Makefile rules.
+# 2. Replace these directory names by '$(OBJDIR)/'
+FIXDEPEND:=perl -e 'while(<>) { s%[^/\\ :]*/% %g; s%[^/\\ :]+\\% %g; s%([-a-zA-Z0-9+-.:/\/_]+)%\$$(OBJDIR)/$$1%g; print $$_;}'
+# FIXDEPEND:=cat
+
+DEPINCLUDES= -I $(OBJDIR) $(SOURCEDIRS:%=-I %)
+$(DEPENDDIR)/%.d: %.ml
+ @$(NARRATIVE) Generating dependency information for $<
+ @$(COMMAND) $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $<
+ $(ECHO)$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $< | $(FIXDEPEND) > $@
+
+$(DEPENDDIR)/%.di: %.mli
+ @$(NARRATIVE) Generating dependency information for $<
+ @$(COMMAND) $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $<
+ $(ECHO)$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $< | $(FIXDEPEND) > $@
+
+# sm: it turns out there's a variable which lists all the goals
+# specified on the command line; I'll use this to set CLEANING
+# (which is not set anywhere else, currently)
+ifeq ($(MAKECMDGOALS),clean)
+ #$(warning "Skipping dependency rules because we're cleaning")
+ CLEANING := 1
+endif
+
+ifndef CLEANING
+-include $(MODULES:%=$(DEPENDDIR)/%.d)
+-include $(MODULES:%=$(DEPENDDIR)/%.di)
+endif
+
+listmodules:
+ @echo $(MODULES)
diff --git a/cil/ocamlutil/Makefile.ocaml.build b/cil/ocamlutil/Makefile.ocaml.build
new file mode 100644
index 0000000..5271e46
--- /dev/null
+++ b/cil/ocamlutil/Makefile.ocaml.build
@@ -0,0 +1,50 @@
+# -*- Mode: makefile -*-
+# Copyright (c) 2001-2002,
+# George C. Necula <necula@cs.berkeley.edu>
+# Scott McPeak <smcpeak@cs.berkeley.edu>
+# Wes Weimer <weimer@cs.berkeley.edu>
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# 3. The names of the contributors may not be used to endorse or promote
+# products derived from this software without specific prior written
+# permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+# IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+# TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+# OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+ # Auxiliary Makefile for building Ocaml project. See the documentation in
+ # the associated Makefile.ocaml for how to use this file.
+ # Written by necula@cs.berkeley.edu
+ #
+$(PROJECT_EXECUTABLE) : $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \
+ $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC))
+ @$(NARRATIVE) "Linking $(COMPILETOWHAT) $@ $(LINKMSG)"
+ $(AT)$(CAMLLINK) -verbose -o $@ \
+ $(PROJECT_LIBS:%=%.$(CMXA)) \
+ $(PROJECT_LIBS:%=-cclib -l%) \
+ $^
+
+
+
+
+
diff --git a/cil/ocamlutil/alpha.ml b/cil/ocamlutil/alpha.ml
new file mode 100755
index 0000000..6a1ea01
--- /dev/null
+++ b/cil/ocamlutil/alpha.ml
@@ -0,0 +1,156 @@
+module H = Hashtbl
+module E = Errormsg
+open Pretty
+
+let debugAlpha (prefix: string) = false
+(*** Alpha conversion ***)
+let alphaSeparator = "___"
+let alphaSeparatorLen = String.length alphaSeparator
+
+(** For each prefix we remember the next integer suffix to use and the list
+ * of suffixes, each with some data assciated with the newAlphaName that
+ * created the suffix. *)
+type 'a alphaTableData = int * (string * 'a) list
+
+type 'a undoAlphaElement =
+ AlphaChangedSuffix of 'a alphaTableData ref * 'a alphaTableData (* The
+ * reference that was changed and
+ * the old suffix *)
+ | AlphaAddedSuffix of string (* We added this new entry to the
+ * table *)
+
+(* Create a new name based on a given name. The new name is formed from a
+ * prefix (obtained from the given name by stripping a suffix consisting of
+ * the alphaSeparator followed by only digits), followed by alphaSeparator
+ * and then by a positive integer suffix. The first argument is a table
+ * mapping name prefixes to the largest suffix used so far for that
+ * prefix. The largest suffix is one when only the version without suffix has
+ * been used. *)
+let rec newAlphaName ~(alphaTable: (string, 'a alphaTableData ref) H.t)
+ ~(undolist: 'a undoAlphaElement list ref option)
+ ~(lookupname: string)
+ ~(data: 'a) : string * 'a =
+ alphaWorker ~alphaTable:alphaTable ~undolist:undolist
+ ~lookupname:lookupname ~data:data true
+
+
+(** Just register the name so that we will not use in the future *)
+and registerAlphaName ~(alphaTable: (string, 'a alphaTableData ref) H.t)
+ ~(undolist: 'a undoAlphaElement list ref option)
+ ~(lookupname: string)
+ ~(data: 'a) : unit =
+ ignore (alphaWorker ~alphaTable:alphaTable ~undolist:undolist
+ ~lookupname:lookupname ~data:data false)
+
+
+and alphaWorker ~(alphaTable: (string, 'a alphaTableData ref) H.t)
+ ~(undolist: 'a undoAlphaElement list ref option)
+ ~(lookupname: string) ~(data:'a)
+ (make_new: bool) : string * 'a =
+ let prefix, suffix, (numsuffix: int) = splitNameForAlpha ~lookupname in
+ if debugAlpha prefix then
+ ignore (E.log "Alpha worker: prefix=%s suffix=%s (%d) create=%b. "
+ prefix suffix numsuffix make_new);
+ let newname, (olddata: 'a) =
+ try
+ let rc = H.find alphaTable prefix in
+ let max, suffixes = !rc in
+ (* We have seen this prefix *)
+ if debugAlpha prefix then
+ ignore (E.log " Old max %d. Old suffixes: @[%a@]" max
+ (docList
+ (fun (s, l) -> dprintf "%s" (* d_loc l *) s)) suffixes);
+ (* Save the undo info *)
+ (match undolist with
+ Some l -> l := AlphaChangedSuffix (rc, !rc) :: !l
+ | _ -> ());
+
+ let newmax, newsuffix, (olddata: 'a), newsuffixes =
+ if numsuffix > max then begin
+ (* Clearly we have not seen it *)
+ numsuffix, suffix, data,
+ (suffix, data) :: suffixes
+ end else begin
+ match List.filter (fun (n, _) -> n = suffix) suffixes with
+ [] -> (* Not found *)
+ max, suffix, data, (suffix, data) :: suffixes
+ | [(_, l) ] ->
+ (* We have seen this exact suffix before *)
+ if make_new then
+ let newsuffix = alphaSeparator ^ (string_of_int (max + 1)) in
+ max + 1, newsuffix, l, (newsuffix, data) :: suffixes
+ else
+ max, suffix, data, suffixes
+ | _ -> E.s (E.bug "Cil.alphaWorker")
+ end
+ in
+ rc := (newmax, newsuffixes);
+ prefix ^ newsuffix, olddata
+ with Not_found -> begin (* First variable with this prefix *)
+ (match undolist with
+ Some l -> l := AlphaAddedSuffix prefix :: !l
+ | _ -> ());
+ H.add alphaTable prefix (ref (numsuffix, [ (suffix, data) ]));
+ if debugAlpha prefix then ignore (E.log " First seen. ");
+ lookupname, data (* Return the original name *)
+ end
+ in
+ if debugAlpha prefix then
+ ignore (E.log " Res=: %s \n" newname (* d_loc oldloc *));
+ newname, olddata
+
+(* Strip the suffix. Return the prefix, the suffix (including the separator
+ * and the numeric value, possibly empty), and the
+ * numeric value of the suffix (possibly -1 if missing) *)
+and splitNameForAlpha ~(lookupname: string) : (string * string * int) =
+ let len = String.length lookupname in
+ (* Search backward for the numeric suffix. Return the first digit of the
+ * suffix. Returns len if no numeric suffix *)
+ let rec skipSuffix (i: int) =
+ if i = -1 then -1 else
+ let c = Char.code (String.get lookupname i) - Char.code '0' in
+ if c >= 0 && c <= 9 then
+ skipSuffix (i - 1)
+ else (i + 1)
+ in
+ let startSuffix = skipSuffix (len - 1) in
+
+ if startSuffix >= len (* No digits at all at the end *) ||
+ startSuffix <= alphaSeparatorLen (* Not enough room for a prefix and
+ * the separator before suffix *) ||
+ (* Suffix starts with a 0 and has more characters after that *)
+ (startSuffix < len - 1 && String.get lookupname startSuffix = '0') ||
+ alphaSeparator <> String.sub lookupname
+ (startSuffix - alphaSeparatorLen)
+ alphaSeparatorLen
+ then
+ (lookupname, "", -1) (* No valid suffix in the name *)
+ else
+ (String.sub lookupname 0 (startSuffix - alphaSeparatorLen),
+ String.sub lookupname (startSuffix - alphaSeparatorLen)
+ (len - startSuffix + alphaSeparatorLen),
+ int_of_string (String.sub lookupname startSuffix (len - startSuffix)))
+
+
+let getAlphaPrefix ~(lookupname:string) : string =
+ let p, _, _ = splitNameForAlpha ~lookupname:lookupname in
+ p
+
+(* Undoes the changes as specified by the undolist *)
+let undoAlphaChanges ~(alphaTable: (string, 'a alphaTableData ref) H.t)
+ ~(undolist: 'a undoAlphaElement list) =
+ List.iter
+ (function
+ AlphaChangedSuffix (where, old) ->
+ where := old
+ | AlphaAddedSuffix name ->
+ if debugAlpha name then
+ ignore (E.log "Removing %s from alpha table\n" name);
+ H.remove alphaTable name)
+ undolist
+
+let docAlphaTable () (alphaTable: (string, 'a alphaTableData ref) H.t) =
+ let acc : (string * (int * (string * 'a) list)) list ref = ref [] in
+ H.iter (fun k d -> acc := (k, !d) :: !acc) alphaTable;
+ docList ~sep:line (fun (k, (d, _)) -> dprintf " %s -> %d" k d) () !acc
+
diff --git a/cil/ocamlutil/alpha.mli b/cil/ocamlutil/alpha.mli
new file mode 100755
index 0000000..e1e430d
--- /dev/null
+++ b/cil/ocamlutil/alpha.mli
@@ -0,0 +1,50 @@
+(** {b ALPHA conversion} *)
+
+(** This is the type of the elements that are recorded by the alpha
+ * conversion functions in order to be able to undo changes to the tables
+ * they modify. Useful for implementing
+ * scoping *)
+type 'a undoAlphaElement
+
+(** This is the type of the elements of the alpha renaming table. These
+ * elements can carry some data associated with each occurrence of the name. *)
+type 'a alphaTableData
+
+
+(** Create a new name based on a given name. The new name is formed from a
+ * prefix (obtained from the given name by stripping a suffix consisting of _
+ * followed by only digits), followed by a special separator and then by a
+ * positive integer suffix. The first argument is a table mapping name
+ * prefixes to some data that specifies what suffixes have been used and how
+ * to create the new one. This function updates the table with the new
+ * largest suffix generated. The "undolist" argument, when present, will be
+ * used by the function to record information that can be used by
+ * {!Alpha.undoAlphaChanges} to undo those changes. Note that the undo
+ * information will be in reverse order in which the action occurred. Returns
+ * the new name and, if different from the lookupname, the location of the
+ * previous occurrence. This function knows about the location implicitly
+ * from the {!Cil.currentLoc}. *)
+val newAlphaName: alphaTable:(string, 'a alphaTableData ref) Hashtbl.t ->
+ undolist: 'a undoAlphaElement list ref option ->
+ lookupname:string -> data:'a -> string * 'a
+
+
+(** Register a name with an alpha conversion table to ensure that when later
+ * we call newAlphaName we do not end up generating this one *)
+val registerAlphaName: alphaTable:(string, 'a alphaTableData ref) Hashtbl.t ->
+ undolist: 'a undoAlphaElement list ref option ->
+ lookupname:string -> data:'a -> unit
+
+(** Split the name in preparation for newAlphaName. The prefix returned is
+ used to index into the hashtable. The next result value is a separator
+ (either empty or the separator chosen to separate the original name from
+ the index) *)
+val docAlphaTable: unit ->
+ (string, 'a alphaTableData ref) Hashtbl.t -> Pretty.doc
+
+
+val getAlphaPrefix: lookupname:string -> string
+
+(** Undo the changes to a table *)
+val undoAlphaChanges: alphaTable:(string, 'a alphaTableData ref) Hashtbl.t ->
+ undolist:'a undoAlphaElement list -> unit
diff --git a/cil/ocamlutil/clist.ml b/cil/ocamlutil/clist.ml
new file mode 100644
index 0000000..80f0fd6
--- /dev/null
+++ b/cil/ocamlutil/clist.ml
@@ -0,0 +1,183 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+open Pretty
+
+
+(* We often need to concatenate sequences and using lists for this purpose is
+ * expensive. So we define a kind of "concatenable lists" that are easier to
+ * concatenate *)
+type 'a clist =
+ | CList of 'a list (* This is the only representation for empty
+ * *)
+ | CConsL of 'a * 'a clist
+ | CConsR of 'a clist * 'a
+ | CSeq of 'a clist * 'a clist (* We concatenate only two of them at this
+ * time. Neither is CEmpty. To be sure
+ * always use append to make these *)
+
+let rec listifyOnto (tail: 'a list) = function
+ CList l -> l @ tail
+ | CConsL (x, l) -> x :: listifyOnto tail l
+ | CConsR (l, x) -> listifyOnto (x :: tail) l
+ | CSeq (l1, l2) -> listifyOnto (listifyOnto tail l2) l1
+
+let toList l = listifyOnto [] l
+let fromList l = CList l
+
+
+let single x = CList [x]
+let empty = CList []
+
+let checkBeforeAppend (l1: 'a clist) (l2: 'a clist) : bool =
+ l1 != l2 || l1 = (CList [])
+
+let append l1 l2 =
+ if l1 = CList [] then l2 else
+ if l2 = CList [] then l1 else
+ begin
+ if l1 == l2 then
+ raise (Failure "You should not use Clist.append to double a list");
+ CSeq (l1, l2)
+ end
+
+let rec length (acc: int) = function
+ CList l -> acc + (List.length l)
+ | CConsL (x, l) -> length (acc + 1) l
+ | CConsR (l, _) -> length (acc + 1) l
+ | CSeq (l1, l2) -> length (length acc l1) l2
+let length l = length 0 l (* The external version *)
+
+let map (f: 'a -> 'b) (l: 'a clist) : 'b clist =
+ let rec loop = function
+ CList l -> CList (List.map f l)
+ | CConsL (x, l) -> let x' = f x in CConsL (x', loop l)
+ | CConsR (l, x) -> let l' = loop l in CConsR (l', f x)
+ | CSeq (l1, l2) -> let l1' = loop l1 in CSeq (l1', loop l2)
+ in
+ loop l
+
+
+let fold_left (f: 'acc -> 'a -> 'acc) (start: 'acc) (l: 'a clist) =
+ let rec loop (start: 'acc) = function
+ CList l -> List.fold_left f start l
+ | CConsL (x, l) -> loop (f start x) l
+ | CConsR (l, x) -> let res = loop start l in f res x
+ | CSeq (l1, l2) ->
+ let res1 = loop start l1 in
+ loop res1 l2
+ in
+ loop start l
+
+let iter (f: 'a -> unit) (l: 'a clist) : unit =
+ let rec loop = function
+ CList l -> List.iter f l
+ | CConsL (x, l) -> f x; loop l
+ | CConsR (l, x) -> loop l; f x
+ | CSeq (l1, l2) -> loop l1; loop l2
+ in
+ loop l
+
+
+let rec rev (revelem: 'a -> 'a) = function
+ CList l ->
+ let rec revonto (tail: 'a list) = function
+ [] -> tail
+ | x :: rest -> revonto (revelem x :: tail) rest
+ in
+ CList (revonto [] l)
+
+ | CConsL (x, l) -> CConsR (rev revelem l, x)
+ | CConsR (l, x) -> CConsL (x, rev revelem l)
+ | CSeq (l1, l2) -> CSeq (rev revelem l2, rev revelem l1)
+
+
+let docCList (sep: doc) (doone: 'a -> doc) () (dl: 'a clist) =
+ fold_left
+ (fun (acc: doc) (elem: 'a) ->
+ let elemd = doone elem in
+ if acc == nil then elemd else acc ++ sep ++ elemd)
+ nil
+ dl
+
+
+(* let debugCheck (lst: 'a clist) : unit =*)
+(* (* use a hashtable to store values encountered *)*)
+(* let tbl : 'a bool H.t = (H.create 13) in*)
+
+(* letrec recurse (node: 'a clist) =*)
+(* (* have we seen*)*)
+
+(* match node with*)
+(* | CList*)
+
+
+(* --------------- testing ----------------- *)
+type boxedInt =
+ | BI of int
+ | SomethingElse
+
+let d_boxedInt () b =
+ match b with
+ | BI(i) -> (dprintf "%d" i)
+ | SomethingElse -> (text "somethingElse")
+
+
+(* sm: some simple tests of CLists
+let testCList () : unit =
+begin
+ (trace "sm" (dprintf "in testCList\n"));
+
+ let clist1 = (fromList [BI(1); BI(2); BI(3)]) in
+ (trace "sm" (dprintf "length of clist1 is %d\n"
+ (length clist1) ));
+
+ let flattened = (toList clist1) in
+ (trace "sm" (dprintf "flattened: %a\n"
+ (docList ~sep:(chr ',' ++ break) (d_boxedInt ()))
+ flattened));
+
+
+end
+1) in
+ (trace "sm" (dprintf "flattened: %a\n"
+ (docList ~sep:(chr ',' ++ break) (d_boxedInt ()))
+ flattened));
+
+
+end
+*)
diff --git a/cil/ocamlutil/clist.mli b/cil/ocamlutil/clist.mli
new file mode 100644
index 0000000..c0378a6
--- /dev/null
+++ b/cil/ocamlutil/clist.mli
@@ -0,0 +1,97 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** Utilities for managing "concatenable lists" (clists). We often need to
+ concatenate sequences, and using lists for this purpose is expensive. This
+ module provides routines to manage such lists more efficiently. In this
+ model, we never do cons or append explicitly. Instead we maintain
+ the elements of the list in a special data structure. Routines are provided
+ to convert to/from ordinary lists, and carry out common list operations.*)
+
+(** The clist datatype. A clist can be an ordinary list, or a clist preceded
+ or followed by an element, or two clists implicitly appended together*)
+type 'a clist =
+ | CList of 'a list (** The only representation for the empty
+ list. Try to use sparingly. *)
+ | CConsL of 'a * 'a clist (** Do not use this a lot because scanning
+ * it is not tail recursive *)
+ | CConsR of 'a clist * 'a
+ | CSeq of 'a clist * 'a clist (** We concatenate only two of them at this
+ time. Neither is the empty clist. To be
+ sure always use append to make these *)
+
+
+(** Convert a clist to an ordinary list *)
+val toList: 'a clist -> 'a list
+
+(** Convert an ordinary list to a clist *)
+val fromList: 'a list -> 'a clist
+
+(** Create a clist containing one element *)
+val single: 'a -> 'a clist
+
+(** The empty clist *)
+val empty: 'a clist
+
+
+(** Append two clists *)
+val append: 'a clist -> 'a clist -> 'a clist
+
+(** A useful check to assert before an append. It checks that the two lists
+ * are not identically the same (Except if they are both empty) *)
+val checkBeforeAppend: 'a clist -> 'a clist -> bool
+
+(** Find the length of a clist *)
+val length: 'a clist -> int
+
+(** Map a function over a clist. Returns another clist *)
+val map: ('a -> 'b) -> 'a clist -> 'b clist
+
+
+(** A version of fold_left that works on clists *)
+val fold_left: ('acc -> 'a -> 'acc) -> 'acc -> 'a clist -> 'acc
+
+(** A version of iter that works on clists *)
+val iter: ('a -> unit) -> 'a clist -> unit
+
+(** Reverse a clist. The first function reverses an element. *)
+val rev: ('a -> 'a) -> 'a clist -> 'a clist
+
+(** A document for printing a clist (similar to [docList]) *)
+val docCList:
+ Pretty.doc -> ('a -> Pretty.doc) -> unit -> 'a clist -> Pretty.doc
+
diff --git a/cil/ocamlutil/errormsg.ml b/cil/ocamlutil/errormsg.ml
new file mode 100644
index 0000000..07e935d
--- /dev/null
+++ b/cil/ocamlutil/errormsg.ml
@@ -0,0 +1,337 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+open Pretty
+
+
+
+let debugFlag = ref false (* If set then print debugging info *)
+let verboseFlag = ref false
+
+(**** Error reporting ****)
+exception Error
+let s (d : 'a) = raise Error
+
+let hadErrors = ref false
+
+let errorContext = ref []
+let pushContext f = errorContext := f :: (!errorContext)
+let popContext () =
+ match !errorContext with
+ _ :: t -> errorContext := t
+ | [] -> s (eprintf "Bug: cannot pop error context")
+
+
+let withContext ctx f x =
+ pushContext ctx;
+ try
+ let res = f x in
+ popContext ();
+ res
+ with e -> begin
+ popContext ();
+ raise e
+ end
+
+ (* Make sure that showContext calls
+ * each f with its appropriate
+ * errorContext as it was when it was
+ * pushed *)
+let showContext () =
+ let rec loop = function
+ [] -> ()
+ | f :: rest -> (errorContext := rest; (* Just in case f raises an error *)
+ ignore (eprintf " Context : %t@!" f);
+ loop rest)
+ in
+ let old = !errorContext in
+ try
+ loop old;
+ errorContext := old
+ with e -> begin
+ errorContext := old;
+ raise e
+ end
+
+let contextMessage (name: string) (d: doc) =
+ ignore (eprintf "@!%s: %a@!" name insert d);
+ showContext ()
+
+let warnFlag = ref false
+
+let logChannel : out_channel ref = ref stderr
+
+
+let bug (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d =
+ hadErrors := true; contextMessage "Bug" d;
+ flush !logChannel
+ in
+ Pretty.gprintf f fmt
+
+let error (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d = hadErrors := true; contextMessage "Error" d;
+ flush !logChannel
+ in
+ Pretty.gprintf f fmt
+
+let unimp (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d = hadErrors := true; contextMessage "Unimplemented" d;
+ flush !logChannel
+ in
+ Pretty.gprintf f fmt
+
+let warn (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d = contextMessage "Warning" d; flush !logChannel in
+ Pretty.gprintf f fmt
+
+let warnOpt (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d =
+ if !warnFlag then contextMessage "Warning" d;
+ flush !logChannel in
+ Pretty.gprintf f fmt
+
+
+let log (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d = fprint !logChannel 80 d; flush !logChannel in
+ Pretty.gprintf f fmt
+
+let logg (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d = fprint !logChannel 10000000 d; flush !logChannel in
+ Pretty.gprintf f fmt
+
+let null (fmt : ('a,unit,doc,unit) format4) : 'a =
+ let f d = () in
+ Pretty.gprintf f fmt
+
+
+let theLexbuf = ref (Lexing.from_string "")
+
+let fail format = Pretty.gprintf (fun x -> Pretty.fprint stderr 80 x;
+ raise (Failure "")) format
+
+
+
+(***** Handling parsing errors ********)
+type parseinfo =
+ { mutable linenum: int ; (* Current line *)
+ mutable linestart: int ; (* The position in the buffer where the
+ * current line starts *)
+ mutable fileName : string ; (* Current file *)
+ mutable hfile : string ; (* High-level file *)
+ mutable hline : int; (* High-level line *)
+ lexbuf : Lexing.lexbuf;
+ inchan : in_channel option; (* None, if from a string *)
+ mutable num_errors : int; (* Errors so far *)
+ }
+
+let dummyinfo =
+ { linenum = 1;
+ linestart = 0;
+ fileName = "" ;
+ lexbuf = Lexing.from_string "";
+ inchan = None;
+ hfile = "";
+ hline = 0;
+ num_errors = 0;
+ }
+
+let current = ref dummyinfo
+
+let setHLine (l: int) : unit =
+ !current.hline <- l
+let setHFile (f: string) : unit =
+ !current.hfile <- f
+
+let rem_quotes str = String.sub str 1 ((String.length str) - 2)
+
+(* Change \ into / in file names. To avoid complications with escapes *)
+let cleanFileName str =
+ let str1 =
+ if str <> "" && String.get str 0 = '"' (* '"' ( *)
+ then rem_quotes str else str in
+ let l = String.length str1 in
+ let rec loop (copyto: int) (i: int) =
+ if i >= l then
+ String.sub str1 0 copyto
+ else
+ let c = String.get str1 i in
+ if c <> '\\' then begin
+ String.set str1 copyto c; loop (copyto + 1) (i + 1)
+ end else begin
+ String.set str1 copyto '/';
+ if i < l - 2 && String.get str1 (i + 1) = '\\' then
+ loop (copyto + 1) (i + 2)
+ else
+ loop (copyto + 1) (i + 1)
+ end
+ in
+ loop 0 0
+
+let readingFromStdin = ref false
+
+let startParsing ?(useBasename=true) (fname: string) =
+ (* We only support one open file at a time *)
+ if !current != dummyinfo then begin
+ s (error "Errormsg.startParsing supports only one open file: You want to open %s and %s is still open\n" fname !current.fileName);
+ end;
+ let inchan =
+ try if fname = "-" then begin
+ readingFromStdin := true;
+ stdin
+ end else begin
+ readingFromStdin := false;
+ open_in fname
+ end
+ with e -> s (error "Cannot find input file %s (exception %s"
+ fname (Printexc.to_string e)) in
+ let lexbuf = Lexing.from_channel inchan in
+ let i =
+ { linenum = 1; linestart = 0;
+ fileName =
+ cleanFileName (if useBasename then Filename.basename fname else fname);
+ lexbuf = lexbuf; inchan = Some inchan;
+ hfile = ""; hline = 0;
+ num_errors = 0 } in
+
+ current := i;
+ lexbuf
+
+let startParsingFromString ?(file="<string>") ?(line=1) (str: string) =
+ let lexbuf = Lexing.from_string str in
+ let i =
+ { linenum = line; linestart = line - 1;
+ fileName = file;
+ hfile = ""; hline = 0;
+ lexbuf = lexbuf;
+ inchan = None;
+ num_errors = 0 }
+ in
+ current := i;
+ lexbuf
+
+let finishParsing () =
+ let i = !current in
+ (match i.inchan with Some c -> close_in c | _ -> ());
+ current := dummyinfo
+
+
+(* Call this function to announce a new line *)
+let newline () =
+ let i = !current in
+ i.linenum <- 1 + i.linenum;
+ i.linestart <- Lexing.lexeme_start i.lexbuf
+
+let newHline () =
+ let i = !current in
+ i.hline <- 1 + i.hline
+
+let setCurrentLine (i: int) =
+ !current.linenum <- i
+
+let setCurrentFile (n: string) =
+ !current.fileName <- cleanFileName n
+
+
+let max_errors = 20 (* Stop after 20 errors *)
+
+let parse_error (msg: string) : 'a =
+ (* Sometimes the Ocaml parser raises errors in symbol_start and symbol_end *)
+ let token_start, token_end =
+ try Parsing.symbol_start (), Parsing.symbol_end ()
+ with e -> begin
+ ignore (warn "Parsing raised %s\n" (Printexc.to_string e));
+ 0, 0
+ end
+ in
+ let i = !current in
+ let adjStart =
+ if token_start < i.linestart then 0 else token_start - i.linestart in
+ let adjEnd =
+ if token_end < i.linestart then 0 else token_end - i.linestart in
+ output_string
+ stderr
+ (i.fileName ^ "[" ^ (string_of_int i.linenum) ^ ":"
+ ^ (string_of_int adjStart) ^ "-"
+ ^ (string_of_int adjEnd)
+ ^ "]"
+ ^ " : " ^ msg);
+ output_string stderr "\n";
+ flush stderr ;
+ i.num_errors <- i.num_errors + 1;
+ if i.num_errors > max_errors then begin
+ output_string stderr "Too many errors. Aborting.\n" ;
+ exit 1
+ end;
+ hadErrors := true;
+ raise Parsing.Parse_error
+
+
+
+
+(* More parsing support functions: line, file, char count *)
+let getPosition () : int * string * int =
+ let i = !current in
+ i.linenum, i.fileName, Lexing.lexeme_start i.lexbuf
+
+
+let getHPosition () =
+ !current.hline, !current.hfile
+
+(** Type for source-file locations *)
+type location =
+ { file: string; (** The file name *)
+ line: int; (** The line number *)
+ hfile: string; (** The high-level file name, or "" if not present *)
+ hline: int; (** The high-level line number, or 0 if not present *)
+ }
+
+let d_loc () l =
+ text (l.file ^ ":" ^ string_of_int l.line)
+
+let d_hloc () (l: location) =
+ dprintf "%s:%d%a" l.file l.line
+ insert (if l.hline > 0 then dprintf " (%s:%d)" l.hfile l.hline else nil)
+
+let locUnknown = { file = ""; hfile = ""; line = -1; hline = -1 }
+
+let getLocation () =
+ let hl, hf = getHPosition () in
+ let l, f, c = getPosition () in
+ { hfile = hf; hline = hl;
+ file = f; line = l }
+
diff --git a/cil/ocamlutil/errormsg.mli b/cil/ocamlutil/errormsg.mli
new file mode 100644
index 0000000..8d9c697
--- /dev/null
+++ b/cil/ocamlutil/errormsg.mli
@@ -0,0 +1,164 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(** Utility functions for error-reporting *)
+
+(** A channel for printing log messages *)
+val logChannel : out_channel ref
+
+(** If set then print debugging info *)
+val debugFlag : bool ref
+
+val verboseFlag : bool ref
+
+
+(** Set to true if you want to see all warnings. *)
+val warnFlag: bool ref
+
+(** Error reporting functions raise this exception *)
+exception Error
+
+
+ (* Error reporting. All of these functions take same arguments as a
+ * Pretty.eprintf. They set the hadErrors flag, but do not raise an
+ * exception. Their return type is unit.
+ *)
+
+(** Prints an error message of the form [Error: ...].
+ Use in conjunction with s, for example: [E.s (E.error ... )]. *)
+val error: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** Similar to [error] except that its output has the form [Bug: ...] *)
+val bug: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** Similar to [error] except that its output has the form [Unimplemented: ...] *)
+val unimp: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** Stop the execution by raising an Error. *)
+val s: 'a -> 'b
+
+(** This is set whenever one of the above error functions are called. It must
+ be cleared manually *)
+val hadErrors: bool ref
+
+(** Like {!Errormsg.error} but does not raise the {!Errormsg.Error}
+ * exception. Return type is unit. *)
+val warn: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** Like {!Errormsg.warn} but optional. Printed only if the
+ * {!Errormsg.warnFlag} is set *)
+val warnOpt: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** Print something to [logChannel] *)
+val log: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** same as {!Errormsg.log} but do not wrap lines *)
+val logg: ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+ (* All of the error and warning reporting functions can also print a
+ * context. To register a context printing function use "pushContext". To
+ * remove the last registered one use "popContext". If one of the error
+ * reporting functions is called it will invoke all currently registered
+ * context reporting functions in the reverse order they were registered. *)
+
+(** Do not actually print (i.e. print to /dev/null) *)
+val null : ('a,unit,Pretty.doc,unit) format4 -> 'a
+
+(** Registers a context printing function *)
+val pushContext : (unit -> Pretty.doc) -> unit
+
+(** Removes the last registered context printing function *)
+val popContext : unit -> unit
+
+(** Show the context stack to stderr *)
+val showContext : unit -> unit
+
+(** To ensure that the context is registered and removed properly, use the
+ function below *)
+val withContext : (unit -> Pretty.doc) -> ('a -> 'b) -> 'a -> 'b
+
+
+
+val newline: unit -> unit (* Call this function to announce a new line *)
+val newHline: unit -> unit
+
+val getPosition: unit -> int * string * int (* Line number, file name,
+ current byte count in file *)
+val getHPosition: unit -> int * string (** high-level position *)
+
+val setHLine: int -> unit
+val setHFile: string -> unit
+
+val setCurrentLine: int -> unit
+val setCurrentFile: string -> unit
+
+(** Type for source-file locations *)
+type location =
+ { file: string; (** The file name *)
+ line: int; (** The line number *)
+ hfile: string; (** The high-level file name, or "" if not present *)
+ hline: int; (** The high-level line number, or 0 if not present *)
+ }
+
+val d_loc: unit -> location -> Pretty.doc
+val d_hloc: unit -> location -> Pretty.doc
+
+val getLocation: unit -> location
+
+val parse_error: string -> (* A message *)
+ 'a
+
+(** An unknown location for use when you need one but you don't have one *)
+val locUnknown: location
+
+
+(** Records whether the stdin is open for reading the goal **)
+val readingFromStdin: bool ref
+
+
+(* Call this function to start parsing. useBasename is by default "true",
+ * meaning that the error information maintains only the basename. If the
+ * file name is - then it reads from stdin. *)
+val startParsing: ?useBasename:bool -> string ->
+ Lexing.lexbuf
+
+val startParsingFromString: ?file:string -> ?line:int -> string
+ -> Lexing.lexbuf
+
+val finishParsing: unit -> unit (* Call this function to finish parsing and
+ * close the input channel *)
+
+
diff --git a/cil/ocamlutil/growArray.ml b/cil/ocamlutil/growArray.ml
new file mode 100644
index 0000000..ccadc76
--- /dev/null
+++ b/cil/ocamlutil/growArray.ml
@@ -0,0 +1,191 @@
+(** Growable Arrays *)
+
+type 'a fill =
+ Elem of 'a
+ | Susp of (int -> 'a)
+
+type 'a t = {
+ gaFill: 'a fill;
+ (** Stuff to use to fill in the array as it grows *)
+
+ mutable gaMaxInitIndex: int;
+ (** Maximum index that was written to. -1 if no writes have
+ * been made. *)
+
+ mutable gaData: 'a array;
+ }
+
+let growTheArray (ga: 'a t) (len: int)
+ (toidx: int) (why: string) : unit =
+ if toidx >= len then begin
+ (* Grow the array by 50% *)
+ let newlen = toidx + 1 + len / 2 in
+(*
+ ignore (E.log "growing an array to idx=%d (%s)\n" toidx why);
+*)
+ let data' = begin match ga.gaFill with
+ Elem x ->
+ let data'' = Array.create newlen x in
+ Array.blit ga.gaData 0 data'' 0 len;
+ data''
+ | Susp f -> Array.init newlen
+ (fun i -> if i < len then ga.gaData.(i) else f i)
+ end
+ in
+ ga.gaData <- data'
+ end
+
+let max_init_index (ga: 'a t) : int =
+ ga.gaMaxInitIndex
+
+let num_alloc_index (ga: 'a t) : int =
+ Array.length ga.gaData
+
+let reset_max_init_index (ga: 'a t) : unit =
+ ga.gaMaxInitIndex <- -1
+
+let getg (ga: 'a t) (r: int) : 'a =
+ let len = Array.length ga.gaData in
+ if r >= len then
+ growTheArray ga len r "getg";
+
+ ga.gaData.(r)
+
+let setg (ga: 'a t) (r: int) (what: 'a) : unit =
+ let len = Array.length ga.gaData in
+ if r >= len then
+ growTheArray ga len r "setg";
+ if r > max_init_index ga then ga.gaMaxInitIndex <- r;
+ ga.gaData.(r) <- what
+
+let get (ga: 'a t) (r: int) : 'a = Array.get ga.gaData r
+
+let set (ga: 'a t) (r: int) (what: 'a) : unit =
+ if r > max_init_index ga then ga.gaMaxInitIndex <- r;
+ Array.set ga.gaData r what
+
+let make (initsz: int) (fill: 'a fill) : 'a t =
+ { gaFill = fill;
+ gaMaxInitIndex = -1;
+ gaData = begin match fill with
+ Elem x -> Array.create initsz x
+ | Susp f -> Array.init initsz f
+ end; }
+
+let clear (ga: 'a t) : unit =
+ (* This assumes the user hasn't used the raw "set" on any value past
+ max_init_index. Maybe we shouldn't trust max_init_index here?? *)
+ if ga.gaMaxInitIndex >= 0 then begin
+ begin match ga.gaFill with
+ Elem x -> Array.fill ga.gaData 0 (ga.gaMaxInitIndex+1) x
+ | Susp f ->
+ for i = 0 to ga.gaMaxInitIndex do
+ Array.set ga.gaData i (f i)
+ done
+ end;
+ ga.gaMaxInitIndex <- -1
+ end
+
+let copy (ga: 'a t) : 'a t =
+ { ga with gaData = Array.copy ga.gaData }
+
+let deep_copy (ga: 'a t) (copy: 'a -> 'a): 'a t =
+ { ga with gaData = Array.map copy ga.gaData }
+
+(* An accumulating for loop. Used internally. *)
+let fold_for ~(init: 'a) ~(lo: int) ~(hi: int) (f: int -> 'a -> 'a) =
+ let rec forloop i acc =
+ if i > hi then acc
+ else forloop (i+1) (f i acc)
+ in
+ forloop lo init
+
+(** Iterate over the initialized elements of the array *)
+let iter (f: 'a -> unit) (ga: 'a t) =
+ for i = 0 to max_init_index ga do
+ f ga.gaData.(i)
+ done
+
+(** Iterate over the initialized elements of the array *)
+let iteri (f: int -> 'a -> unit) (ga: 'a t) =
+ for i = 0 to max_init_index ga do
+ f i ga.gaData.(i)
+ done
+
+(** Iterate over the elements of 2 arrays *)
+let iter2 (f: int -> 'a -> 'b -> unit) (ga1: 'a t) (ga2: 'b t) =
+ let len1 = max_init_index ga1 in
+ let len2 = max_init_index ga2 in
+ if len1 > -1 || len2 > -1 then begin
+ let max = if len1 > len2 then begin
+ ignore(getg ga2 len1); (*grow ga2 to match ga1*)
+ len1
+ end else begin
+ ignore(getg ga1 len2); (*grow ga1 to match ga2*)
+ len2
+ end in
+ for i = 0 to max do
+ f i ga1.gaData.(i) ga2.gaData.(i)
+ done
+ end
+
+(** Fold left over the initialized elements of the array *)
+let fold_left (f: 'acc -> 'a -> 'acc) (acc: 'acc) (ga: 'a t) : 'acc =
+ let rec loop (acc: 'acc) (idx: int) : 'acc =
+ if idx > max_init_index ga then
+ acc
+ else
+ loop (f acc ga.gaData.(idx)) (idx + 1)
+ in
+ loop acc 0
+
+
+(** Fold left over the initialized elements of the array *)
+let fold_lefti (f: 'acc -> int -> 'a -> 'acc) (acc: 'acc) (ga: 'a t) : 'acc =
+ let rec loop (acc: 'acc) (idx: int) : 'acc =
+ if idx > max_init_index ga then
+ acc
+ else
+ loop (f acc idx ga.gaData.(idx)) (idx + 1)
+ in
+ loop acc 0
+
+(** Fold right over the initialized elements of the array *)
+let fold_right (f: 'a -> 'acc -> 'acc) (ga: 'a t) (acc: 'acc) : 'acc =
+ let rec loop (acc: 'acc) (idx: int) : 'acc =
+ if idx < 0 then
+ acc
+ else
+ loop (f ga.gaData.(idx) acc) (idx - 1)
+ in
+ loop acc (max_init_index ga)
+
+(** Document generator *)
+let d_growarray (sep: Pretty.doc)
+ (doit:int -> 'a -> Pretty.doc)
+ ()
+ (elements: 'a t) =
+ Pretty.docArray ~sep:sep doit () elements.gaData
+
+let restoreGA ?deepCopy (ga: 'a t) : (unit -> unit) =
+ let old =
+ (match deepCopy with
+ None -> copy ga
+ | Some f -> deep_copy ga f)
+ in
+ (fun () ->
+ if ga.gaFill != old.gaFill then
+ Errormsg.s
+ (Errormsg.bug "restoreGA to an array with a different fill.");
+ ga.gaMaxInitIndex <- old.gaMaxInitIndex;
+ for i = 0 to max_init_index ga do
+ set ga i (getg old i)
+ done)
+
+let find (ga: 'a t) (fn: 'a -> bool) : int option =
+ let rec loop (i:int) : int option =
+ if i > ga.gaMaxInitIndex then None
+ else if fn (get ga i) then Some i
+ else loop (i + 1)
+ in
+ loop 0
diff --git a/cil/ocamlutil/growArray.mli b/cil/ocamlutil/growArray.mli
new file mode 100644
index 0000000..4cb5f48
--- /dev/null
+++ b/cil/ocamlutil/growArray.mli
@@ -0,0 +1,131 @@
+(***********************************************************************)
+(* Growable Arrays *)
+(* *)
+(* This a wrapper around the standard OCaml array, but will grow *)
+(* automatically on get or set outside the current size of the *)
+(* array. *)
+(* *)
+(* The interface is the same as the standard OCaml array where *)
+(* applicable (and implemented). *)
+(***********************************************************************)
+
+(* $Id: growArray.mli,v 1.8 2005-01-06 15:37:36 necula Exp $ *)
+
+(** Array operations. *)
+
+(** The type of growable arrays *)
+type 'a t
+
+(** The default value to a new element of the growable array *)
+type 'a fill =
+ Elem of 'a
+ (* A default value *)
+ | Susp of (int -> 'a)
+ (* A function given an index to generate a default value *)
+
+val make : int -> 'a fill -> 'a t
+(** [GrowArray.make n x] returns a fresh growable array of size
+ at least [n] with default value specified by [x].
+
+ Raise [Invalid_argument] if [n < 0] or [n > Sys.max_array_length]. *)
+
+val num_alloc_index: 'a t -> int
+(** [GrowArray.num_alloc_index a] returns the number of allocated entries in
+ * the array **)
+
+val max_init_index : 'a t -> int
+(** [GrowArray.max_init_index a] returns the maximum index to
+ which has been written.
+
+ Returns -1 if no writes have been made. *)
+
+val reset_max_init_index : 'a t -> unit
+(** [GrowArray.reset_init a] resets the max_init_index. You should probably
+ use [GrowArray.clear a] instead if you also want to delete the contents. *)
+
+val getg : 'a t -> int -> 'a
+(** [GrowArray.getg a n] returns the element number [n] of array [a].
+ The first element has number 0.
+ The last element has number [GrowArray.length a - 1].
+
+ If [n] is outside the range 0 to [(GrowArray.max_init_index a)],
+ then the array grows to at least [n] and yields the default value. *)
+
+val setg : 'a t -> int -> 'a -> unit
+(** [GrowArray.setg a n x] modifies array [a] in place, replacing
+ element number [n] with [x].
+
+ If [n] is outside the range 0 to [(GrowArray.max_init_index a)],
+ then the array grows to at least [n] and yields the default value. *)
+
+val get : 'a t -> int -> 'a
+(** [GrowArray.get a n] returns the element number [n] of grow array [a].
+
+ Raise [Invalid_argument "Array.get"] if [n] is outside the range
+ of the underlying array. *)
+
+val set : 'a t -> int -> 'a -> unit
+(** [GrowArray.set a n x] modifies grow array [a] in place, replacing
+ element number [n] with [x].
+
+ Raise [Invalid_argument "Array.set"] if [n] is outside the range
+ of the underlying array. *)
+
+val clear: 'a t -> unit
+(** [GrowArray.clear a] clears the contents of the array and sets
+ max_init_index to -1. Suspension thunks will be rerun to regenerate the
+ initial values of the array. *)
+
+val copy : 'a t -> 'a t
+(** [GrowArray.copy a] returns a copy of [a], that is, a fresh array
+ containing the same elements as [a]. *)
+
+val deep_copy : 'a t -> ('a -> 'a) -> 'a t
+(** [GrowArray.copy a f] returns a deep copy of [a] using f to
+ copy elements of [a]. *)
+
+val iter : ('a -> unit) -> 'a t -> unit
+(** [GrowArray.iter f a] applies function [f] in turn to all
+ the elements of [a]. It is equivalent to
+ [f a.(0); f a.(1); ...; f a.(GrowArray.length a - 1); ()]. *)
+
+val iteri : (int -> 'a -> unit) -> 'a t -> unit
+(** Same as {!GrowArray.iter}, but the
+ function is applied to the index of the element as first argument,
+ and the element itself as second argument. *)
+
+val iter2 : (int -> 'a -> 'b -> unit) -> 'a t -> 'b t -> unit
+(** Same as {!GrowArray.iteri}, but the function is applied to two arrays.
+ [iter2 f a b] is equivalent to
+ [f 0 a.(0) b.(0); f 1 a.(1) b.(1); ...; f n a.(n) b.(n); ()]
+ where n is the larger of (max_init_index a) or (max_init_index b).
+ The shorter array will grow to match the longer.*)
+
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+(** [GrowArray.fold_left f x a] computes
+ [f (... (f (f x a.(0)) a.(1)) ...) a.(n-1)],
+ where [n] is the length of the array [a]. *)
+
+val fold_lefti : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
+(** [GrowArray.fold_lefti f x a] computes
+ [f (... (f (f x 0 a.(0)) 1 a.(1)) ...) (n-1) a.(n-1)],
+ where [n] is the length of the array [a]. *)
+
+val fold_right : ('b -> 'a -> 'a) -> 'b t -> 'a -> 'a
+(** [GrowArray.fold_right f a x] computes
+ [f a.(0) (f a.(1) ( ... (f a.(n-1) x) ...))],
+ where [n] is the length of the array [a]. *)
+
+val d_growarray : Pretty.doc -> (int -> 'a -> Pretty.doc) -> unit -> 'a t
+ -> Pretty.doc
+(** [GrowArray.d_growarray sep f () a] creates a {!Pretty.doc} for growable
+ array a using separator sep and element printer f. *)
+
+
+val restoreGA: ?deepCopy:('a -> 'a) -> 'a t -> unit -> unit
+(** Given a growable array, produce a thunk that later restores it to its
+ current value *)
+
+val find: 'a t -> ('a -> bool) -> int option
+(** Returns the index of the first element in the array that satisfies the
+ predicate, or None if there is no such element *)
diff --git a/cil/ocamlutil/inthash.ml b/cil/ocamlutil/inthash.ml
new file mode 100755
index 0000000..b1ad0c0
--- /dev/null
+++ b/cil/ocamlutil/inthash.ml
@@ -0,0 +1,188 @@
+(** A hash table specialized on integer keys *)
+type 'a t =
+ { mutable size: int; (* number of elements *)
+ mutable data: 'a bucketlist array } (* the buckets *)
+
+and 'a bucketlist =
+ Empty
+ | Cons of int * 'a * 'a bucketlist
+
+let hash key = key land 0x3fffffff
+
+let create initial_size =
+ let s = min (max 1 initial_size) Sys.max_array_length in
+ { size = 0; data = Array.make s Empty }
+
+let clear h =
+ for i = 0 to Array.length h.data - 1 do
+ h.data.(i) <- Empty
+ done;
+ h.size <- 0
+
+let copy h =
+ { size = h.size;
+ data = Array.copy h.data }
+
+let copy_into src dest =
+ dest.size <- src.size;
+ dest.data <- Array.copy src.data
+
+let length h = h.size
+
+let resize tbl =
+ let odata = tbl.data in
+ let osize = Array.length odata in
+ let nsize = min (2 * osize + 1) Sys.max_array_length in
+ if nsize <> osize then begin
+ let ndata = Array.create nsize Empty in
+ let rec insert_bucket = function
+ Empty -> ()
+ | Cons(key, data, rest) ->
+ insert_bucket rest; (* preserve original order of elements *)
+ let nidx = (hash key) mod nsize in
+ ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
+ for i = 0 to osize - 1 do
+ insert_bucket odata.(i)
+ done;
+ tbl.data <- ndata;
+ end
+
+let add h key info =
+ let i = (hash key) mod (Array.length h.data) in
+ let bucket = Cons(key, info, h.data.(i)) in
+ h.data.(i) <- bucket;
+ h.size <- succ h.size;
+ if h.size > Array.length h.data lsl 1 then resize h
+
+let remove h key =
+ let rec remove_bucket = function
+ Empty ->
+ Empty
+ | Cons(k, i, next) ->
+ if k = key
+ then begin h.size <- pred h.size; next end
+ else Cons(k, i, remove_bucket next) in
+ let i = (hash key) mod (Array.length h.data) in
+ h.data.(i) <- remove_bucket h.data.(i)
+
+let remove_all h key =
+ let rec remove_bucket = function
+ Empty ->
+ Empty
+ | Cons(k, i, next) ->
+ if k = key
+ then begin h.size <- pred h.size;
+ remove_bucket next end
+ else Cons(k, i, remove_bucket next) in
+ let i = (hash key) mod (Array.length h.data) in
+ h.data.(i) <- remove_bucket h.data.(i)
+
+let rec find_rec key = function
+ Empty ->
+ raise Not_found
+ | Cons(k, d, rest) ->
+ if key = k then d else find_rec key rest
+
+let find h key =
+ match h.data.((hash key) mod (Array.length h.data)) with
+ Empty -> raise Not_found
+ | Cons(k1, d1, rest1) ->
+ if key = k1 then d1 else
+ match rest1 with
+ Empty -> raise Not_found
+ | Cons(k2, d2, rest2) ->
+ if key = k2 then d2 else
+ match rest2 with
+ Empty -> raise Not_found
+ | Cons(k3, d3, rest3) ->
+ if key = k3 then d3 else find_rec key rest3
+
+let find_all h key =
+ let rec find_in_bucket = function
+ Empty ->
+ []
+ | Cons(k, d, rest) ->
+ if k = key then d :: find_in_bucket rest else find_in_bucket rest in
+ find_in_bucket h.data.((hash key) mod (Array.length h.data))
+
+let replace h key info =
+ let rec replace_bucket = function
+ Empty ->
+ raise Not_found
+ | Cons(k, i, next) ->
+ if k = key
+ then Cons(k, info, next)
+ else Cons(k, i, replace_bucket next) in
+ let i = (hash key) mod (Array.length h.data) in
+ let l = h.data.(i) in
+ try
+ h.data.(i) <- replace_bucket l
+ with Not_found ->
+ h.data.(i) <- Cons(key, info, l);
+ h.size <- succ h.size;
+ if h.size > Array.length h.data lsl 1 then resize h
+
+let mem h key =
+ let rec mem_in_bucket = function
+ | Empty ->
+ false
+ | Cons(k, d, rest) ->
+ k = key || mem_in_bucket rest in
+ mem_in_bucket h.data.((hash key) mod (Array.length h.data))
+
+let iter (f: int -> 'a -> unit) (h: 'a t) : unit =
+ let rec do_bucket = function
+ Empty ->
+ ()
+ | Cons(k, d, rest) ->
+ f k d; do_bucket rest in
+ let d = h.data in
+ for i = 0 to Array.length d - 1 do
+ do_bucket d.(i)
+ done
+
+let fold (f: int -> 'a -> 'b -> 'b) (h: 'a t) (init: 'b) =
+ let rec do_bucket b accu =
+ match b with
+ Empty ->
+ accu
+ | Cons(k, d, rest) ->
+ do_bucket rest (f k d accu) in
+ let d = h.data in
+ let accu = ref init in
+ for i = 0 to Array.length d - 1 do
+ accu := do_bucket d.(i) !accu
+ done;
+ !accu
+
+
+let memoize (h: 'a t) (key: int) (f: int -> 'a) : 'a =
+ let i = (hash key) mod (Array.length h.data) in
+ let rec find_rec key = function
+ Empty -> addit ()
+ | Cons(k, d, rest) ->
+ if key = k then d else find_rec key rest
+ and find_in_bucket key = function
+ Empty -> addit ()
+ | Cons(k1, d1, rest1) ->
+ if key = k1 then d1 else
+ match rest1 with
+ Empty -> addit ()
+ | Cons(k2, d2, rest2) ->
+ if key = k2 then d2 else
+ match rest2 with
+ Empty -> addit ()
+ | Cons(k3, d3, rest3) ->
+ if key = k3 then d3 else find_rec key rest3
+ and addit () =
+ let it = f key in
+ h.data.(i) <- Cons(key, it, h.data.(i));
+ h.size <- succ h.size;
+ if h.size > Array.length h.data lsl 1 then resize h;
+ it
+ in
+ find_in_bucket key h.data.(i)
+
+
+let tolist (h: 'a t) : (int * 'a) list =
+ fold (fun k d acc -> (k, d) :: acc) h []
diff --git a/cil/ocamlutil/inthash.mli b/cil/ocamlutil/inthash.mli
new file mode 100755
index 0000000..f62fcd2
--- /dev/null
+++ b/cil/ocamlutil/inthash.mli
@@ -0,0 +1,27 @@
+type 'a t
+
+(* These functions behave the same as Hashtbl, but the key type is
+ always int. (Specializing on int improves the performance) *)
+
+val create: int -> 'a t
+val clear: 'a t -> unit
+val length : 'a t -> int
+
+val copy: 'a t -> 'a t
+val copy_into: 'a t -> 'a t -> unit
+
+val add: 'a t -> int -> 'a -> unit
+val replace: 'a t -> int -> 'a -> unit
+val remove: 'a t -> int -> unit
+val remove_all: 'a t -> int -> unit
+
+val mem: 'a t -> int -> bool
+val find: 'a t -> int -> 'a
+val find_all: 'a t -> int -> 'a list
+
+val iter: (int -> 'a -> unit) -> 'a t -> unit
+val fold: (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+
+val memoize: 'a t -> int -> (int -> 'a) -> 'a
+
+val tolist: 'a t -> (int * 'a) list
diff --git a/cil/ocamlutil/intmap.ml b/cil/ocamlutil/intmap.ml
new file mode 100755
index 0000000..00242bc
--- /dev/null
+++ b/cil/ocamlutil/intmap.ml
@@ -0,0 +1,171 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: intmap.ml,v 1.2 2005-10-04 21:30:25 necula Exp $ *)
+
+(* specialized to integer keys by George Necula *)
+
+type 'a t =
+ Empty
+ | Node of 'a t * int * 'a * 'a t * int
+
+let height = function
+ Empty -> 0
+ | Node(_,_,_,_,h) -> h
+
+let create l x d r =
+ let hl = height l and hr = height r in
+ Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+let bal l x d r =
+ let hl = match l with Empty -> 0 | Node(_,_,_,_,h) -> h in
+ let hr = match r with Empty -> 0 | Node(_,_,_,_,h) -> h in
+ if hl > hr + 2 then begin
+ match l with
+ Empty -> invalid_arg "Map.bal"
+ | Node(ll, lv, ld, lr, _) ->
+ if height ll >= height lr then
+ create ll lv ld (create lr x d r)
+ else begin
+ match lr with
+ Empty -> invalid_arg "Map.bal"
+ | Node(lrl, lrv, lrd, lrr, _)->
+ create (create ll lv ld lrl) lrv lrd (create lrr x d r)
+ end
+ end else if hr > hl + 2 then begin
+ match r with
+ Empty -> invalid_arg "Map.bal"
+ | Node(rl, rv, rd, rr, _) ->
+ if height rr >= height rl then
+ create (create l x d rl) rv rd rr
+ else begin
+ match rl with
+ Empty -> invalid_arg "Map.bal"
+ | Node(rll, rlv, rld, rlr, _) ->
+ create (create l x d rll) rlv rld (create rlr rv rd rr)
+ end
+ end else
+ Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
+
+let empty = Empty
+
+let is_empty = function Empty -> true | _ -> false
+
+let rec add x data = function
+ Empty ->
+ Node(Empty, x, data, Empty, 1)
+ | Node(l, v, d, r, h) as t ->
+ if x = v then
+ Node(l, x, data, r, h)
+ else if x < v then
+ bal (add x data l) v d r
+ else
+ bal l v d (add x data r)
+
+let rec find x = function
+ Empty ->
+ raise Not_found
+ | Node(l, v, d, r, _) ->
+ if x = v then d
+ else find x (if x < v then l else r)
+
+let rec mem x = function
+ Empty ->
+ false
+ | Node(l, v, d, r, _) ->
+ x = v || mem x (if x < v then l else r)
+
+let rec min_binding = function
+ Empty -> raise Not_found
+ | Node(Empty, x, d, r, _) -> (x, d)
+ | Node(l, x, d, r, _) -> min_binding l
+
+let rec remove_min_binding = function
+ Empty -> invalid_arg "Map.remove_min_elt"
+ | Node(Empty, x, d, r, _) -> r
+ | Node(l, x, d, r, _) -> bal (remove_min_binding l) x d r
+
+let merge t1 t2 =
+ match (t1, t2) with
+ (Empty, t) -> t
+ | (t, Empty) -> t
+ | (_, _) ->
+ let (x, d) = min_binding t2 in
+ bal t1 x d (remove_min_binding t2)
+
+let rec remove x = function
+ Empty ->
+ Empty
+ | Node(l, v, d, r, h) as t ->
+ if x = v then
+ merge l r
+ else if x < v then
+ bal (remove x l) v d r
+ else
+ bal l v d (remove x r)
+
+let rec iter f = function
+ Empty -> ()
+ | Node(l, v, d, r, _) ->
+ iter f l; f v d; iter f r
+
+let rec map f = function
+ Empty -> Empty
+ | Node(l, v, d, r, h) -> Node(map f l, v, f d, map f r, h)
+
+let rec mapi f = function
+ Empty -> Empty
+ | Node(l, v, d, r, h) -> Node(mapi f l, v, f v d, mapi f r, h)
+
+let rec fold f m accu =
+ match m with
+ Empty -> accu
+ | Node(l, v, d, r, _) ->
+ fold f l (f v d (fold f r accu))
+
+type 'a enumeration = End | More of int * 'a * 'a t * 'a enumeration
+
+let rec cons_enum m e =
+ match m with
+ Empty -> e
+ | Node(l, v, d, r, _) -> cons_enum l (More(v, d, r, e))
+
+let compare cmp m1 m2 =
+ let rec compare_aux e1 e2 =
+ match (e1, e2) with
+ (End, End) -> 0
+ | (End, _) -> -1
+ | (_, End) -> 1
+ | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+ if v1 <> v2 then if v1 < v2 then -1 else 1 else
+ let c = cmp d1 d2 in
+ if c <> 0 then c else
+ compare_aux (cons_enum r1 e1) (cons_enum r2 e2)
+in compare_aux (cons_enum m1 End) (cons_enum m2 End)
+
+let equal cmp m1 m2 =
+ let rec equal_aux e1 e2 =
+ match (e1, e2) with
+ (End, End) -> true
+ | (End, _) -> false
+ | (_, End) -> false
+ | (More(v1, d1, r1, e1), More(v2, d2, r2, e2)) ->
+ v1 = v2 && cmp d1 d2 &&
+ equal_aux (cons_enum r1 e1) (cons_enum r2 e2)
+in equal_aux (cons_enum m1 End) (cons_enum m2 End)
+
+(** Some definitions for ML2Coq *)
+let _ = ignore "coq:
+(* Some definitions for ML2Coq *)
+
+"
diff --git a/cil/ocamlutil/intmap.mli b/cil/ocamlutil/intmap.mli
new file mode 100755
index 0000000..eef89b5
--- /dev/null
+++ b/cil/ocamlutil/intmap.mli
@@ -0,0 +1,87 @@
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: intmap.mli,v 1.1 2005-02-28 16:24:00 necula Exp $ *)
+
+(** Specialized to integer keys by George Necula *)
+
+(** Association tables over ordered types.
+
+ This module implements applicative association tables, also known as
+ finite maps or dictionaries, given a total ordering function
+ over the keys.
+ All operations over maps are purely applicative (no side-effects).
+ The implementation uses balanced binary trees, and therefore searching
+ and insertion take time logarithmic in the size of the map.
+*)
+
+type (+'a) t
+ (** The type of maps from type [key] to type ['a]. *)
+
+val empty: 'a t
+ (** The empty map. *)
+
+val is_empty: 'a t -> bool
+ (** Test whether a map is empty or not. *)
+
+val add: int -> 'a -> 'a t -> 'a t
+ (** [add x y m] returns a map containing the same bindings as
+ [m], plus a binding of [x] to [y]. If [x] was already bound
+ in [m], its previous binding disappears. *)
+
+val find: int -> 'a t -> 'a
+ (** [find x m] returns the current binding of [x] in [m],
+ or raises [Not_found] if no such binding exists. *)
+
+val remove: int -> 'a t -> 'a t
+ (** [remove x m] returns a map containing the same bindings as
+ [m], except for [x] which is unbound in the returned map. *)
+
+val mem: int -> 'a t -> bool
+ (** [mem x m] returns [true] if [m] contains a binding for [x],
+ and [false] otherwise. *)
+
+val iter: (int -> 'a -> unit) -> 'a t -> unit
+ (** [iter f m] applies [f] to all bindings in map [m].
+ [f] receives the key as first argument, and the associated value
+ as second argument. The bindings are passed to [f] in increasing
+ order with respect to the ordering over the type of the keys.
+ Only current bindings are presented to [f]:
+ bindings hidden by more recent bindings are not passed to [f]. *)
+
+val map: ('a -> 'b) -> 'a t -> 'b t
+ (** [map f m] returns a map with same domain as [m], where the
+ associated value [a] of all bindings of [m] has been
+ replaced by the result of the application of [f] to [a].
+ The bindings are passed to [f] in increasing order
+ with respect to the ordering over the type of the keys. *)
+
+val mapi: (int -> 'a -> 'b) -> 'a t -> 'b t
+ (** Same as {!Map.S.map}, but the function receives as arguments both the
+ key and the associated value for each binding of the map. *)
+
+val fold: (int -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ (** [fold f m a] computes [(f kN dN ... (f k1 d1 a)...)],
+ where [k1 ... kN] are the keys of all bindings in [m]
+ (in increasing order), and [d1 ... dN] are the associated data. *)
+
+val compare: ('a -> 'a -> int) -> 'a t -> 'a t -> int
+ (** Total ordering between maps. The first argument is a total ordering
+ used to compare data associated with equal keys in the two maps. *)
+
+val equal: ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
+ (** [equal cmp m1 m2] tests whether the maps [m1] and [m2] are
+ equal, that is, contain equal keys and associate them with
+ equal data. [cmp] is the equality predicate used to compare
+ the data associated with the keys. *)
+
diff --git a/cil/ocamlutil/perfcount.c.in b/cil/ocamlutil/perfcount.c.in
new file mode 100755
index 0000000..ae532f6
--- /dev/null
+++ b/cil/ocamlutil/perfcount.c.in
@@ -0,0 +1,184 @@
+// -*- Mode: c -*-
+//
+/*
+ * A module that allows the reading of performance counters on Pentium.
+ *
+ * This file contains both code that uses the performance counters to
+ * compute the number of cycles per second (to be used during ./configure)
+ * and also code to read the performance counters from Ocaml.
+ *
+ * Author: George Necula (necula@cs.berkeley.edu)
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#if defined(__GNUC__)
+ #define longlong long long
+ // RDTSC puts the result in EAX and EDX. We tell gcc to use those registers
+ // for "low" and "high"
+ #if defined(__i386__)
+ #define GETCOUNTER(low,high) \
+ __asm__ volatile ("rdtsc" : "=a" (low), "=d" (high));
+ #else
+ #define GETCOUNTER(low,high) \
+ printf ("Reading of performance counters is supported only on Intel x86\n"); \
+ exit(1);
+ #endif
+#else
+ // Microsoft Visual Studio
+ #define longlong __int64
+ #define inline __inline
+ #define GETCOUNTER(low,high) __asm { \
+ __asm rdtsc \
+ __asm mov low, eax \
+ __asm mov high, edx };
+#endif
+
+/* Store here the first value read from the performance counter */
+unsigned static longlong first_value;
+
+
+/* This is the function that actually reads the performance counter. */
+inline unsigned longlong read_ppc(void) {
+ unsigned long pclow, pchigh;
+ unsigned longlong lowhigh;
+
+ GETCOUNTER(pclow, pchigh);
+
+ // printf ("Read low=0x%08lx high=0x%08lx\n", low, high);
+
+ // Put the 64-bit value together
+ lowhigh = ((unsigned longlong)pclow) | ((unsigned longlong)pchigh << 32);
+
+ if(first_value == 0) {
+ first_value = lowhigh;
+ }
+ return lowhigh - first_value;
+}
+
+
+/* sm: I want a version that is as fast as possible, dropping
+ * bits that aren't very important to achieve it. *
+ *
+ * This version drops the low 20 bits and the high 14 bits so the
+ * result is 30 bits (always a positive Ocaml int); this yields
+ * megacycles, which for GHz machines will be something like
+ * milliseconds. */
+static unsigned long sample_ppc_20(void)
+{
+ unsigned long pclow, pchigh;
+
+ GETCOUNTER(pclow, pchigh);
+
+ return ((pclow >> 20) | (pchigh << 12)) & 0x3FFFFFFF;
+}
+
+/* This version drops the low 10 bits, yielding something like
+ * microseconds. */
+inline static unsigned long sample_ppc_10()
+{
+ unsigned long pclow, pchigh;
+
+ GETCOUNTER(pclow,pchigh);
+
+ return ((pclow >> 10) | (pchigh << 22)) & 0x3FFFFFFF;
+}
+
+
+
+#ifndef CONFIGURATION_ONLY
+/*** This is the OCAML stub for the read_ppc ***/
+#include <caml/mlvalues.h>
+#include <caml/alloc.h>
+#include <caml/memory.h>
+
+#define CYCLES_PER_USEC @CYCLES_PER_USEC@
+value read_pentium_perfcount()
+{
+ double counter = (double)read_ppc() / (1000000.0 * CYCLES_PER_USEC);
+ return copy_double(counter);
+}
+
+/* The Ocaml system can use this function to figure out if there are
+ * performance counters available */
+value has_performance_counters() {
+ // HAS_PERFCOUNT is set by the configuration code at the end of
+ // this file, during ./configure
+#if @HAS_PERFCOUNT@ != 0
+ return Val_true;
+#else
+ return Val_false;
+#endif
+}
+
+/* sm: interface to above from Ocaml */
+value sample_pentium_perfcount_20()
+{
+ return Val_long(sample_ppc_20());
+}
+
+value sample_pentium_perfcount_10()
+{
+ return Val_long(sample_ppc_10());
+}
+
+#endif
+
+
+/* Now we have a function that tries to compute the number of cycles per
+ * second (to be used during ./configure) */
+#ifdef CONFIGURATION_ONLY
+#include <sys/times.h>
+#include <unistd.h>
+#include <math.h>
+
+int main() {
+ struct tms t;
+ clock_t start, finish, diff;
+ unsigned longlong start_pc, finish_pc, diff_pc;
+ long clk_per_sec = sysconf(_SC_CLK_TCK);
+ double cycles_per_usec;
+
+ if(clk_per_sec <= 0) {
+ printf("Cannot find clk_per_sec (got %ld)\n", clk_per_sec);
+ exit(1);
+ }
+
+ times(&t); start = t.tms_utime;
+ start_pc = read_ppc();
+ // Do something for a while
+ {
+ int i;
+ double a = 5.678;
+ for(i=0;i<10000000;i++) {
+ a = (i & 1) ? (a * a) : (sqrt(a));
+ }
+ }
+ times(&t); finish = t.tms_utime;
+ finish_pc = read_ppc();
+ diff = finish - start;
+ diff_pc = finish_pc - start_pc;
+ if(diff == 0) {
+ printf("Cannot use Unix.times\n");
+ exit(1);
+ }
+ if(diff_pc == 0) {
+ printf("Invalid result from the peformance counters\n");
+ exit(1);
+ }
+ diff_pc /= 1000000; // We care about cycles per microsecond
+// printf("diff = %ld, diff_pc = %ld, clk = %ld\n",
+// (long)diff,
+// (long)diff_pc, (long)clk_per_sec);
+
+ cycles_per_usec = (((double)diff_pc / (double)diff)
+ * (double)clk_per_sec);
+
+ /* Whatever value we print here will be used as the CYCLES_PER_USEC
+ * below */
+ printf("%.3lf\n", cycles_per_usec);
+ exit(0);
+}
+#endif //defined CONFIGURATION_ONLY
+
diff --git a/cil/ocamlutil/pretty.ml b/cil/ocamlutil/pretty.ml
new file mode 100644
index 0000000..47d07ac
--- /dev/null
+++ b/cil/ocamlutil/pretty.ml
@@ -0,0 +1,859 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(******************************************************************************)
+(* Pretty printer
+ This module contains several fast, but sub-optimal heuristics to pretty-print
+ structured text.
+*)
+
+let debug = false
+
+(* Choose an algorithm *)
+type algo = George | Aman | Gap
+let algo = George
+let fastMode = ref false
+
+
+(** Whether to print identation or not (for faster printing and smaller
+ * output) *)
+let printIndent = ref true
+
+(******************************************************************************)
+(* The doc type and constructors *)
+
+type doc =
+ Nil
+ | Text of string
+ | Concat of doc * doc
+ | CText of doc * string
+ | Break
+ | Line
+ | LeftFlush
+ | Align
+ | Unalign
+ | Mark
+ | Unmark
+
+(* Break a string at \n *)
+let rec breakString (acc: doc) (str: string) : doc =
+ try
+ (* Printf.printf "breaking string %s\n" str; *)
+ let r = String.index str '\n' in
+ (* Printf.printf "r=%d\n" r; *)
+ let len = String.length str in
+ if r > 0 then begin
+ (* Printf.printf "Taking %s\n" (String.sub str 0 r); *)
+ let acc' = Concat(CText (acc, String.sub str 0 r), Line) in
+ if r = len - 1 then (* The last one *)
+ acc'
+ else begin
+ (* Printf.printf "Continuing with %s\n" (String.sub str (r + 1) (len - r - 1)); *)
+ breakString acc'
+ (String.sub str (r + 1) (len - r - 1))
+ end
+ end else (* The first is a newline *)
+ breakString (Concat(acc, Line))
+ (String.sub str (r + 1) (len - r - 1))
+ with Not_found ->
+ if acc = Nil then Text str else CText (acc, str)
+
+let nil = Nil
+let text s = breakString nil s
+let num i = text (string_of_int i)
+let real f = text (string_of_float f)
+let chr c = text (String.make 1 c)
+let align = Align
+let unalign = Unalign
+let line = Line
+let leftflush = LeftFlush
+let break = Break
+let mark = Mark
+let unmark = Unmark
+
+let d_int32 (i: int32) = text (Int32.to_string i)
+let f_int32 () i = d_int32 i
+
+let d_int64 (i: int64) = text (Int64.to_string i)
+let f_int64 () i = d_int64 i
+
+
+(* Note that the ++ operator in Ocaml are left-associative. This means
+ * that if you have a long list of ++ then the whole thing is very unbalanced
+ * towards the left side. This is the worst possible case since scanning the
+ * left side of a Concat is the non-tail recursive case. *)
+
+let (++) d1 d2 = Concat (d1, d2)
+let concat d1 d2 = Concat (d1, d2)
+
+(* Ben Liblit fix *)
+let indent n d = text (String.make n ' ') ++ (align ++ (d ++ unalign))
+
+let markup d = mark ++ d ++ unmark
+
+(* Format a sequence. The first argument is a separator *)
+let seq ~(sep:doc) ~(doit:'a -> doc) ~(elements: 'a list) =
+ let rec loop (acc: doc) = function
+ [] -> acc
+ | h :: t ->
+ let fh = doit h in (* Make sure this is done first *)
+ loop (acc ++ sep ++ fh) t
+ in
+ (match elements with
+ [] -> nil
+ | h :: t ->
+ let fh = doit h in loop fh t)
+
+
+let docArray ?(sep=chr ',') (doit:int -> 'a -> doc) () (elements:'a array) =
+ let len = Array.length elements in
+ if len = 0 then
+ nil
+ else
+ let rec loop (acc: doc) i =
+ if i >= len then acc else
+ let fi = doit i elements.(i) in (* Make sure this is done first *)
+ loop (acc ++ sep ++ fi) (i + 1)
+ in
+ let f0 = doit 0 elements.(0) in
+ loop f0 1
+
+let docOpt delem () = function
+ None -> text "None"
+ | Some e -> text "Some(" ++ (delem e) ++ chr ')'
+
+
+
+let docList ?(sep=chr ',') (doit:'a -> doc) () (elements:'a list) =
+ seq sep doit elements
+
+let insert () d = d
+
+
+let d_list (sep:string) (doit:unit -> 'a -> doc) () (elts:'a list) : doc =
+ (* thunk 'doit' to match docList's interface *)
+ let internalDoit (elt:'a) =
+ (doit () elt) in
+ (docList ~sep:(text sep) internalDoit () elts)
+
+(** Format maps *)
+module MakeMapPrinter =
+ functor (Map: sig
+ type key
+ type 'a t
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ end) ->
+struct
+ let docMap ?(sep=chr ',')
+ (doit: Map.key -> 'a -> doc) () (maplets: 'a Map.t) : doc =
+ Map.fold
+ (fun k d acc ->
+ (if acc==nil then acc else acc ++ sep)
+ ++ (doit k d))
+ maplets
+ nil
+
+ let dmaplet d0 d1 = d0 ++ (text " |-> ") ++ d1
+
+ let d_map ?(dmaplet=dmaplet) (sep:string) dkey dval =
+ let doit = fun k d -> dmaplet (dkey () k) (dval () d) in
+ docMap ~sep:(text sep) doit
+end
+
+(** Format sets *)
+module MakeSetPrinter =
+ functor (Set: sig
+ type elt
+ type t
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ end) ->
+struct
+ let docSet ?(sep=chr ',') (doit: Set.elt -> doc) () (set: Set.t) : doc =
+ Set.fold
+ (fun elt acc ->
+ (if acc==nil then acc else acc ++ sep)
+ ++ (doit elt))
+ set
+ nil
+
+ let d_set (sep:string) delt =
+ docSet ~sep:(text sep) (delt ())
+end
+
+
+(******************************************************************************)
+(* Some debugging stuff *)
+
+let dbgprintf x = Printf.fprintf stderr x
+
+let rec dbgPrintDoc = function
+ Nil -> dbgprintf "(Nil)"
+ | Text s -> dbgprintf "(Text %s)" s
+ | Concat (d1,d2) -> dbgprintf ""; dbgPrintDoc d1; dbgprintf " ++\n ";
+ dbgPrintDoc d2; dbgprintf ""
+ | CText (d,s) -> dbgPrintDoc d; dbgprintf " ++ \"%s\"" s;
+ | Break -> dbgprintf "(Break)"
+ | Line -> dbgprintf "(Line)"
+ | LeftFlush -> dbgprintf "(LeftFlush)"
+ | Align -> dbgprintf "(Align)"
+ | Unalign -> dbgprintf "(Unalign)"
+ | Mark -> dbgprintf "(Mark)"
+ | Unmark -> dbgprintf "(Unmark)"
+
+(******************************************************************************)
+(* The "george" algorithm *)
+
+(* When we construct documents, most of the time they are heavily unbalanced
+ * towards the left. This is due to the left-associativity of ++ and also to
+ * the fact that constructors such as docList construct from the let of a
+ * sequence. We would prefer to shift the imbalance to the right to avoid
+ * consuming a lot of stack when we traverse the document *)
+let rec flatten (acc: doc) = function
+ | Concat (d1, d2) -> flatten (flatten acc d2) d1
+ | CText (d, s) -> flatten (Concat(Text s, acc)) d
+ | Nil -> acc (* Get rid of Nil *)
+ | d -> Concat(d, acc)
+
+(* We keep a stack of active aligns. *)
+type align =
+ { mutable gainBreak: int; (* This is the gain that is associated with
+ * taking the break associated with this
+ * alignment mark. If this is 0, then there
+ * is no break associated with the mark *)
+ mutable isTaken: bool ref; (* If breakGain is > 0 then this is a ref
+ * cell that must be set to true when the
+ * break is taken. These ref cells are also
+ * int the "breaks" list *)
+ deltaFromPrev: int ref; (* The column of this alignment mark -
+ * the column of the previous mark.
+ * Shared with the deltaToNext of the
+ * previous active align *)
+ deltaToNext: int ref (* The column of the next alignment mark -
+ * the columns of this one. Shared with
+ * deltaFromPrev of the next active align *)
+ }
+
+(* We use references to avoid the need to pass data around all the time *)
+let aligns: align list ref = (* The current stack of active alignment marks,
+ * with the top at the head. Never empty. *)
+ ref [{ gainBreak = 0; isTaken = ref false;
+ deltaFromPrev = ref 0; deltaToNext = ref 0; }]
+
+let topAlignAbsCol = ref 0 (* The absolute column of the top alignment *)
+
+let pushAlign (abscol: int) =
+ let topalign = List.hd !aligns in
+ let res =
+ { gainBreak = 0; isTaken = ref false;
+ deltaFromPrev = topalign.deltaToNext; (* Share with the previous *)
+ deltaToNext = ref 0; (* Allocate a new ref *)} in
+ aligns := res :: !aligns;
+ res.deltaFromPrev := abscol - !topAlignAbsCol;
+ topAlignAbsCol := abscol
+
+let popAlign () =
+ match !aligns with
+ top :: t when t != [] ->
+ aligns := t;
+ topAlignAbsCol := !topAlignAbsCol - !(top.deltaFromPrev)
+ | _ -> failwith "Unmatched unalign\n"
+
+(** We keep a list of active markup sections. For each one we keep the column
+ * we are in *)
+let activeMarkups: int list ref = ref []
+
+
+(* Keep a list of ref cells for the breaks, in the same order that we see
+ * them in the document *)
+let breaks: bool ref list ref = ref []
+
+(* The maximum column that we should use *)
+let maxCol = ref 0
+
+(* Sometimes we take all the optional breaks *)
+let breakAllMode = ref false
+
+(* We are taking a newline and moving left *)
+let newline () =
+ let topalign = List.hd !aligns in (* aligns is never empty *)
+ if debug then
+ dbgprintf "Taking a newline: reseting gain of %d\n" topalign.gainBreak;
+ topalign.gainBreak <- 0; (* Erase the current break info *)
+ if !breakAllMode && !topAlignAbsCol < !maxCol then
+ breakAllMode := false;
+ !topAlignAbsCol (* This is the new column *)
+
+
+
+(* Choose the align with the best gain. We outght to find a better way to
+ * keep the aligns sorted, especially since they gain never changes (when the
+ * align is the top align) *)
+let chooseBestGain () : align option =
+ let bestGain = ref 0 in
+ let rec loop (breakingAlign: align option) = function
+ [] -> breakingAlign
+ | a :: resta ->
+ if debug then dbgprintf "Looking at align with gain %d\n" a.gainBreak;
+ if a.gainBreak > !bestGain then begin
+ bestGain := a.gainBreak;
+ loop (Some a) resta
+ end else
+ loop breakingAlign resta
+ in
+ loop None !aligns
+
+
+(* Another one that chooses the break associated with the current align only *)
+let chooseLastGain () : align option =
+ let topalign = List.hd !aligns in
+ if topalign.gainBreak > 0 then Some topalign else None
+
+(* We have just advanced to a new column. See if we must take a line break *)
+let movingRight (abscol: int) : int =
+ (* Keep taking the best break until we get back to the left of maxCol or no
+ * more are left *)
+ let rec tryAgain abscol =
+ if abscol <= !maxCol then abscol else
+ begin
+ if debug then
+ dbgprintf "Looking for a break to take in column %d\n" abscol;
+ (* Find the best gain there is out there *)
+ match if !fastMode then None else chooseBestGain () with
+ None -> begin
+ (* No breaks are available. Take all breaks from now on *)
+ breakAllMode := true;
+ if debug then
+ dbgprintf "Can't find any breaks\n";
+ abscol
+ end
+ | Some breakingAlign -> begin
+ let topalign = List.hd !aligns in
+ let theGain = breakingAlign.gainBreak in
+ assert (theGain > 0);
+ if debug then dbgprintf "Taking break at %d. gain=%d\n" abscol theGain;
+ breakingAlign.isTaken := true;
+ breakingAlign.gainBreak <- 0;
+ if breakingAlign != topalign then begin
+ breakingAlign.deltaToNext :=
+ !(breakingAlign.deltaToNext) - theGain;
+ topAlignAbsCol := !topAlignAbsCol - theGain
+ end;
+ tryAgain (abscol - theGain)
+ end
+ end
+ in
+ tryAgain abscol
+
+
+(* Keep track of nested align in gprintf. Each gprintf format string must
+ * have properly nested align/unalign pairs. When the nesting depth surpasses
+ * !printDepth then we print ... and we skip until the matching unalign *)
+let printDepth = ref 10000000 (* WRW: must see whole thing *)
+let alignDepth = ref 0
+
+let useAlignDepth = true
+
+(** Start an align. Return true if we ahve just passed the threshhold *)
+let enterAlign () =
+ incr alignDepth;
+ useAlignDepth && !alignDepth = !printDepth + 1
+
+(** Exit an align *)
+let exitAlign () =
+ decr alignDepth
+
+(** See if we are at a low-enough align level (and we should be printing
+ * normally) *)
+let shallowAlign () =
+ not useAlignDepth || !alignDepth <= !printDepth
+
+
+(* Pass the current absolute column and compute the new column *)
+let rec scan (abscol: int) (d: doc) : int =
+ match d with
+ Nil -> abscol
+ | Concat (d1, d2) -> scan (scan abscol d1) d2
+ | Text s when shallowAlign () ->
+ let sl = String.length s in
+ if debug then
+ dbgprintf "Done string: %s from %d to %d\n" s abscol (abscol + sl);
+ movingRight (abscol + sl)
+ | CText (d, s) ->
+ let abscol' = scan abscol d in
+ if shallowAlign () then begin
+ let sl = String.length s in
+ if debug then
+ dbgprintf "Done string: %s from %d to %d\n" s abscol' (abscol' + sl);
+ movingRight (abscol' + sl)
+ end else
+ abscol'
+
+ | Align ->
+ pushAlign abscol;
+ if enterAlign () then
+ movingRight (abscol + 3) (* "..." *)
+ else
+ abscol
+
+ | Unalign -> exitAlign (); popAlign (); abscol
+
+ | Line when shallowAlign () -> (* A forced line break *)
+ if !activeMarkups != [] then
+ failwith "Line breaks inside markup sections";
+ newline ()
+
+ | LeftFlush when shallowAlign () -> (* Keep cursor left-flushed *) 0
+
+ | Break when shallowAlign () -> (* An optional line break. Always a space
+ * followed by an optional line break *)
+ if !activeMarkups != [] then
+ failwith "Line breaks inside markup sections";
+ let takenref = ref false in
+ breaks := takenref :: !breaks;
+ let topalign = List.hd !aligns in (* aligns is never empty *)
+ if !breakAllMode then begin
+ takenref := true;
+ newline ()
+ end else begin
+ (* If there was a previous break there it stays not taken, forever.
+ * So we overwrite it. *)
+ topalign.isTaken <- takenref;
+ topalign.gainBreak <- 1 + abscol - !topAlignAbsCol;
+ if debug then
+ dbgprintf "Registering a break at %d with gain %d\n"
+ (1 + abscol) topalign.gainBreak;
+ movingRight (1 + abscol)
+ end
+
+ | Mark -> activeMarkups := abscol :: !activeMarkups;
+ abscol
+
+ | Unmark -> begin
+ match !activeMarkups with
+ old :: rest -> activeMarkups := rest;
+ old
+ | [] -> failwith "Too many unmark"
+ end
+
+ | _ -> (* Align level is too deep *) abscol
+
+
+(** Keep a running counter of the newlines we are taking. You can read and
+ * reset this from user code, if you want *)
+let countNewLines = ref 0
+
+(* The actual function that takes a document and prints it *)
+let emitDoc
+ (emitString: string -> int -> unit) (* emit a number of copies of a
+ * string *)
+ (d: doc) =
+ let aligns: int list ref = ref [0] in (* A stack of alignment columns *)
+
+ let wantIndent = ref false in
+ (* Use this function to take a newline *)
+ (* AB: modified it to flag wantIndent. The actual indentation is done only
+ if leftflush is not encountered *)
+ let newline () =
+ match !aligns with
+ [] -> failwith "Ran out of aligns"
+ | x :: _ ->
+ emitString "\n" 1;
+ incr countNewLines;
+ wantIndent := true;
+ x
+ in
+ (* Print indentation if wantIndent was previously flagged ; reset this flag *)
+ let indentIfNeeded () =
+ if !printIndent && !wantIndent then ignore (
+ match !aligns with
+ [] -> failwith "Ran out of aligns"
+ | x :: _ ->
+ if x > 0 then emitString " " x;
+ x);
+ wantIndent := false
+ in
+ (* A continuation passing style loop *)
+ let rec loopCont (abscol: int) (d: doc) (cont: int -> unit) : unit
+ (* the new column *) =
+ match d with
+ Nil -> cont abscol
+ | Concat (d1, d2) ->
+ loopCont abscol d1 (fun abscol' -> loopCont abscol' d2 cont)
+
+ | Text s when shallowAlign () ->
+ let sl = String.length s in
+ indentIfNeeded ();
+ emitString s 1;
+ cont (abscol + sl)
+
+ | CText (d, s) ->
+ loopCont abscol d
+ (fun abscol' ->
+ if shallowAlign () then
+ let sl = String.length s in
+ indentIfNeeded ();
+ emitString s 1;
+ cont (abscol' + sl)
+ else
+ cont abscol')
+
+ | Align ->
+ aligns := abscol :: !aligns;
+ if enterAlign () then begin
+ indentIfNeeded ();
+ emitString "..." 1;
+ cont (abscol + 3)
+ end else
+ cont abscol
+
+ | Unalign -> begin
+ match !aligns with
+ [] -> failwith "Unmatched unalign"
+ | _ :: rest ->
+ exitAlign ();
+ aligns := rest; cont abscol
+ end
+ | Line when shallowAlign () -> cont (newline ())
+ | LeftFlush when shallowAlign () -> wantIndent := false; cont (0)
+ | Break when shallowAlign () -> begin
+ match !breaks with
+ [] -> failwith "Break without a takenref"
+ | istaken :: rest ->
+ breaks := rest; (* Consume the break *)
+ if !istaken then cont (newline ())
+ else begin
+ indentIfNeeded ();
+ emitString " " 1;
+ cont (abscol + 1)
+ end
+ end
+
+ | Mark ->
+ activeMarkups := abscol :: !activeMarkups;
+ cont abscol
+
+ | Unmark -> begin
+ match !activeMarkups with
+ old :: rest -> activeMarkups := rest;
+ cont old
+ | [] -> failwith "Unmark without a mark"
+ end
+
+ | _ -> (* Align is too deep *)
+ cont abscol
+ in
+
+ loopCont 0 d (fun x -> ())
+
+
+(* Print a document on a channel *)
+let fprint (chn: out_channel) ~(width: int) doc =
+ (* Save some parameters, to allow for nested calls of these routines. *)
+ maxCol := width;
+ let old_breaks = !breaks in
+ breaks := [];
+ let old_alignDepth = !alignDepth in
+ alignDepth := 0;
+ let old_activeMarkups = !activeMarkups in
+ activeMarkups := [];
+ ignore (scan 0 doc);
+ breaks := List.rev !breaks;
+ ignore (emitDoc
+ (fun s nrcopies ->
+ for i = 1 to nrcopies do
+ output_string chn s
+ done) doc);
+ activeMarkups := old_activeMarkups;
+ alignDepth := old_alignDepth;
+ breaks := old_breaks (* We must do this especially if we don't do emit
+ * (which consumes breaks) because otherwise we waste
+ * memory *)
+
+(* Print the document to a string *)
+let sprint ~(width : int) doc : string =
+ maxCol := width;
+ let old_breaks = !breaks in
+ breaks := [];
+ let old_activeMarkups = !activeMarkups in
+ activeMarkups := [];
+ let old_alignDepth = !alignDepth in
+ alignDepth := 0;
+ ignore (scan 0 doc);
+ breaks := List.rev !breaks;
+ let buf = Buffer.create 1024 in
+ let rec add_n_strings str num =
+ if num <= 0 then ()
+ else begin Buffer.add_string buf str; add_n_strings str (num - 1) end
+ in
+ emitDoc add_n_strings doc;
+ breaks := old_breaks;
+ activeMarkups := old_activeMarkups;
+ alignDepth := old_alignDepth;
+ Buffer.contents buf
+
+
+ (* The rest is based on printf.ml *)
+external format_int: string -> int -> string = "caml_format_int"
+external format_float: string -> float -> string = "caml_format_float"
+
+
+
+let gprintf (finish : doc -> 'b)
+ (format : ('a, unit, doc, 'b) format4) : 'a =
+ let format = (Obj.magic format : string) in
+
+ (* Record the starting align depth *)
+ let startAlignDepth = !alignDepth in
+ (* Special concatenation functions *)
+ let dconcat (acc: doc) (another: doc) =
+ if !alignDepth > !printDepth then acc else acc ++ another in
+ let dctext1 (acc: doc) (str: string) =
+ if !alignDepth > !printDepth then acc else
+ CText(acc, str)
+ in
+ (* Special finish function *)
+ let dfinish (dc: doc) : 'b =
+ if !alignDepth <> startAlignDepth then
+ prerr_string ("Unmatched align/unalign in " ^ format ^ "\n");
+ finish dc
+ in
+ let flen = String.length format in
+ (* Reading a format character *)
+ let fget = String.unsafe_get format in
+ (* Output a literal sequence of
+ * characters, starting at i. The
+ * character at i does not need to be
+ * checked. *)
+ let rec literal acc i =
+ let rec skipChars j =
+ if j >= flen ||
+ (match fget j with
+ '%' -> true
+ | '@' -> true
+ | '\n' -> true
+ | _ -> false) then
+ collect (dctext1 acc (String.sub format i (j-i))) j
+ else
+ skipChars (succ j)
+ in
+ skipChars (succ i)
+ (* the main collection function *)
+ and collect (acc: doc) (i: int) =
+ if i >= flen then begin
+ Obj.magic (dfinish acc)
+ end else begin
+ let c = fget i in
+ if c = '%' then begin
+ let j = skip_args (succ i) in
+ match fget j with
+ '%' -> literal acc j
+ | 's' ->
+ Obj.magic(fun s ->
+ let str =
+ if j <= i+1 then
+ s
+ else
+ let sl = String.length s in
+ let p =
+ try
+ int_of_string (String.sub format (i+1) (j-i-1))
+ with _ ->
+ invalid_arg "fprintf: bad %s format" in
+ if p > 0 && sl < p then
+ (String.make (p - sl) ' ') ^ s
+ else if p < 0 && sl < -p then
+ s ^ (String.make (-p - sl) ' ')
+ else
+ s
+ in
+ collect (breakString acc str) (succ j))
+ | 'c' ->
+ Obj.magic(fun c ->
+ collect (dctext1 acc (String.make 1 c)) (succ j))
+ | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
+ Obj.magic(fun n ->
+ collect (dctext1 acc
+ (format_int (String.sub format i
+ (j-i+1)) n))
+ (succ j))
+ (* L, l, and n are the Int64, Int32, and Nativeint modifiers to the integer
+ formats d,i,o,x,X,u. For example, %Lo means print an Int64 in octal.*)
+ | 'L' ->
+ if j != i + 1 then (*Int64.format handles simple formats like %d.
+ * Any special flags eaten by skip_args will confuse it. *)
+ invalid_arg ("dprintf: unimplemented format "
+ ^ (String.sub format i (j-i+1)));
+ let j' = succ j in (* eat the d,i,x etc. *)
+ let format_spec = "% " in
+ String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
+ Obj.magic(fun n ->
+ collect (dctext1 acc
+ (Int64.format format_spec n))
+ (succ j'))
+ | 'l' ->
+ if j != i + 1 then invalid_arg ("dprintf: unimplemented format "
+ ^ (String.sub format i (j-i+1)));
+ let j' = succ j in (* eat the d,i,x etc. *)
+ let format_spec = "% " in
+ String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
+ Obj.magic(fun n ->
+ collect (dctext1 acc
+ (Int32.format format_spec n))
+ (succ j'))
+ | 'n' ->
+ if j != i + 1 then invalid_arg ("dprintf: unimplemented format "
+ ^ (String.sub format i (j-i+1)));
+ let j' = succ j in (* eat the d,i,x etc. *)
+ let format_spec = "% " in
+ String.set format_spec 1 (fget j'); (* format_spec = "%x", etc. *)
+ Obj.magic(fun n ->
+ collect (dctext1 acc
+ (Nativeint.format format_spec n))
+ (succ j'))
+ | 'f' | 'e' | 'E' | 'g' | 'G' ->
+ Obj.magic(fun f ->
+ collect (dctext1 acc
+ (format_float (String.sub format i (j-i+1)) f))
+ (succ j))
+ | 'b' | 'B' ->
+ Obj.magic(fun b ->
+ collect (dctext1 acc (string_of_bool b)) (succ j))
+ | 'a' ->
+ Obj.magic(fun pprinter arg ->
+ collect (dconcat acc (pprinter () arg)) (succ j))
+ | 't' ->
+ Obj.magic(fun pprinter ->
+ collect (dconcat acc (pprinter ())) (succ j))
+ | c ->
+ invalid_arg ("dprintf: unknown format %s" ^ String.make 1 c)
+
+ end else if c = '@' then begin
+ if i + 1 < flen then begin
+ match fget (succ i) with
+
+ (* Now the special format characters *)
+ '[' -> (* align *)
+ let newacc =
+ if !alignDepth > !printDepth then
+ acc
+ else if !alignDepth = !printDepth then
+ CText(acc, "...")
+ else
+ acc ++ align
+ in
+ incr alignDepth;
+ collect newacc (i + 2)
+
+ | ']' -> (* unalign *)
+ decr alignDepth;
+ let newacc =
+ if !alignDepth >= !printDepth then
+ acc
+ else
+ acc ++ unalign
+ in
+ collect newacc (i + 2)
+ | '!' -> (* hard-line break *)
+ collect (dconcat acc line) (i + 2)
+ | '?' -> (* soft line break *)
+ collect (dconcat acc (break)) (i + 2)
+ | '<' ->
+ collect (dconcat acc mark) (i +1)
+ | '>' ->
+ collect (dconcat acc unmark) (i +1)
+ | '^' -> (* left-flushed *)
+ collect (dconcat acc (leftflush)) (i + 2)
+ | '@' ->
+ collect (dctext1 acc "@") (i + 2)
+ | c ->
+ invalid_arg ("dprintf: unknown format @" ^ String.make 1 c)
+ end else
+ invalid_arg "dprintf: incomplete format @"
+ end else if c = '\n' then begin
+ collect (dconcat acc line) (i + 1)
+ end else
+ literal acc i
+ end
+
+ and skip_args j =
+ match String.unsafe_get format j with
+ '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
+ | c -> j
+
+ in
+ collect Nil 0
+
+let withPrintDepth dp thunk =
+ let opd = !printDepth in
+ printDepth := dp;
+ thunk ();
+ printDepth := opd
+
+
+
+let flushOften = ref false
+
+let dprintf format = gprintf (fun x -> x) format
+let fprintf chn format =
+ let f d = fprint chn 80 d; d in
+ (* weimeric hack begins -- flush output to streams *)
+ let res = gprintf f format in
+ (* save the value we would have returned, flush the channel and then
+ * return it -- this allows us to see debug input near infinite loops
+ * *)
+ if !flushOften then flush chn;
+ res
+ (* weimeric hack ends *)
+
+let printf format = fprintf stdout format
+let eprintf format = fprintf stderr format
+
+
+
+(******************************************************************************)
+let getAlgoName = function
+ George -> "George"
+ | Aman -> "Aman"
+ | Gap -> "Gap"
+
+let getAboutString () : string =
+ "(Pretty: ALGO=" ^ (getAlgoName algo) ^ ")"
+
+
+(************************************************)
+let auto_printer (typ: string) =
+ failwith ("Pretty.auto_printer \"" ^ typ ^ "\" only works with you use -pp \"camlp4o pa_prtype.cmo\" when you compile")
diff --git a/cil/ocamlutil/pretty.mli b/cil/ocamlutil/pretty.mli
new file mode 100644
index 0000000..5422432
--- /dev/null
+++ b/cil/ocamlutil/pretty.mli
@@ -0,0 +1,316 @@
+(*
+ *
+ * Copyright (c) 2001 by
+ * George C. Necula necula@cs.berkeley.edu
+ * Scott McPeak smcpeak@cs.berkeley.edu
+ * Wes Weimer weimer@cs.berkeley.edu
+ *
+ * All rights reserved. Permission to use, copy, modify and distribute
+ * this software for research purposes only is hereby granted,
+ * provided that the following conditions are met:
+ * 1. Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the authors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * DISCLAIMER:
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** Utility functions for pretty-printing. The major features provided by
+ this module are
+- An [fprintf]-style interface with support for user-defined printers
+- The printout is fit to a width by selecting some of the optional newlines
+- Constructs for alignment and indentation
+- Print ellipsis starting at a certain nesting depth
+- Constructs for printing lists and arrays
+
+ Pretty-printing occurs in two stages:
+- Construct a {!Pretty.doc} object that encodes all of the elements to be
+ printed
+ along with alignment specifiers and optional and mandatory newlines
+- Format the {!Pretty.doc} to a certain width and emit it as a string, to an
+ output stream or pass it to a user-defined function
+
+ The formatting algorithm is not optimal but it does a pretty good job while
+ still operating in linear time. The original version was based on a pretty
+ printer by Philip Wadler which turned out to not scale to large jobs.
+*)
+
+(** API *)
+
+(** The type of unformated documents. Elements of this type can be
+ * constructed in two ways. Either with a number of constructor shown below,
+ * or using the {!Pretty.dprintf} function with a [printf]-like interface.
+ * The {!Pretty.dprintf} method is slightly slower so we do not use it for
+ * large jobs such as the output routines for a compiler. But we use it for
+ * small jobs such as logging and error messages. *)
+type doc
+
+
+
+(** Constructors for the doc type. *)
+
+
+
+
+(** Constructs an empty document *)
+val nil : doc
+
+
+(** Concatenates two documents. This is an infix operator that associates to
+ the left. *)
+val (++) : doc -> doc -> doc
+val concat : doc -> doc -> doc
+
+(** A document that prints the given string *)
+val text : string -> doc
+
+
+(** A document that prints an integer in decimal form *)
+val num : int -> doc
+
+
+(** A document that prints a real number *)
+val real : float -> doc
+
+(** A document that prints a character. This is just like {!Pretty.text}
+ with a one-character string. *)
+val chr : char -> doc
+
+
+(** A document that consists of a mandatory newline. This is just like [(text
+ "\n")]. The new line will be indented to the current indentation level,
+ unless you use {!Pretty.leftflush} right after this. *)
+val line : doc
+
+(** Use after a {!Pretty.line} to prevent the indentation. Whatever follows
+ * next will be flushed left. Indentation resumes on the next line. *)
+val leftflush : doc
+
+
+(** A document that consists of either a space or a line break. Also called
+ an optional line break. Such a break will be
+ taken only if necessary to fit the document in a given width. If the break
+ is not taken a space is printed instead. *)
+val break: doc
+
+(** Mark the current column as the current indentation level. Does not print
+ anything. All taken line breaks will align to this column. The previous
+ alignment level is saved on a stack. *)
+val align: doc
+
+(** Reverts to the last saved indentation level. *)
+val unalign: doc
+
+
+(** Mark the beginning of a markup section. The width of a markup section is
+ * considered 0 for the purpose of computing identation *)
+val mark: doc
+
+(** The end of a markup section *)
+val unmark: doc
+
+(************* Now some syntactic sugar *****************)
+(** Syntactic sugar *)
+
+(** Indents the document. Same as [((text " ") ++ align ++ doc ++ unalign)],
+ with the specified number of spaces. *)
+val indent: int -> doc -> doc
+
+(** Prints a document as markup. The marked document cannot contain line
+ * breaks or alignment constructs. *)
+val markup: doc -> doc
+
+(** Formats a sequence. [sep] is a separator, [doit] is a function that
+ * converts an element to a document. *)
+val seq: sep:doc -> doit:('a ->doc) -> elements:'a list -> doc
+
+
+(** An alternative function for printing a list. The [unit] argument is there
+ * to make this function more easily usable with the {!Pretty.dprintf}
+ * interface. The first argument is a separator, by default a comma. *)
+val docList: ?sep:doc -> ('a -> doc) -> unit -> 'a list -> doc
+
+(** sm: Yet another list printer. This one accepts the same kind of
+ * printing function that {!Pretty.dprintf} does, and itself works
+ * in the dprintf context. Also accepts
+ * a string as the separator since that's by far the most common. *)
+val d_list: string -> (unit -> 'a -> doc) -> unit -> 'a list -> doc
+
+(** Formats an array. A separator and a function that prints an array
+ element. The default separator is a comma. *)
+val docArray: ?sep:doc -> (int -> 'a -> doc) -> unit -> 'a array -> doc
+
+(** Prints an ['a option] with [None] or [Some] *)
+val docOpt: ('a -> doc) -> unit -> 'a option -> doc
+
+
+(** Print an int32 *)
+val d_int32: int32 -> doc
+val f_int32: unit -> int32 -> doc
+
+val d_int64: int64 -> doc
+val f_int64: unit -> int64 -> doc
+
+(** Format maps. *)
+module MakeMapPrinter :
+ functor (Map: sig
+ type key
+ type 'a t
+ val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ end) ->
+sig
+ (** Format a map, analogous to docList. *)
+ val docMap: ?sep:doc -> (Map.key -> 'a -> doc) -> unit -> 'a Map.t -> doc
+
+ (** Format a map, analogous to d_list. *)
+ val d_map: ?dmaplet:(doc -> doc -> doc)
+ -> string
+ -> (unit -> Map.key -> doc)
+ -> (unit -> 'a -> doc)
+ -> unit
+ -> 'a Map.t
+ -> doc
+ end
+
+(** Format sets. *)
+module MakeSetPrinter :
+ functor (Set: sig
+ type elt
+ type t
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ end) ->
+sig
+ (** Format a set, analogous to docList. *)
+ val docSet: ?sep:doc -> (Set.elt -> doc) -> unit -> Set.t -> doc
+
+ (** Format a set, analogous to d_list. *)
+ val d_set: string
+ -> (unit -> Set.elt -> doc)
+ -> unit
+ -> Set.t
+ -> doc
+end
+
+(** A function that is useful with the [printf]-like interface *)
+val insert: unit -> doc -> doc
+
+val dprintf: ('a, unit, doc, doc) format4 -> 'a
+(** This function provides an alternative method for constructing
+ [doc] objects. The first argument for this function is a format string
+ argument (of type [('a, unit, doc) format]; if you insist on
+ understanding what that means see the module [Printf]). The format string
+ is like that for the [printf] function in C, except that it understands a
+ few more formatting controls, all starting with the @ character.
+
+ See the gprintf function if you want to pipe the result of dprintf into
+ some other functions.
+
+ The following special formatting characters are understood (these do not
+ correspond to arguments of the function):
+- @\[ Inserts an {!Pretty.align}. Every format string must have matching
+ {!Pretty.align} and {!Pretty.unalign}.
+- @\] Inserts an {!Pretty.unalign}.
+- @! Inserts a {!Pretty.line}. Just like "\n"
+- @? Inserts a {!Pretty.break}.
+- @< Inserts a {!Pretty.mark}.
+- @> Inserts a {!Pretty.unmark}.
+- @^ Inserts a {!Pretty.leftflush}
+ Should be used immediately after @! or "\n".
+- @@ : inserts a @ character
+
+ In addition to the usual [printf] % formatting characters the following two
+ new characters are supported:
+- %t Corresponds to an argument of type [unit -> doc]. This argument is
+ invoked to produce a document
+- %a Corresponds to {b two} arguments. The first of type [unit -> 'a -> doc]
+ and the second of type ['a]. (The extra [unit] is do to the
+ peculiarities of the built-in support for format strings in Ocaml. It
+ turns out that it is not a major problem.) Here is an example of how
+ you use this:
+
+{v dprintf "Name=%s, SSN=%7d, Children=\@\[%a\@\]\n"
+ pers.name pers.ssn (docList (chr ',' ++ break) text)
+ pers.children v}
+
+ The result of [dprintf] is a {!Pretty.doc}. You can format the document and
+ emit it using the functions {!Pretty.fprint} and {!Pretty.sprint}.
+
+*)
+
+(** Like {!Pretty.dprintf} but more general. It also takes a function that is
+ * invoked on the constructed document but before any formatting is done. The
+ * type of the format argument means that 'a is the type of the parameters of
+ * this function, unit is the type of the first argument to %a and %t
+ * formats, doc is the type of the intermediate result, and 'b is the type of
+ * the result of gprintf. *)
+val gprintf: (doc -> 'b) -> ('a, unit, doc, 'b) format4 -> 'a
+
+(** Format the document to the given width and emit it to the given channel *)
+val fprint: out_channel -> width:int -> doc -> unit
+
+(** Format the document to the given width and emit it as a string *)
+val sprint: width:int -> doc -> string
+
+(** Like {!Pretty.dprintf} followed by {!Pretty.fprint} *)
+val fprintf: out_channel -> ('a, unit, doc) format -> 'a
+
+(** Like {!Pretty.fprintf} applied to [stdout] *)
+val printf: ('a, unit, doc) format -> 'a
+
+(** Like {!Pretty.fprintf} applied to [stderr] *)
+val eprintf: ('a, unit, doc) format -> 'a
+
+
+(* sm: arg! why can't I write this function?! *)
+(* * Like {!Pretty.dprintf} but yielding a string with no newlines *)
+(*val sprintf: (doc, unit, doc) format -> string*)
+
+(* sm: different tack.. *)
+(* doesn't work either. well f it anyway *)
+(*val failwithf: ('a, unit, doc) format -> 'a*)
+
+
+(** Invokes a thunk, with printDepth temporarily set to the specified value *)
+val withPrintDepth : int -> (unit -> unit) -> unit
+
+(** The following variables can be used to control the operation of the printer *)
+
+(** Specifies the nesting depth of the [align]/[unalign] pairs at which
+ everything is replaced with ellipsis *)
+val printDepth : int ref
+
+val printIndent : bool ref (** If false then does not indent *)
+
+
+(** If set to [true] then optional breaks are taken only when the document
+ has exceeded the given width. This means that the printout will looked
+ more ragged but it will be faster *)
+val fastMode : bool ref
+
+val flushOften : bool ref (** If true the it flushes after every print *)
+
+
+(** Keep a running count of the taken newlines. You can read and write this
+ * from the client code if you want *)
+val countNewLines : int ref
+
+
+(** A function that when used at top-level in a module will direct
+ * the pa_prtype module generate automatically the printing functions for a
+ * type *)
+val auto_printer: string -> 'b
diff --git a/cil/ocamlutil/stats.ml b/cil/ocamlutil/stats.ml
new file mode 100644
index 0000000..8bbb7d0
--- /dev/null
+++ b/cil/ocamlutil/stats.ml
@@ -0,0 +1,146 @@
+(* The following functions are implemented in perfcount.c *)
+
+(* Returns true is we have the performance counters *)
+external has_performance_counters: unit -> bool = "has_performance_counters"
+
+(* Returns number of seconds since the first read *)
+external read_pentium_perfcount : unit -> float = "read_pentium_perfcount"
+
+(* Returns current cycle counter, divided by 1^20, and truncated to 30 bits *)
+external sample_pentium_perfcount_20 : unit -> int = "sample_pentium_perfcount_20"
+
+(* Returns current cycle counter, divided by 1^10, and truncated to 30 bits *)
+external sample_pentium_perfcount_10 : unit -> int = "sample_pentium_perfcount_10"
+
+
+(* Whether to use the performance counters (on Pentium only) *)
+
+(* The performance counters are disabled by default. *)
+let do_use_performance_counters = ref false
+
+ (* A hierarchy of timings *)
+
+type t = { name : string;
+ mutable time : float; (* In seconds *)
+ mutable sub : t list}
+
+ (* Create the top level *)
+let top = { name = "TOTAL";
+ time = 0.0;
+ sub = []; }
+
+ (* The stack of current path through
+ * the hierarchy. The first is the
+ * leaf. *)
+let current : t list ref = ref [top]
+
+exception NoPerfCount
+let reset (perfcount: bool) =
+ top.sub <- [];
+ if perfcount then begin
+ if not (has_performance_counters ()) then begin
+ raise NoPerfCount
+ end
+ end;
+ do_use_performance_counters := perfcount
+
+
+
+let print chn msg =
+ (* Total up *)
+ top.time <- List.fold_left (fun sum f -> sum +. f.time) 0.0 top.sub;
+ let rec prTree ind node =
+ if !do_use_performance_counters then
+ (Printf.fprintf chn "%s%-20s %8.5f s\n"
+ (String.make ind ' ') node.name node.time)
+ else
+ (Printf.fprintf chn "%s%-20s %6.3f s\n"
+ (String.make ind ' ') node.name node.time);
+
+ List.iter (prTree (ind + 2)) (List.rev node.sub)
+ in
+ Printf.fprintf chn "%s" msg;
+ List.iter (prTree 0) [ top ];
+ Printf.fprintf chn "Timing used %s\n"
+ (if !do_use_performance_counters then "Pentium performance counters"
+ else "Unix.time");
+ let gc = Gc.quick_stat () in
+ let printM (w: float) : string =
+ Printf.sprintf "%.2fMb" (w *. 4.0 /. 1000000.0)
+ in
+ Printf.fprintf chn
+ "Memory statistics: total=%s, max=%s, minor=%s, major=%s, promoted=%s\n minor collections=%d major collections=%d compactions=%d\n"
+ (printM (gc.Gc.minor_words +. gc.Gc.major_words
+ -. gc.Gc.promoted_words))
+ (printM (float_of_int gc.Gc.top_heap_words))
+ (printM gc.Gc.minor_words)
+ (printM gc.Gc.major_words)
+ (printM gc.Gc.promoted_words)
+ gc.Gc.minor_collections
+ gc.Gc.major_collections
+ gc.Gc.compactions;
+
+ ()
+
+
+
+(* Get the current time, in seconds *)
+let get_current_time () : float =
+ if !do_use_performance_counters then
+ read_pentium_perfcount ()
+ else
+ (Unix.times ()).Unix.tms_utime
+
+let repeattime limit str f arg =
+ (* Find the right stat *)
+ let stat : t =
+ let curr = match !current with h :: _ -> h | _ -> assert false in
+ let rec loop = function
+ h :: _ when h.name = str -> h
+ | _ :: rest -> loop rest
+ | [] ->
+ let nw = {name = str; time = 0.0; sub = []} in
+ curr.sub <- nw :: curr.sub;
+ nw
+ in
+ loop curr.sub
+ in
+ let oldcurrent = !current in
+ current := stat :: oldcurrent;
+ let start = get_current_time () in
+ let rec repeatf count =
+ let res = f arg in
+ let diff = get_current_time () -. start in
+ if diff < limit then
+ repeatf (count + 1)
+ else begin
+ stat.time <- stat.time +. (diff /. float(count));
+ current := oldcurrent; (* Pop the current stat *)
+ res (* Return the function result *)
+ end
+ in
+ repeatf 1
+
+
+let time str f arg = repeattime 0.0 str f arg
+
+
+let lastTime = ref 0.0
+let timethis (f: 'a -> 'b) (arg: 'a) : 'b =
+ let start = get_current_time () in
+ let res = f arg in
+ lastTime := get_current_time () -. start;
+ res
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/cil/ocamlutil/stats.mli b/cil/ocamlutil/stats.mli
new file mode 100644
index 0000000..9ed98e5
--- /dev/null
+++ b/cil/ocamlutil/stats.mli
@@ -0,0 +1,72 @@
+(*
+ *
+ * Copyright (c) 2001 by
+ * George C. Necula necula@cs.berkeley.edu
+ * Scott McPeak smcpeak@cs.berkeley.edu
+ * Wes Weimer weimer@cs.berkeley.edu
+ *
+ * All rights reserved. Permission to use, copy, modify and distribute
+ * this software for research purposes only is hereby granted,
+ * provided that the following conditions are met:
+ * 1. Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the authors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * DISCLAIMER:
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** Utilities for maintaining timing statistics *)
+
+(** Resets all the timings. Invoke with "true" if you want to switch to using
+ * the hardware performance counters from now on. You get an exception if
+ * there are not performance counters available *)
+val reset: bool -> unit
+exception NoPerfCount
+
+(** Check if we have performance counters *)
+val has_performance_counters: unit -> bool
+
+(** Sample the current cycle count, in megacycles. *)
+val sample_pentium_perfcount_20: unit -> int
+
+(** Sample the current cycle count, in kilocycles. *)
+val sample_pentium_perfcount_10: unit -> int
+
+(** Time a function and associate the time with the given string. If some
+ timing information is already associated with that string, then accumulate
+ the times. If this function is invoked within another timed function then
+ you can have a hierarchy of timings *)
+val time : string -> ('a -> 'b) -> 'a -> 'b
+
+(** repeattime is like time but runs the function several times until the total
+ running time is greater or equal to the first argument. The total time is
+ then divided by the number of times the function was run. *)
+val repeattime : float -> string -> ('a -> 'b) -> 'a -> 'b
+
+(** Print the current stats preceeded by a message *)
+val print : out_channel -> string -> unit
+
+
+
+(** Time a function and set lastTime to the time it took *)
+val lastTime: float ref
+val timethis: ('a -> 'b) -> 'a -> 'b
+
+
+
+
diff --git a/cil/ocamlutil/trace.ml b/cil/ocamlutil/trace.ml
new file mode 100644
index 0000000..b429286
--- /dev/null
+++ b/cil/ocamlutil/trace.ml
@@ -0,0 +1,169 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* Trace module implementation
+ * see trace.mli
+ *)
+
+open Pretty;;
+
+
+(* --------- traceSubsystems --------- *)
+(* this is the list of tags (usually subsystem names) for which
+ * trace output will appear *)
+let traceSubsystems : string list ref = ref [];;
+
+
+let traceAddSys (subsys : string) : unit =
+ (* (ignore (printf "traceAddSys %s\n" subsys)); *)
+ traceSubsystems := subsys :: !traceSubsystems
+;;
+
+
+let traceActive (subsys : string) : bool =
+ (* (List.mem elt list) returns true if something in list equals ('=') elt *)
+ (List.mem subsys !traceSubsystems)
+;;
+
+
+let rec parseString (str : string) (delim : char) : string list =
+begin
+ if (not (String.contains str delim)) then
+ if ((String.length str) = 0) then
+ []
+ else
+ [str]
+
+ else
+ let d = ((String.index str delim) + 1) in
+ if (d = 1) then
+ (* leading delims are eaten *)
+ (parseString (String.sub str d ((String.length str) - d)) delim)
+ else
+ (String.sub str 0 (d-1)) ::
+ (parseString (String.sub str d ((String.length str) - d)) delim)
+end;;
+
+let traceAddMulti (systems : string) : unit =
+begin
+ let syslist = (parseString systems ',') in
+ (List.iter traceAddSys syslist)
+end;;
+
+
+
+(* --------- traceIndent --------- *)
+let traceIndentLevel : int ref = ref 0;;
+
+
+let traceIndent (sys : string) : unit =
+ if (traceActive sys) then
+ traceIndentLevel := !traceIndentLevel + 2
+;;
+
+let traceOutdent (sys : string) : unit =
+ if ((traceActive sys) &&
+ (!traceIndentLevel >= 2)) then
+ traceIndentLevel := !traceIndentLevel - 2
+;;
+
+
+(* --------- trace --------- *)
+(* return a tag to prepend to a trace output
+ * e.g. " %%% mysys: "
+ *)
+let traceTag (sys : string) : Pretty.doc =
+ (* return string of 'i' spaces *)
+ let rec ind (i : int) : string =
+ if (i <= 0) then
+ ""
+ else
+ " " ^ (ind (i-1))
+
+ in
+ (text ((ind !traceIndentLevel) ^ "%%% " ^ sys ^ ": "))
+;;
+
+
+(* this is the trace function; its first argument is a string
+ * tag, and subsequent arguments are like printf formatting
+ * strings ("%a" and whatnot) *)
+let trace
+ (subsys : string) (* subsystem identifier for enabling tracing *)
+ (d : Pretty.doc) (* something made by 'dprintf' *)
+ : unit = (* no return value *)
+ (* (ignore (printf "trace %s\n" subsys)); *)
+
+ (* see if the subsystem's tracing is turned on *)
+ if (traceActive subsys) then
+ begin
+ (fprint stderr 80 (* print it *)
+ ((traceTag subsys) ++ d)); (* with prepended subsys tag *)
+ (* mb: flush after every message; useful if the program hangs in an
+ infinite loop... *)
+ (flush stderr)
+ end
+ else
+ () (* eat it *)
+;;
+
+
+let tracei (sys : string) (d : Pretty.doc) : unit =
+ (* trace before indent *)
+ (trace sys d);
+ (traceIndent sys)
+;;
+
+let traceu (sys : string) (d : Pretty.doc) : unit =
+ (* trace after outdent *)
+ (* no -- I changed my mind -- I want trace *then* outdent *)
+ (trace sys d);
+ (traceOutdent sys)
+;;
+
+
+
+
+(* -------------------------- trash --------------------- *)
+(* TRASH START
+
+(* sm: more experimenting *)
+(trace "no" (dprintf "no %d\n" 5));
+(trace "yes" (dprintf "yes %d\n" 6));
+(trace "maybe" (dprintf "maybe %d\n" 7));
+
+TRASH END *)
diff --git a/cil/ocamlutil/trace.mli b/cil/ocamlutil/trace.mli
new file mode 100644
index 0000000..46ca652
--- /dev/null
+++ b/cil/ocamlutil/trace.mli
@@ -0,0 +1,106 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* Trace module
+ * Scott McPeak, 5/4/00
+ *
+ * The idea is to pepper the source with debugging printfs,
+ * and be able to select which ones to actually display at
+ * runtime.
+ *
+ * It is built on top of the Pretty module for printing data
+ * structures.
+ *
+ * To a first approximation, this is needed to compensate for
+ * the lack of a debugger that does what I want...
+ *)
+
+
+(* this is the list of tags (usually subsystem names) for which
+ * trace output will appear *)
+val traceSubsystems : string list ref
+
+(* interface to add a new subsystem to trace (slightly more
+ * convenient than direclty changing 'tracingSubsystems') *)
+val traceAddSys : string -> unit
+
+(* query whether a particular subsystem is being traced *)
+val traceActive : string -> bool
+
+(* add several systems, separated by commas *)
+val traceAddMulti : string -> unit
+
+
+(* current indentation level for tracing *)
+val traceIndentLevel : int ref
+
+(* bump up or down the indentation level, if the given subsys
+ * is being traced *)
+val traceIndent : string -> unit
+val traceOutdent : string -> unit
+
+
+(* this is the trace function; its first argument is a string
+ * tag, and second argument is a 'doc' (which is what 'dprintf'
+ * returns).
+ *
+ * so a sample usage might be
+ * (trace "mysubsys" (dprintf "something neat happened %d times\n" counter))
+ *)
+val trace : string -> Pretty.doc -> unit
+
+
+(* special flavors that indent/outdent as well. the indent version
+ * indents *after* printing, while the outdent version outdents
+ * *before* printing. thus, a sequence like
+ *
+ * (tracei "foo" (dprintf "beginning razzle-dazzle\n"))
+ * ..razzle..
+ * ..dazzle..
+ * (traceu "foo" (dprintf "done with razzle-dazzle\n"))
+ *
+ * will do the right thing
+ *
+ * update -- I changed my mind! I decided I prefer it like this
+ * %%% sys: (myfunc args)
+ * %%% ...inner stuff...
+ * %%% sys: myfunc returning 56
+ *
+ * so now they both print before in/outdenting
+ *)
+val tracei : string -> Pretty.doc -> unit
+val traceu : string -> Pretty.doc -> unit
diff --git a/cil/ocamlutil/util.ml b/cil/ocamlutil/util.ml
new file mode 100755
index 0000000..e6c2c67
--- /dev/null
+++ b/cil/ocamlutil/util.ml
@@ -0,0 +1,815 @@
+(** Utility functions for Coolaid *)
+module E = Errormsg
+module H = Hashtbl
+module IH = Inthash
+
+open Pretty
+
+exception GotSignal of int
+
+let withTimeout (secs: float) (* Seconds for timeout *)
+ (handler: int -> 'b) (* What to do if we have a timeout. The
+ * argument passed is the signal number
+ * received. *)
+ (f: 'a -> 'b) (* The function to run *)
+ (arg: 'a) (* And its argument *)
+ : 'b =
+ let oldHandler =
+ Sys.signal Sys.sigalrm
+ (Sys.Signal_handle
+ (fun i ->
+ ignore (E.log "Got signal %d\n" i);
+ raise (GotSignal i)))
+ in
+ let reset_sigalrm () =
+ ignore (Unix.setitimer Unix.ITIMER_REAL { Unix.it_value = 0.0;
+ Unix.it_interval = 0.0;});
+ Sys.set_signal Sys.sigalrm oldHandler;
+ in
+ ignore (Unix.setitimer Unix.ITIMER_REAL
+ { Unix.it_value = secs;
+ Unix.it_interval = 0.0;});
+ (* ignore (Unix.alarm 2); *)
+ try
+ let res = f arg in
+ reset_sigalrm ();
+ res
+ with exc -> begin
+ reset_sigalrm ();
+ ignore (E.log "Got an exception\n");
+ match exc with
+ GotSignal i ->
+ handler i
+ | _ -> raise exc
+ end
+
+(** Print a hash table *)
+let docHash ?(sep=chr ',') (one: 'a -> 'b -> doc) () (h: ('a, 'b) H.t) =
+ (H.fold
+ (fun key data acc ->
+ if acc == align then acc ++ one key data
+ else acc ++ sep ++ one key data)
+ h
+ align) ++ unalign
+
+
+
+let hash_to_list (h: ('a, 'b) H.t) : ('a * 'b) list =
+ H.fold
+ (fun key data acc -> (key, data) :: acc)
+ h
+ []
+
+let keys (h: ('a, 'b) H.t) : 'a list =
+ H.fold
+ (fun key data acc -> key :: acc)
+ h
+ []
+
+let hash_copy_into (hfrom: ('a, 'b) H.t) (hto: ('a, 'b) H.t) : unit =
+ H.clear hto;
+ H.iter (H.add hto) hfrom
+
+let anticompare a b = compare b a
+;;
+
+
+let rec list_drop (n : int) (xs : 'a list) : 'a list =
+ if n < 0 then invalid_arg "Util.list_drop";
+ if n = 0 then
+ xs
+ else begin
+ match xs with
+ | [] -> invalid_arg "Util.list_drop"
+ | y::ys -> list_drop (n-1) ys
+ end
+
+let list_droptail (n : int) (xs : 'a list) : 'a list =
+ if n < 0 then invalid_arg "Util.list_droptail";
+ let (ndrop,r) =
+ List.fold_right
+ (fun x (ndrop,acc) ->
+ if ndrop = 0 then (ndrop, x :: acc)
+ else (ndrop-1, acc))
+ xs
+ (n,[])
+ in
+ if ndrop > 0 then invalid_arg "Util.listdroptail"
+ else r
+
+let rec list_span (p : 'a -> bool) (xs : 'a list) : 'a list * 'a list =
+ begin match xs with
+ | [] -> ([],[])
+ | x::xs' ->
+ if p x then
+ let (ys,zs) = list_span p xs' in (x::ys,zs)
+ else ([],xs)
+ end
+;;
+
+let rec list_rev_append revxs ys =
+ begin match revxs with
+ | [] -> ys
+ | x::xs -> list_rev_append xs (x::ys)
+ end
+;;
+let list_insert_by (cmp : 'a -> 'a -> int)
+ (x : 'a) (xs : 'a list) : 'a list =
+ let rec helper revhs ts =
+ begin match ts with
+ | [] -> List.rev (x::revhs)
+ | t::ts' ->
+ if cmp x t >= 0 then helper (t::revhs) ts'
+ else list_rev_append (x::revhs) ts
+ end
+ in
+ helper [] xs
+;;
+
+let list_head_default (d : 'a) (xs : 'a list) : 'a =
+ begin match xs with
+ | [] -> d
+ | x::_ -> x
+ end
+;;
+
+let rec list_iter3 f xs ys zs =
+ begin match xs, ys, zs with
+ | [], [], [] -> ()
+ | x::xs, y::ys, z::zs -> f x y z; list_iter3 f xs ys zs
+ | _ -> invalid_arg "Util.list_iter3"
+ end
+;;
+
+let rec get_some_option_list (xs : 'a option list) : 'a list =
+ begin match xs with
+ | [] -> []
+ | None::xs -> get_some_option_list xs
+ | Some x::xs -> x :: get_some_option_list xs
+ end
+;;
+
+(* tail-recursive append: reverses xs twice *)
+let list_append (xs: 'a list) (ys: 'a list): 'a list =
+ match xs with (* optimize some common cases *)
+ [] -> ys
+ | [x] -> x::ys
+ | _ -> list_rev_append (List.rev xs) ys
+
+let list_iteri (f: int -> 'a -> unit) (l: 'a list) : unit =
+ let rec loop (i: int) (l: 'a list) : unit =
+ match l with
+ [] -> ()
+ | h :: t -> f i h; loop (i + 1) t
+ in
+ loop 0 l
+
+let list_mapi (f: int -> 'a -> 'b) (l: 'a list) : 'b list =
+ let rec loop (i: int) (l: 'a list) : 'b list =
+ match l with
+ [] -> []
+ | h :: t ->
+ let headres = f i h in
+ headres :: loop (i + 1) t
+ in
+ loop 0 l
+
+let list_fold_lefti (f: 'acc -> int -> 'a -> 'acc) (start: 'acc)
+ (l: 'a list) : 'acc =
+ let rec loop (i, acc) l =
+ match l with
+ [] -> acc
+ | h :: t -> loop (i + 1, f acc i h) t
+ in
+ loop (0, start) l
+
+
+let list_init (len : int) (init_fun : int -> 'a) : 'a list =
+ let rec loop n acc =
+ if n < 0 then acc
+ else loop (n-1) ((init_fun n)::acc)
+ in
+ loop (len - 1) []
+;;
+
+
+let rec list_find_first (l: 'a list) (f: 'a -> 'b option) : 'b option =
+ match l with
+ [] -> None
+ | h :: t -> begin
+ match f h with
+ None -> list_find_first t f
+ | r -> r
+ end
+
+(** Generates the range of integers starting with a and ending with b *)
+let int_range_list (a: int) (b: int) =
+ list_init (b - a + 1) (fun i -> a + i)
+
+
+(** Some handling of registers *)
+type 'a growArrayFill =
+ Elem of 'a
+ | Susp of (int -> 'a)
+
+type 'a growArray = {
+ gaFill: 'a growArrayFill;
+ (** Stuff to use to fill in the array as it grows *)
+
+ mutable gaMaxInitIndex: int;
+ (** Maximum index that was written to. -1 if no writes have
+ * been made. *)
+
+ mutable gaData: 'a array;
+ }
+
+let growTheArray (ga: 'a growArray) (len: int)
+ (toidx: int) (why: string) : unit =
+ if toidx >= len then begin
+ (* Grow the array by 50% *)
+ let newlen = toidx + 1 + len / 2 in
+(*
+ ignore (E.log "growing an array to idx=%d (%s)\n" toidx why);
+*)
+ let data' = begin match ga.gaFill with
+ Elem x ->
+
+ let data'' = Array.create newlen x in
+ Array.blit ga.gaData 0 data'' 0 len;
+ data''
+ | Susp f -> Array.init newlen
+ (fun i -> if i < len then ga.gaData.(i) else f i)
+ end
+ in
+ ga.gaData <- data'
+ end
+
+let getReg (ga: 'a growArray) (r: int) : 'a =
+ let len = Array.length ga.gaData in
+ if r >= len then
+ growTheArray ga len r "get";
+
+ ga.gaData.(r)
+
+let setReg (ga: 'a growArray) (r: int) (what: 'a) : unit =
+ let len = Array.length ga.gaData in
+ if r >= len then
+ growTheArray ga len r "set";
+ if r > ga.gaMaxInitIndex then ga.gaMaxInitIndex <- r;
+ ga.gaData.(r) <- what
+
+let newGrowArray (initsz: int) (fill: 'a growArrayFill) : 'a growArray =
+ { gaFill = fill;
+ gaMaxInitIndex = -1;
+ gaData = begin match fill with
+ Elem x -> Array.create initsz x
+ | Susp f -> Array.init initsz f
+ end; }
+
+let copyGrowArray (ga: 'a growArray) : 'a growArray =
+ { ga with gaData = Array.copy ga.gaData }
+
+let deepCopyGrowArray (ga: 'a growArray) (copy: 'a -> 'a): 'a growArray =
+ { ga with gaData = Array.map copy ga.gaData }
+
+
+
+(** Iterate over the initialized elements of the array *)
+let growArray_iteri (f: int -> 'a -> unit) (ga: 'a growArray) =
+ for i = 0 to ga.gaMaxInitIndex do
+ f i ga.gaData.(i)
+ done
+
+
+(** Fold left over the initialized elements of the array *)
+let growArray_foldl (f: 'acc -> 'a -> 'acc)
+ (acc: 'acc) (ga: 'a growArray) : 'acc =
+ let rec loop (acc: 'acc) (idx: int) : 'acc =
+ if idx > ga.gaMaxInitIndex then
+ acc
+ else
+ loop (f acc ga.gaData.(idx)) (idx + 1)
+ in
+ loop acc 0
+
+
+
+
+let hasPrefix (prefix: string) (what: string) : bool =
+ let pl = String.length prefix in
+ try String.sub what 0 pl = prefix
+ with Invalid_argument _ -> false
+
+
+
+let restoreRef ?(deepCopy=(fun x -> x)) (r: 'a ref) : (unit -> unit) =
+ let old = deepCopy !r in
+ (fun () -> r := old)
+
+let restoreHash ?deepCopy (h: ('a, 'b) H.t) : (unit -> unit) =
+ let old =
+ match deepCopy with
+ None -> H.copy h
+ | Some f ->
+ let old = H.create (H.length h) in
+ H.iter (fun k d -> H.add old k (f d)) h;
+ old
+ in
+ (fun () -> hash_copy_into old h)
+
+let restoreIntHash ?deepCopy (h: 'a IH.t) : (unit -> unit) =
+ let old =
+ match deepCopy with
+ None -> IH.copy h
+ | Some f ->
+ let old = IH.create 13 in
+ IH.iter (fun k d -> IH.add old k (f d)) h;
+ old
+ in
+ (fun () ->
+ IH.clear old;
+ IH.iter (fun i k -> IH.add old i k) h)
+
+let restoreArray ?deepCopy (a: 'a array) : (unit -> unit) =
+ let old = Array.copy a in
+ (match deepCopy with
+ None -> ()
+ | Some f -> Array.iteri (fun i v -> old.(i) <- f v) old);
+ (fun () -> Array.blit old 0 a 0 (Array.length a))
+
+let runThunks (l: (unit -> unit) list) : (unit -> unit) =
+ fun () -> List.iter (fun f -> f ()) l
+
+
+
+(* Memoize *)
+let memoize (h: ('a, 'b) Hashtbl.t)
+ (arg: 'a)
+ (f: 'a -> 'b) : 'b =
+ try
+ Hashtbl.find h arg
+ with Not_found -> begin
+ let res = f arg in
+ Hashtbl.add h arg res;
+ res
+ end
+
+(* Just another name for memoize *)
+let findOrAdd h arg f = memoize h arg f
+
+(* A tryFinally function *)
+let tryFinally
+ (main: 'a -> 'b) (* The function to run *)
+ (final: 'b option -> unit) (* Something to run at the end *)
+ (arg: 'a) : 'b =
+ try
+ let res: 'b = main arg in
+ final (Some res);
+ res
+ with e -> begin
+ final None;
+ raise e
+ end
+
+
+
+
+let valOf : 'a option -> 'a = function
+ None -> raise (Failure "Util.valOf")
+ | Some x -> x
+
+(**
+ * An accumulating for loop.
+ *
+ * Initialize the accumulator with init. The current index and accumulator
+ * from the previous iteration is passed to f.
+ *)
+let fold_for ~(init: 'a) ~(lo: int) ~(hi: int) (f: int -> 'a -> 'a) =
+ let rec forloop i acc =
+ if i > hi then acc
+ else forloop (i+1) (f i acc)
+ in
+ forloop lo init
+
+(************************************************************************)
+
+module type STACK = sig
+ type 'a t
+ (** The type of stacks containing elements of type ['a]. *)
+
+ exception Empty
+ (** Raised when {!Stack.pop} or {!Stack.top} is applied to an empty stack. *)
+
+ val create : unit -> 'a t
+ (** Return a new stack, initially empty. *)
+
+ val push : 'a -> 'a t -> unit
+ (** [push x s] adds the element [x] at the top of stack [s]. *)
+
+ val pop : 'a t -> 'a
+ (** [pop s] removes and returns the topmost element in stack [s],
+ or raises [Empty] if the stack is empty. *)
+
+ val top : 'a t -> 'a
+ (** [top s] returns the topmost element in stack [s],
+ or raises [Empty] if the stack is empty. *)
+
+ val clear : 'a t -> unit
+ (** Discard all elements from a stack. *)
+
+ val copy : 'a t -> 'a t
+ (** Return a copy of the given stack. *)
+
+ val is_empty : 'a t -> bool
+ (** Return [true] if the given stack is empty, [false] otherwise. *)
+
+ val length : 'a t -> int
+ (** Return the number of elements in a stack. *)
+
+ val iter : ('a -> unit) -> 'a t -> unit
+ (** [iter f s] applies [f] in turn to all elements of [s],
+ from the element at the top of the stack to the element at the
+ bottom of the stack. The stack itself is unchanged. *)
+end
+
+module Stack = struct
+
+ type 'a t = { mutable length : int;
+ stack : 'a Stack.t; }
+
+ exception Empty
+
+ let create () = { length = 0;
+ stack = Stack.create(); }
+
+ let push x s =
+ s.length <- s.length + 1;
+ Stack.push x s.stack
+
+ let pop s =
+ s.length <- s.length - 1;
+ Stack.pop s.stack
+
+ let top s =
+ Stack.top s.stack
+
+ let clear s =
+ s.length <- 0;
+ Stack.clear s.stack
+
+ let copy s = { length = s.length;
+ stack = Stack.copy s.stack; }
+
+ let is_empty s =
+ Stack.is_empty s.stack
+
+ let length s = s.length
+
+ let iter f s =
+ Stack.iter f s.stack
+
+end
+
+(************************************************************************)
+
+let absoluteFilename (fname: string) =
+ if Filename.is_relative fname then
+ Filename.concat (Sys.getcwd ()) fname
+ else
+ fname
+
+
+(* mapNoCopy is like map but avoid copying the list if the function does not
+ * change the elements. *)
+let rec mapNoCopy (f: 'a -> 'a) = function
+ [] -> []
+ | (i :: resti) as li ->
+ let i' = f i in
+ let resti' = mapNoCopy f resti in
+ if i' != i || resti' != resti then i' :: resti' else li
+
+let rec mapNoCopyList (f: 'a -> 'a list) = function
+ [] -> []
+ | (i :: resti) as li ->
+ let il' = f i in
+ let resti' = mapNoCopyList f resti in
+ match il' with
+ [i'] when i' == i && resti' == resti -> li
+ | _ -> il' @ resti'
+
+
+(* Use a filter function that does not rewrite the list unless necessary *)
+let rec filterNoCopy (f: 'a -> bool) (l: 'a list) : 'a list =
+ match l with
+ [] -> []
+ | h :: rest when not (f h) -> filterNoCopy f rest
+ | h :: rest ->
+ let rest' = filterNoCopy f rest in
+ if rest == rest' then l else h :: rest'
+
+(** Join a list of strings *)
+let rec joinStrings (sep: string) (sl: string list) =
+ match sl with
+ [] -> ""
+ | [s1] -> s1
+ | s1 :: ((_ :: _) as rest) -> s1 ^ sep ^ joinStrings sep rest
+
+
+(************************************************************************
+
+ Configuration
+
+ ************************************************************************)
+(** The configuration data can be of several types **)
+type configData =
+ ConfInt of int
+ | ConfBool of bool
+ | ConfFloat of float
+ | ConfString of string
+ | ConfList of configData list
+
+
+(* Store here window configuration file *)
+let configurationData: (string, configData) H.t = H.create 13
+
+let clearConfiguration () = H.clear configurationData
+
+let setConfiguration (key: string) (c: configData) =
+ H.replace configurationData key c
+
+let findConfiguration (key: string) : configData =
+ H.find configurationData key
+
+let findConfigurationInt (key: string) : int =
+ match findConfiguration key with
+ ConfInt i -> i
+ | _ ->
+ ignore (E.warn "Configuration %s is not an integer" key);
+ raise Not_found
+
+let useConfigurationInt (key: string) (f: int -> unit) =
+ try f (findConfigurationInt key)
+ with Not_found -> ()
+
+let findConfigurationString (key: string) : string =
+ match findConfiguration key with
+ ConfString s -> s
+ | _ ->
+ ignore (E.warn "Configuration %s is not a string" key);
+ raise Not_found
+
+let useConfigurationString (key: string) (f: string -> unit) =
+ try f (findConfigurationString key)
+ with Not_found -> ()
+
+
+let findConfigurationBool (key: string) : bool =
+ match findConfiguration key with
+ ConfBool b -> b
+ | _ ->
+ ignore (E.warn "Configuration %s is not a boolean" key);
+ raise Not_found
+
+let useConfigurationBool (key: string) (f: bool -> unit) =
+ try f (findConfigurationBool key)
+ with Not_found -> ()
+
+let findConfigurationList (key: string) : configData list =
+ match findConfiguration key with
+ ConfList l -> l
+ | _ ->
+ ignore (E.warn "Configuration %s is not a list" key);
+ raise Not_found
+
+let useConfigurationList (key: string) (f: configData list -> unit) =
+ try f (findConfigurationList key)
+ with Not_found -> ()
+
+
+let saveConfiguration (fname: string) =
+ (** Convert configuration data to a string, for saving externally *)
+ let configToString (c: configData) : string =
+ let buff = Buffer.create 80 in
+ let rec loop (c: configData) : unit =
+ match c with
+ ConfInt i ->
+ Buffer.add_char buff 'i';
+ Buffer.add_string buff (string_of_int i);
+ Buffer.add_char buff ';'
+
+ | ConfBool b ->
+ Buffer.add_char buff 'b';
+ Buffer.add_string buff (string_of_bool b);
+ Buffer.add_char buff ';'
+
+ | ConfFloat f ->
+ Buffer.add_char buff 'f';
+ Buffer.add_string buff (string_of_float f);
+ Buffer.add_char buff ';'
+
+ | ConfString s ->
+ if String.contains s '"' then
+ E.s (E.unimp "Guilib: configuration string contains quotes");
+ Buffer.add_char buff '"';
+ Buffer.add_string buff s;
+ Buffer.add_char buff '"'; (* '"' *)
+
+ | ConfList l ->
+ Buffer.add_char buff '[';
+ List.iter loop l;
+ Buffer.add_char buff ']'
+ in
+ loop c;
+ Buffer.contents buff
+ in
+ try
+ let oc = open_out fname in
+ ignore (E.log "Saving configuration to %s\n" (absoluteFilename fname));
+ H.iter (fun k c ->
+ output_string oc (k ^ "\n");
+ output_string oc ((configToString c) ^ "\n"))
+ configurationData;
+ close_out oc
+ with _ ->
+ ignore (E.warn "Cannot open configuration file %s\n" fname)
+
+
+(** Make some regular expressions early *)
+let intRegexp = Str.regexp "i\\([0-9]+\\);"
+let floatRegexp = Str.regexp "f\\([0-9]+\\.[0-9]+\\);"
+let boolRegexp = Str.regexp "b\\(\\(true\\)\\|\\(false\\)\\);"
+let stringRegexp = Str.regexp "\"\\([^\"]*\\)\""
+
+let loadConfiguration (fname: string) : unit =
+ H.clear configurationData;
+
+ let stringToConfig (s: string) : configData =
+ let idx = ref 0 in (** the current index *)
+ let l = String.length s in
+
+ let rec getOne () : configData =
+ if !idx >= l then raise Not_found;
+
+ if Str.string_match intRegexp s !idx then begin
+ idx := Str.match_end ();
+ ConfInt (int_of_string (Str.matched_group 1 s))
+ end else if Str.string_match floatRegexp s !idx then begin
+ idx := Str.match_end ();
+ ConfFloat (float_of_string (Str.matched_group 1 s))
+ end else if Str.string_match boolRegexp s !idx then begin
+ idx := Str.match_end ();
+ ConfBool (bool_of_string (Str.matched_group 1 s))
+ end else if Str.string_match stringRegexp s !idx then begin
+ idx := Str.match_end ();
+ ConfString (Str.matched_group 1 s)
+ end else if String.get s !idx = '[' then begin
+ (* We are starting a list *)
+ incr idx;
+ let rec loop (acc: configData list) : configData list =
+ if !idx >= l then begin
+ ignore (E.warn "Non-terminated list in configuration %s" s);
+ raise Not_found
+ end;
+ if String.get s !idx = ']' then begin
+ incr idx;
+ List.rev acc
+ end else
+ loop (getOne () :: acc)
+ in
+ ConfList (loop [])
+ end else begin
+ ignore (E.warn "Bad configuration element in a list: %s\n"
+ (String.sub s !idx (l - !idx)));
+ raise Not_found
+ end
+ in
+ getOne ()
+ in
+ (try
+ let ic = open_in fname in
+ ignore (E.log "Loading configuration from %s\n" (absoluteFilename fname));
+ (try
+ while true do
+ let k = input_line ic in
+ let s = input_line ic in
+ try
+ let c = stringToConfig s in
+ setConfiguration k c
+ with Not_found -> ()
+ done
+ with End_of_file -> ());
+ close_in ic;
+ with _ -> () (* no file, ignore *));
+
+ ()
+
+
+
+(*********************************************************************)
+type symbol = int
+
+(**{ Registering symbol names} *)
+let registeredSymbolNames: (string, symbol) H.t = H.create 113
+let symbolNames: string IH.t = IH.create 113
+let nextSymbolId = ref 0
+
+(* When we register symbol ranges, we store a naming function for use later
+ * when we print the symbol *)
+let symbolRangeNaming: (int * int * (int -> string)) list ref = ref []
+
+(* Reset the symbols. We want to allow the registration of symbols at the
+ * top-level. This means that we cannot simply clear the hash tables. The
+ * first time we call "reset" we actually remember the state. *)
+let resetThunk: (unit -> unit) option ref = ref None
+
+let snapshotSymbols () : unit -> unit =
+ runThunks [ restoreIntHash symbolNames;
+ restoreRef nextSymbolId;
+ restoreHash registeredSymbolNames;
+ restoreRef symbolRangeNaming ]
+
+let resetSymbols () =
+ match !resetThunk with
+ None -> resetThunk := Some (snapshotSymbols ())
+ | Some t -> t ()
+
+
+let dumpSymbols () =
+ ignore (E.log "Current symbols\n");
+ IH.iter (fun i k -> ignore (E.log " %s -> %d\n" k i)) symbolNames;
+ ()
+
+let newSymbol (n: string) : symbol =
+ assert(not (H.mem registeredSymbolNames n));
+ let id = !nextSymbolId in
+ incr nextSymbolId;
+ H.add registeredSymbolNames n id;
+ IH.add symbolNames id n;
+ id
+
+let registerSymbolName (n: string) : symbol =
+ try H.find registeredSymbolNames n
+ with Not_found -> begin
+ newSymbol n
+ end
+
+(** Register a range of symbols. The mkname function will be invoked for
+ * indices starting at 0 *)
+let registerSymbolRange (count: int) (mkname: int -> string) : symbol =
+ if count < 0 then E.s (E.bug "registerSymbolRange: invalid counter");
+ let first = !nextSymbolId in
+ nextSymbolId := !nextSymbolId + count;
+ symbolRangeNaming :=
+ (first, !nextSymbolId - 1, mkname) :: !symbolRangeNaming;
+ first
+
+let symbolName (id: symbol) : string =
+ try IH.find symbolNames id
+ with Not_found ->
+ (* Perhaps it is one of the lazily named symbols *)
+ try
+ let (fst, _, mkname) =
+ List.find
+ (fun (fst,lst,_) -> fst <= id && id <= lst)
+ !symbolRangeNaming in
+ let n = mkname (id - fst) in
+ IH.add symbolNames id n;
+ n
+ with Not_found ->
+ ignore (E.warn "Cannot find the name of symbol %d" id);
+ "symbol" ^ string_of_int id
+
+(************************************************************************)
+
+(** {1 Int32 Operators} *)
+
+module Int32Op = struct
+ exception IntegerTooLarge
+ let to_int (i: int32) =
+ let i' = Int32.to_int i in (* Silently drop the 32nd bit *)
+ if i = Int32.of_int i' then i'
+ else raise IntegerTooLarge
+
+ let (<%) = (fun x y -> (Int32.compare x y) < 0)
+ let (<=%) = (fun x y -> (Int32.compare x y) <= 0)
+ let (>%) = (fun x y -> (Int32.compare x y) > 0)
+ let (>=%) = (fun x y -> (Int32.compare x y) >= 0)
+ let (<>%) = (fun x y -> (Int32.compare x y) <> 0)
+
+ let (+%) = Int32.add
+ let (-%) = Int32.sub
+ let ( *% ) = Int32.mul
+ let (/%) = Int32.div
+ let (~-%) = Int32.neg
+
+ (* We cannot use the <<% because it trips camlp4 *)
+ let sll = fun i j -> Int32.shift_left i (to_int j)
+ let (>>%) = fun i j -> Int32.shift_right i (to_int j)
+ let (>>>%) = fun i j -> Int32.shift_right_logical i (to_int j)
+end
+
+
+(*********************************************************************)
+
+let equals x1 x2 : bool =
+ (compare x1 x2) = 0
diff --git a/cil/ocamlutil/util.mli b/cil/ocamlutil/util.mli
new file mode 100644
index 0000000..d701c65
--- /dev/null
+++ b/cil/ocamlutil/util.mli
@@ -0,0 +1,311 @@
+(** A bunch of generally useful functions *)
+
+exception GotSignal of int
+
+val withTimeout : float -> (* Seconds for timeout *)
+ (int -> 'b) -> (* What to do if we have a timeout. The
+ * argument passed is the signal number
+ * received. *)
+ ('a -> 'b) -> (* The function to run *)
+ 'a -> (* And its argument *)
+ 'b
+
+val docHash : ?sep:Pretty.doc -> ('a -> 'b -> Pretty.doc) -> unit ->
+ (('a, 'b) Hashtbl.t) -> Pretty.doc
+
+
+val hash_to_list: ('a, 'b) Hashtbl.t -> ('a * 'b) list
+
+val keys: ('a, 'b) Hashtbl.t -> 'a list
+
+
+(** Copy a hash table into another *)
+val hash_copy_into: ('a, 'b) Hashtbl.t -> ('a, 'b) Hashtbl.t -> unit
+
+(** First, a few utility functions I wish were in the standard prelude *)
+
+val anticompare: 'a -> 'a -> int
+
+val list_drop : int -> 'a list -> 'a list
+val list_droptail : int -> 'a list -> 'a list
+val list_span: ('a -> bool) -> ('a list) -> 'a list * 'a list
+val list_insert_by: ('a -> 'a -> int) -> 'a -> 'a list -> 'a list
+val list_head_default: 'a -> 'a list -> 'a
+val list_iter3 : ('a -> 'b -> 'c -> unit) ->
+ 'a list -> 'b list -> 'c list -> unit
+val get_some_option_list : 'a option list -> 'a list
+val list_append: ('a list) -> ('a list) -> ('a list) (* tail-recursive append*)
+
+(** Iterate over a list passing the index as you go *)
+val list_iteri: (int -> 'a -> unit) -> 'a list -> unit
+val list_mapi: (int -> 'a -> 'b) -> 'a list -> 'b list
+
+(** Like fold_left but pass the index into the list as well *)
+val list_fold_lefti: ('acc -> int -> 'a -> 'acc) -> 'acc -> 'a list -> 'acc
+
+(** Generates the range of integers starting with a and ending with b *)
+val int_range_list : int -> int -> int list
+
+(* Create a list of length l *)
+val list_init : int -> (int -> 'a) -> 'a list
+
+(** Find the first element in a list that returns Some *)
+val list_find_first: 'a list -> ('a -> 'b option) -> 'b option
+
+(** mapNoCopy is like map but avoid copying the list if the function does not
+ * change the elements *)
+
+val mapNoCopy: ('a -> 'a) -> 'a list -> 'a list
+
+val mapNoCopyList: ('a -> 'a list) -> 'a list -> 'a list
+
+val filterNoCopy: ('a -> bool) -> 'a list -> 'a list
+
+
+(** Join a list of strings *)
+val joinStrings: string -> string list -> string
+
+
+(**** Now in growArray.mli
+
+(** Growable arrays *)
+type 'a growArrayFill =
+ Elem of 'a
+ | Susp of (int -> 'a)
+
+type 'a growArray = {
+ gaFill: 'a growArrayFill;
+ (** Stuff to use to fill in the array as it grows *)
+
+ mutable gaMaxInitIndex: int;
+ (** Maximum index that was written to. -1 if no writes have
+ * been made. *)
+
+ mutable gaData: 'a array;
+ }
+
+val newGrowArray: int -> 'a growArrayFill -> 'a growArray
+(** [newGrowArray initsz fillhow] *)
+
+val getReg: 'a growArray -> int -> 'a
+val setReg: 'a growArray -> int -> 'a -> unit
+val copyGrowArray: 'a growArray -> 'a growArray
+val deepCopyGrowArray: 'a growArray -> ('a -> 'a) -> 'a growArray
+
+
+val growArray_iteri: (int -> 'a -> unit) -> 'a growArray -> unit
+(** Iterate over the initialized elements of the array *)
+
+val growArray_foldl: ('acc -> 'a -> 'acc) -> 'acc ->'a growArray -> 'acc
+(** Fold left over the initialized elements of the array *)
+
+****)
+
+(** hasPrefix prefix str returns true with str starts with prefix *)
+val hasPrefix: string -> string -> bool
+
+
+(** Given a ref cell, produce a thunk that later restores it to its current value *)
+val restoreRef: ?deepCopy:('a -> 'a) -> 'a ref -> unit -> unit
+
+(** Given a hash table, produce a thunk that later restores it to its current value *)
+val restoreHash: ?deepCopy:('b -> 'b) -> ('a, 'b) Hashtbl.t -> unit -> unit
+
+(** Given an integer hash table, produce a thunk that later restores it to
+ * its current value *)
+val restoreIntHash: ?deepCopy:('b -> 'b) -> 'b Inthash.t -> unit -> unit
+
+(** Given an array, produce a thunk that later restores it to its current value *)
+val restoreArray: ?deepCopy:('a -> 'a) -> 'a array -> unit -> unit
+
+
+(** Given a list of thunks, produce a thunk that runs them all *)
+val runThunks: (unit -> unit) list -> unit -> unit
+
+
+val memoize: ('a, 'b) Hashtbl.t ->
+ 'a ->
+ ('a -> 'b) -> 'b
+
+(** Just another name for memoize *)
+val findOrAdd: ('a, 'b) Hashtbl.t ->
+ 'a ->
+ ('a -> 'b) -> 'b
+
+val tryFinally:
+ ('a -> 'b) -> (* The function to run *)
+ ('b option -> unit) -> (* Something to run at the end. The None case is
+ * used when an exception is thrown *)
+ 'a -> 'b
+
+
+
+
+(** Get the value of an option. Raises Failure if None *)
+val valOf : 'a option -> 'a
+
+(**
+ * An accumulating for loop.
+ *
+ * Initialize the accumulator with init. The current index and accumulator
+ * from the previous iteration is passed to f.
+ *)
+val fold_for : init:'a -> lo:int -> hi:int -> (int -> 'a -> 'a) -> 'a
+
+(************************************************************************)
+
+module type STACK = sig
+ type 'a t
+ (** The type of stacks containing elements of type ['a]. *)
+
+ exception Empty
+ (** Raised when {!Util.Stack.pop} or {!Util.Stack.top} is applied to an
+ * empty stack. *)
+
+ val create : unit -> 'a t
+
+
+ val push : 'a -> 'a t -> unit
+ (** [push x s] adds the element [x] at the top of stack [s]. *)
+
+ val pop : 'a t -> 'a
+ (** [pop s] removes and returns the topmost element in stack [s],
+ or raises [Empty] if the stack is empty. *)
+
+ val top : 'a t -> 'a
+ (** [top s] returns the topmost element in stack [s],
+ or raises [Empty] if the stack is empty. *)
+
+ val clear : 'a t -> unit
+ (** Discard all elements from a stack. *)
+
+ val copy : 'a t -> 'a t
+ (** Return a copy of the given stack. *)
+
+ val is_empty : 'a t -> bool
+ (** Return [true] if the given stack is empty, [false] otherwise. *)
+
+ val length : 'a t -> int
+ (** Return the number of elements in a stack. *)
+
+ val iter : ('a -> unit) -> 'a t -> unit
+ (** [iter f s] applies [f] in turn to all elements of [s],
+ from the element at the top of the stack to the element at the
+ bottom of the stack. The stack itself is unchanged. *)
+end
+
+module Stack : STACK
+
+(************************************************************************
+ Configuration
+************************************************************************)
+(** The configuration data can be of several types **)
+type configData =
+ ConfInt of int
+ | ConfBool of bool
+ | ConfFloat of float
+ | ConfString of string
+ | ConfList of configData list
+
+
+(** Load the configuration from a file *)
+val loadConfiguration: string -> unit
+
+(** Save the configuration in a file. Overwrites the previous values *)
+val saveConfiguration: string -> unit
+
+
+(** Clear all configuration data *)
+val clearConfiguration: unit -> unit
+
+(** Set a configuration element, with a key. Overwrites the previous values *)
+val setConfiguration: string -> configData -> unit
+
+(** Find a configuration elements, given a key. Raises Not_found if it canont
+ * find it *)
+val findConfiguration: string -> configData
+
+(** Like findConfiguration but extracts the integer *)
+val findConfigurationInt: string -> int
+
+(** Looks for an integer configuration element, and if it is found, it uses
+ * the given function. Otherwise, does nothing *)
+val useConfigurationInt: string -> (int -> unit) -> unit
+
+
+val findConfigurationBool: string -> bool
+val useConfigurationBool: string -> (bool -> unit) -> unit
+
+val findConfigurationString: string -> string
+val useConfigurationString: string -> (string -> unit) -> unit
+
+val findConfigurationList: string -> configData list
+val useConfigurationList: string -> (configData list -> unit) -> unit
+
+
+(************************************************************************)
+
+(** Symbols are integers that are uniquely associated with names *)
+type symbol = int
+
+(** Get the name of a symbol *)
+val symbolName: symbol -> string
+
+(** Register a symbol name and get the symbol for it *)
+val registerSymbolName: string -> symbol
+
+(** Register a number of consecutive symbol ids. The naming function will be
+ * invoked with indices from 0 to the counter - 1. Returns the id of the
+ * first symbol created. The naming function is invoked lazily, only when the
+ * name of the symbol is required. *)
+val registerSymbolRange: int -> (int -> string) -> symbol
+
+
+(** Make a fresh symbol. Give the name also, which ought to be distinct from
+ * existing symbols. This is different from registerSymbolName in that it
+ * always creates a new symbol. *)
+val newSymbol: string -> symbol
+
+(** Reset the state of the symbols to the program startup state *)
+val resetSymbols: unit -> unit
+
+(** Take a snapshot of the symbol state. Returns a thunk that restores the
+ * state. *)
+val snapshotSymbols: unit -> unit -> unit
+
+
+(** Dump the list of registered symbols *)
+val dumpSymbols: unit -> unit
+
+(************************************************************************)
+
+(** {1 Int32 Operators} *)
+
+module Int32Op : sig
+ val (<%) : int32 -> int32 -> bool
+ val (<=%) : int32 -> int32 -> bool
+ val (>%) : int32 -> int32 -> bool
+ val (>=%) : int32 -> int32 -> bool
+ val (<>%) : int32 -> int32 -> bool
+
+ val (+%) : int32 -> int32 -> int32
+ val (-%) : int32 -> int32 -> int32
+ val ( *% ) : int32 -> int32 -> int32
+ val (/%) : int32 -> int32 -> int32
+ val (~-%) : int32 -> int32
+
+ val sll : int32 -> int32 -> int32
+ val (>>%) : int32 -> int32 -> int32
+ val (>>>%) : int32 -> int32 -> int32
+
+ exception IntegerTooLarge
+ val to_int : int32 -> int
+end
+
+(************************************************************************)
+
+(** This has the semantics of (=) on OCaml 3.07 and earlier. It can
+ handle cyclic values as long as a structure in the cycle has a unique
+ name or id in some field that occurs before any fields that have cyclic
+ pointers. *)
+val equals: 'a -> 'a -> bool
diff --git a/cil/src/check.ml b/cil/src/check.ml
new file mode 100644
index 0000000..4dc8850
--- /dev/null
+++ b/cil/src/check.ml
@@ -0,0 +1,1017 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* A consistency checker for CIL *)
+open Cil
+module E = Errormsg
+module H = Hashtbl
+open Pretty
+
+
+(* A few parameters to customize the checking *)
+type checkFlags =
+ NoCheckGlobalIds (* Do not check that the global ids have the proper
+ * hash value *)
+
+let checkGlobalIds = ref true
+
+ (* Attributes must be sorted *)
+type ctxAttr =
+ CALocal (* Attribute of a local variable *)
+ | CAGlobal (* Attribute of a global variable *)
+ | CAType (* Attribute of a type *)
+
+let valid = ref true
+
+let warn fmt =
+ valid := false;
+ Cil.warn fmt
+
+let warnContext fmt =
+ valid := false;
+ Cil.warnContext fmt
+
+let checkAttributes (attrs: attribute list) : unit =
+ let rec loop lastname = function
+ [] -> ()
+ | Attr(an, _) :: resta ->
+ if an < lastname then
+ ignore (warn "Attributes not sorted");
+ loop an resta
+ in
+ loop "" attrs
+
+
+ (* Keep track of defined types *)
+let typeDefs : (string, typ) H.t = H.create 117
+
+
+ (* Keep track of all variables names, enum tags and type names *)
+let varNamesEnv : (string, unit) H.t = H.create 117
+
+ (* We also keep a map of variables indexed by id, to ensure that only one
+ * varinfo has a given id *)
+let varIdsEnv: (int, varinfo) H.t = H.create 117
+
+ (* And keep track of all varinfo's to check the uniqueness of the
+ * identifiers *)
+let allVarIds: (int, varinfo) H.t = H.create 117
+
+ (* Also keep a list of environments. We place an empty string in the list to
+ * mark the start of a local environment (i.e. a function) *)
+let varNamesList : (string * int) list ref = ref []
+let defineName s =
+ if s = "" then
+ E.s (bug "Empty name\n");
+ if H.mem varNamesEnv s then
+ ignore (warn "Multiple definitions for %s\n" s);
+ H.add varNamesEnv s ()
+
+let defineVariable vi =
+ defineName vi.vname;
+ varNamesList := (vi.vname, vi.vid) :: !varNamesList;
+ (* Check the id *)
+ if H.mem allVarIds vi.vid then
+ ignore (warn "Id %d is already defined (%s)\n" vi.vid vi.vname);
+ H.add allVarIds vi.vid vi;
+ (* And register it in the current scope also *)
+ H.add varIdsEnv vi.vid vi
+
+(* Check that a varinfo has already been registered *)
+let checkVariable vi =
+ try
+ (* Check in the current scope only *)
+ if vi != H.find varIdsEnv vi.vid then
+ ignore (warnContext "varinfos for %s not shared\n" vi.vname);
+ with Not_found ->
+ ignore (warn "Unknown id (%d) for %s\n" vi.vid vi.vname)
+
+
+let startEnv () =
+ varNamesList := ("", -1) :: !varNamesList
+
+let endEnv () =
+ let rec loop = function
+ [] -> E.s (bug "Cannot find start of env")
+ | ("", _) :: rest -> varNamesList := rest
+ | (s, id) :: rest -> begin
+ H.remove varNamesEnv s;
+ H.remove varIdsEnv id;
+ loop rest
+ end
+ in
+ loop !varNamesList
+
+
+
+(* The current function being checked *)
+let currentReturnType : typ ref = ref voidType
+
+(* A map of labels in the current function *)
+let labels: (string, unit) H.t = H.create 17
+
+(* A list of statements seen in the current function *)
+let statements: stmt list ref = ref []
+
+(* A list of the targets of Gotos *)
+let gotoTargets: (string * stmt) list ref = ref []
+
+(*** TYPES ***)
+(* Cetain types can only occur in some contexts, so keep a list of context *)
+type ctxType =
+ CTStruct (* In a composite type *)
+ | CTUnion
+ | CTFArg (* In a function argument type *)
+ | CTFRes (* In a function result type *)
+ | CTArray (* In an array type *)
+ | CTPtr (* In a pointer type *)
+ | CTExp (* In an expression, as the type of
+ * the result of binary operators, or
+ * in a cast *)
+ | CTSizeof (* In a sizeof *)
+ | CTDecl (* In a typedef, or a declaration *)
+
+let d_context () = function
+ CTStruct -> text "CTStruct"
+ | CTUnion -> text "CTUnion"
+ | CTFArg -> text "CTFArg"
+ | CTFRes -> text "CTFRes"
+ | CTArray -> text "CTArray"
+ | CTPtr -> text "CTPtr"
+ | CTExp -> text "CTExp"
+ | CTSizeof -> text "CTSizeof"
+ | CTDecl -> text "CTDecl"
+
+
+(* Keep track of all tags that we use. For each tag remember also the info
+ * structure and a flag whether it was actually defined or just used. A
+ * forward declaration acts as a definition. *)
+type defuse =
+ Defined (* We actually have seen a definition of this tag *)
+ | Forward (* We have seen a forward declaration for it. This is done using
+ * a GType with an empty type name *)
+ | Used (* Only uses *)
+let compUsed : (int, compinfo * defuse ref) H.t = H.create 117
+let enumUsed : (string, enuminfo * defuse ref) H.t = H.create 117
+let typUsed : (string, typeinfo * defuse ref) H.t = H.create 117
+
+(* For composite types we also check that the names are unique *)
+let compNames : (string, unit) H.t = H.create 17
+
+
+ (* Check a type *)
+let rec checkType (t: typ) (ctx: ctxType) =
+ (* Check that it appears in the right context *)
+ let rec checkContext = function
+ TVoid _ -> ctx = CTPtr || ctx = CTFRes || ctx = CTDecl
+ | TNamed (ti, a) -> checkContext ti.ttype
+ | TArray _ ->
+ (ctx = CTStruct || ctx = CTUnion
+ || ctx = CTSizeof || ctx = CTDecl || ctx = CTArray || ctx = CTPtr)
+ | TComp _ -> ctx <> CTExp
+ | _ -> true
+ in
+ if not (checkContext t) then
+ ignore (warn "Type (%a) used in wrong context. Expected context: %a"
+ d_plaintype t d_context ctx);
+ match t with
+ (TVoid a | TBuiltin_va_list a) -> checkAttributes a
+ | TInt (ik, a) -> checkAttributes a
+ | TFloat (_, a) -> checkAttributes a
+ | TPtr (t, a) -> checkAttributes a; checkType t CTPtr
+
+ | TNamed (ti, a) ->
+ checkAttributes a;
+ if ti.tname = "" then
+ ignore (warnContext "Using a typeinfo for an empty-named type\n");
+ checkTypeInfo Used ti
+
+ | TComp (comp, a) ->
+ checkAttributes a;
+ (* Mark it as a forward. We'll check it later. If we try to check it
+ * now we might encounter undefined types *)
+ checkCompInfo Used comp
+
+
+ | TEnum (enum, a) -> begin
+ checkAttributes a;
+ checkEnumInfo Used enum
+ end
+
+ | TArray(bt, len, a) ->
+ checkAttributes a;
+ checkType bt CTArray;
+ (match len with
+ None -> ()
+ | Some l -> begin
+ let t = checkExp true l in
+ match t with
+ TInt((IInt|IUInt), _) -> ()
+ | _ -> E.s (bug "Type of array length is not integer")
+ end)
+
+ | TFun (rt, targs, isva, a) ->
+ checkAttributes a;
+ checkType rt CTFRes;
+ List.iter
+ (fun (an, at, aa) ->
+ checkType at CTFArg;
+ checkAttributes aa) (argsToList targs)
+
+(* Check that a type is a promoted integral type *)
+and checkIntegralType (t: typ) =
+ checkType t CTExp;
+ match unrollType t with
+ TInt _ -> ()
+ | _ -> ignore (warn "Non-integral type")
+
+(* Check that a type is a promoted arithmetic type *)
+and checkArithmeticType (t: typ) =
+ checkType t CTExp;
+ match unrollType t with
+ TInt _ | TFloat _ -> ()
+ | _ -> ignore (warn "Non-arithmetic type")
+
+(* Check that a type is a promoted boolean type *)
+and checkBooleanType (t: typ) =
+ checkType t CTExp;
+ match unrollType t with
+ TInt _ | TFloat _ | TPtr _ -> ()
+ | _ -> ignore (warn "Non-boolean type")
+
+
+(* Check that a type is a pointer type *)
+and checkPointerType (t: typ) =
+ checkType t CTExp;
+ match unrollType t with
+ TPtr _ -> ()
+ | _ -> ignore (warn "Non-pointer type")
+
+
+and typeMatch (t1: typ) (t2: typ) =
+ if typeSig t1 <> typeSig t2 then
+ match unrollType t1, unrollType t2 with
+ (* Allow free interchange of TInt and TEnum *)
+ TInt (IInt, _), TEnum _ -> ()
+ | TEnum _, TInt (IInt, _) -> ()
+
+ | _, _ -> ignore (warn "Type mismatch:@! %a@!and %a@!"
+ d_type t1 d_type t2)
+
+and checkCompInfo (isadef: defuse) comp =
+ let fullname = compFullName comp in
+ try
+ let oldci, olddef = H.find compUsed comp.ckey in
+ (* Check that it is the same *)
+ if oldci != comp then
+ ignore (warnContext "compinfo for %s not shared\n" fullname);
+ (match !olddef, isadef with
+ | Defined, Defined ->
+ ignore (warnContext "Multiple definition of %s\n" fullname)
+ | _, Defined -> olddef := Defined
+ | Defined, _ -> ()
+ | _, Forward -> olddef := Forward
+ | _, _ -> ())
+ with Not_found -> begin (* This is the first time we see it *)
+ (* Check that the name is not empty *)
+ if comp.cname = "" then
+ E.s (bug "Compinfo with empty name");
+ (* Check that the name is unique *)
+ if H.mem compNames fullname then
+ ignore (warn "Duplicate name %s" fullname);
+ (* Add it to the map before we go on *)
+ H.add compUsed comp.ckey (comp, ref isadef);
+ H.add compNames fullname ();
+ (* Do not check the compinfo unless this is a definition. Otherwise you
+ * might run into undefined types. *)
+ if isadef = Defined then begin
+ checkAttributes comp.cattr;
+ let fctx = if comp.cstruct then CTStruct else CTUnion in
+ let rec checkField f =
+ if not
+ (f.fcomp == comp && (* Each field must share the self cell of
+ * the host *)
+ f.fname <> "") then
+ ignore (warn "Self pointer not set in field %s of %s"
+ f.fname fullname);
+ checkType f.ftype fctx;
+ (* Check the bitfields *)
+ (match unrollType f.ftype, f.fbitfield with
+ | TInt (ik, a), Some w ->
+ checkAttributes a;
+ if w < 0 || w >= bitsSizeOf (TInt(ik, a)) then
+ ignore (warn "Wrong width (%d) in bitfield" w)
+ | _, Some w ->
+ ignore (E.error "Bitfield on a non integer type\n")
+ | _ -> ());
+ checkAttributes f.fattr
+ in
+ List.iter checkField comp.cfields
+ end
+ end
+
+
+and checkEnumInfo (isadef: defuse) enum =
+ if enum.ename = "" then
+ E.s (bug "Enuminfo with empty name");
+ try
+ let oldei, olddef = H.find enumUsed enum.ename in
+ (* Check that it is the same *)
+ if oldei != enum then
+ ignore (warnContext "enuminfo for %s not shared\n" enum.ename);
+ (match !olddef, isadef with
+ Defined, Defined ->
+ ignore (warnContext "Multiple definition of enum %s\n" enum.ename)
+ | _, Defined -> olddef := Defined
+ | Defined, _ -> ()
+ | _, Forward -> olddef := Forward
+ | _, _ -> ())
+ with Not_found -> begin (* This is the first time we see it *)
+ (* Add it to the map before we go on *)
+ H.add enumUsed enum.ename (enum, ref isadef);
+ checkAttributes enum.eattr;
+ List.iter (fun (tn, _, _) -> defineName tn) enum.eitems;
+ end
+
+and checkTypeInfo (isadef: defuse) ti =
+ try
+ let oldti, olddef = H.find typUsed ti.tname in
+ (* Check that it is the same *)
+ if oldti != ti then
+ ignore (warnContext "typeinfo for %s not shared\n" ti.tname);
+ (match !olddef, isadef with
+ Defined, Defined ->
+ ignore (warnContext "Multiple definition of type %s\n" ti.tname)
+ | Defined, Used -> ()
+ | Used, Defined ->
+ ignore (warnContext "Use of type %s before its definition\n" ti.tname)
+ | _, _ ->
+ ignore (warnContext "Bug in checkTypeInfo for %s\n" ti.tname))
+ with Not_found -> begin (* This is the first time we see it *)
+ if ti.tname = "" then
+ ignore (warnContext "typeinfo with empty name");
+ checkType ti.ttype CTDecl;
+ (* Add it to the map before we go on *)
+ H.add typUsed ti.tname (ti, ref isadef);
+ end
+
+(* Check an lvalue. If isconst then the lvalue appears in a context where
+ * only a compile-time constant can appear. Return the type of the lvalue.
+ * See the typing rule from cil.mli *)
+and checkLval (isconst: bool) (lv: lval) : typ =
+ match lv with
+ Var vi, off ->
+ checkVariable vi;
+ checkOffset vi.vtype off
+
+ | Mem addr, off -> begin
+ if isconst then
+ ignore (warn "Memory operation in constant");
+ let ta = checkExp false addr in
+ match unrollType ta with
+ TPtr (t, _) -> checkOffset t off
+ | _ -> E.s (bug "Mem on a non-pointer")
+ end
+
+(* Check an offset. The basetype is the type of the object referenced by the
+ * base. Return the type of the lvalue constructed from a base value of right
+ * type and the offset. See the typing rules from cil.mli *)
+and checkOffset basetyp : offset -> typ = function
+ NoOffset -> basetyp
+ | Index (ei, o) ->
+ checkExpType false ei intType;
+ begin
+ match unrollType basetyp with
+ TArray (t, _, _) -> checkOffset t o
+ | t -> E.s (bug "typeOffset: Index on a non-array: %a" d_plaintype t)
+ end
+
+ | Field (fi, o) ->
+ (* Now check that the host is shared propertly *)
+ checkCompInfo Used fi.fcomp;
+ (* Check that this exact field is part of the host *)
+ if not (List.exists (fun f -> f == fi) fi.fcomp.cfields) then
+ ignore (warn "Field %s not part of %s"
+ fi.fname (compFullName fi.fcomp));
+ checkOffset fi.ftype o
+
+and checkExpType (isconst: bool) (e: exp) (t: typ) =
+ let t' = checkExp isconst e in (* compute the type *)
+ if isconst then begin (* For initializers allow a string to initialize an
+ * array of characters *)
+ if typeSig t' <> typeSig t then
+ match e, t with
+ | _ -> typeMatch t' t
+ end else
+ typeMatch t' t
+
+(* Check an expression. isconst specifies if the expression occurs in a
+ * context where only a compile-time constant can occur. Return the computed
+ * type of the expression *)
+and checkExp (isconst: bool) (e: exp) : typ =
+ E.withContext
+ (fun _ -> dprintf "check%s: %a"
+ (if isconst then "Const" else "Exp") d_exp e)
+ (fun _ ->
+ match e with
+ | Const(CInt64 (_, ik, _)) -> TInt(ik, [])
+ | Const(CChr _) -> charType
+ | Const(CStr s) -> charPtrType
+ | Const(CWStr s) -> TPtr(!wcharType,[])
+ | Const(CReal (_, fk, _)) -> TFloat(fk, [])
+ | Const(CEnum (_, _, ei)) -> TEnum(ei, [])
+ | Lval(lv) ->
+ if isconst then
+ ignore (warn "Lval in constant");
+ checkLval isconst lv
+
+ | SizeOf(t) -> begin
+ (* Sizeof cannot be applied to certain types *)
+ checkType t CTSizeof;
+ (match unrollType t with
+ (TFun _ | TVoid _) ->
+ ignore (warn "Invalid operand for sizeof")
+ | _ ->());
+ uintType
+ end
+ | SizeOfE(e) ->
+ (* The expression in a sizeof can be anything *)
+ let te = checkExp false e in
+ checkExp isconst (SizeOf(te))
+
+ | SizeOfStr s -> uintType
+
+ | AlignOf(t) -> begin
+ (* Sizeof cannot be applied to certain types *)
+ checkType t CTSizeof;
+ (match unrollType t with
+ (TFun _ | TVoid _) ->
+ ignore (warn "Invalid operand for sizeof")
+ | _ ->());
+ uintType
+ end
+ | AlignOfE(e) ->
+ (* The expression in an AlignOfE can be anything *)
+ let te = checkExp false e in
+ checkExp isconst (AlignOf(te))
+
+ | UnOp (Neg, e, tres) ->
+ checkArithmeticType tres; checkExpType isconst e tres; tres
+
+ | UnOp (BNot, e, tres) ->
+ checkIntegralType tres; checkExpType isconst e tres; tres
+
+ | UnOp (LNot, e, tres) ->
+ let te = checkExp isconst e in
+ checkBooleanType te;
+ checkIntegralType tres; (* Must check that t is well-formed *)
+ typeMatch tres intType;
+ tres
+
+ | BinOp (bop, e1, e2, tres) -> begin
+ let t1 = checkExp isconst e1 in
+ let t2 = checkExp isconst e2 in
+ match bop with
+ (Mult | Div) ->
+ typeMatch t1 t2; checkArithmeticType tres;
+ typeMatch t1 tres; tres
+ | (Eq|Ne|Lt|Le|Ge|Gt) ->
+ typeMatch t1 t2; checkArithmeticType t1;
+ typeMatch tres intType; tres
+ | Mod|BAnd|BOr|BXor ->
+ typeMatch t1 t2; checkIntegralType tres;
+ typeMatch t1 tres; tres
+ | LAnd | LOr ->
+ typeMatch t1 t2; checkBooleanType tres;
+ typeMatch t1 tres; tres
+ | Shiftlt | Shiftrt ->
+ typeMatch t1 tres; checkIntegralType t1;
+ checkIntegralType t2; tres
+ | (PlusA | MinusA) ->
+ typeMatch t1 t2; typeMatch t1 tres;
+ checkArithmeticType tres; tres
+ | (PlusPI | MinusPI | IndexPI) ->
+ checkPointerType tres;
+ typeMatch t1 tres;
+ checkIntegralType t2;
+ tres
+ | MinusPP ->
+ checkPointerType t1; checkPointerType t2;
+ typeMatch t1 t2;
+ typeMatch tres intType;
+ tres
+ end
+ | AddrOf (lv) -> begin
+ let tlv = checkLval isconst lv in
+ (* Only certain types can be in AddrOf *)
+ match unrollType tlv with
+ | TVoid _ ->
+ E.s (bug "AddrOf on improper type");
+
+ | (TInt _ | TFloat _ | TPtr _ | TComp _ | TFun _ | TArray _ ) ->
+ TPtr(tlv, [])
+
+ | TEnum _ -> intPtrType
+ | _ -> E.s (bug "AddrOf on unknown type")
+ end
+
+ | StartOf lv -> begin
+ let tlv = checkLval isconst lv in
+ match unrollType tlv with
+ TArray (t,_, _) -> TPtr(t, [])
+ | _ -> E.s (bug "StartOf on a non-array")
+ end
+
+ | CastE (tres, e) -> begin
+ let et = checkExp isconst e in
+ checkType tres CTExp;
+ (* Not all types can be cast *)
+ match unrollType et with
+ TArray _ -> E.s (bug "Cast of an array type")
+ | TFun _ -> E.s (bug "Cast of a function type")
+ | TComp _ -> E.s (bug "Cast of a composite type")
+ | TVoid _ -> E.s (bug "Cast of a void type")
+ | _ -> tres
+ end)
+ () (* The argument of withContext *)
+
+and checkInit (i: init) : typ =
+ E.withContext
+ (fun _ -> dprintf "checkInit: %a" d_init i)
+ (fun _ ->
+ match i with
+ SingleInit e -> checkExp true e
+(*
+ | ArrayInit (bt, len, initl) -> begin
+ checkType bt CTSizeof;
+ if List.length initl > len then
+ ignore (warn "Too many initializers in array");
+ List.iter (fun i -> checkInitType i bt) initl;
+ TArray(bt, Some (integer len), [])
+ end
+*)
+ | CompoundInit (ct, initl) -> begin
+ checkType ct CTSizeof;
+ (match unrollType ct with
+ TArray(bt, Some (Const(CInt64(len, _, _))), _) ->
+ let rec loopIndex i = function
+ [] ->
+ if i <> len then
+ ignore (warn "Wrong number of initializers in array")
+
+ | (Index(Const(CInt64(i', _, _)), NoOffset), ei) :: rest ->
+ if i' <> i then
+ ignore (warn "Initializer for index %s when %s was expected\n"
+ (Int64.format "%d" i') (Int64.format "%d" i));
+ checkInitType ei bt;
+ loopIndex (Int64.succ i) rest
+ | _ :: rest ->
+ ignore (warn "Malformed initializer for array element")
+ in
+ loopIndex Int64.zero initl
+ | TArray(_, _, _) ->
+ ignore (warn "Malformed initializer for array")
+ | TComp (comp, _) ->
+ if comp.cstruct then
+ let rec loopFields
+ (nextflds: fieldinfo list)
+ (initl: (offset * init) list) : unit =
+ match nextflds, initl with
+ [], [] -> () (* We are done *)
+ | f :: restf, (Field(f', NoOffset), i) :: resti ->
+ if f.fname <> f'.fname then
+ ignore (warn "Expected initializer for field %s and found one for %s\n" f.fname f'.fname);
+ checkInitType i f.ftype;
+ loopFields restf resti
+ | [], _ :: _ ->
+ ignore (warn "Too many initializers for struct")
+ | _ :: _, [] ->
+ ignore (warn "Too few initializers for struct")
+ | _, _ ->
+ ignore (warn "Malformed initializer for struct")
+ in
+ loopFields
+ (List.filter (fun f -> f.fname <> missingFieldName)
+ comp.cfields)
+ initl
+
+ else (* UNION *)
+ if comp.cfields == [] then begin
+ if initl != [] then
+ ignore (warn "Initializer for empty union not empty");
+ end else begin
+ match initl with
+ [(Field(f, NoOffset), ei)] ->
+ if f.fcomp != comp then
+ ignore (bug "Wrong designator for union initializer");
+ if !msvcMode && f != List.hd comp.cfields then
+ ignore (warn "On MSVC you can only initialize the first field of a union");
+ checkInitType ei f.ftype
+
+ | _ ->
+ ignore (warn "Malformed initializer for union")
+ end
+ | _ ->
+ E.s (warn "Type of Compound is not array or struct or union"));
+ ct
+ end)
+ () (* The arguments of withContext *)
+
+
+and checkInitType (i: init) (t: typ) : unit =
+ let it = checkInit i in
+ typeMatch it t
+
+and checkStmt (s: stmt) =
+ E.withContext
+ (fun _ ->
+ (* Print context only for certain small statements *)
+ match s.skind with
+ (*Loop _*) While _ | DoWhile _ | For _ | If _ | Switch _ -> nil
+ | _ -> dprintf "checkStmt: %a" d_stmt s)
+ (fun _ ->
+ (* Check the labels *)
+ let checkLabel = function
+ Label (ln, l, _) ->
+ if H.mem labels ln then
+ ignore (warn "Multiply defined label %s" ln);
+ H.add labels ln ()
+ | Case (e, _) -> checkExpType true e intType
+ | _ -> () (* Not yet implemented *)
+ in
+ List.iter checkLabel s.labels;
+ (* See if we have seen this statement before *)
+ if List.memq s !statements then
+ ignore (warn "Statement is shared");
+ (* Remember that we have seen this one *)
+ statements := s :: !statements;
+ match s.skind with
+ Break _ | Continue _ -> ()
+ | Goto (gref, l) ->
+ currentLoc := l;
+ (* Find a label *)
+ let lab =
+ match List.filter (function Label _ -> true | _ -> false)
+ !gref.labels with
+ Label (lab, _, _) :: _ -> lab
+ | _ ->
+ ignore (warn "Goto to block without a label\n");
+ "<missing label>"
+ in
+ (* Remember it as a target *)
+ gotoTargets := (lab, !gref) :: !gotoTargets
+
+
+ | Return (re,l) -> begin
+ currentLoc := l;
+ match re, !currentReturnType with
+ None, TVoid _ -> ()
+ | _, TVoid _ -> ignore (warn "Invalid return value")
+ | None, _ -> ignore (warn "Invalid return value")
+ | Some re', rt' -> checkExpType false re' rt'
+ end
+(*
+ | Loop (b, l, _, _) -> checkBlock b
+*)
+ | While (e, b, l) ->
+ currentLoc := l;
+ let te = checkExp false e in
+ checkBooleanType te;
+ checkBlock b;
+ | DoWhile (e, b, l) ->
+ currentLoc := l;
+ let te = checkExp false e in
+ checkBooleanType te;
+ checkBlock b;
+ | For (bInit, e, bIter, b, l) ->
+ currentLoc := l;
+ checkBlock bInit;
+ let te = checkExp false e in
+ checkBooleanType te;
+ checkBlock bIter;
+ checkBlock b;
+ | Block b -> checkBlock b
+ | If (e, bt, bf, l) ->
+ currentLoc := l;
+ let te = checkExp false e in
+ checkBooleanType te;
+ checkBlock bt;
+ checkBlock bf
+ | Switch (e, b, cases, l) ->
+ currentLoc := l;
+ checkExpType false e intType;
+ (* Remember the statements so far *)
+ let prevStatements = !statements in
+ checkBlock b;
+ (* Now make sure that all the cases do occur in that block *)
+ List.iter
+ (fun c ->
+ if not (List.exists (function Case _ -> true | _ -> false)
+ c.labels) then
+ ignore (warn "Case in switch statment without a \"case\"\n");
+ (* Make sure it is in there *)
+ let rec findCase = function
+ | l when l == prevStatements -> (* Not found *)
+ ignore (warnContext
+ "Cannot find target of switch statement")
+ | [] -> E.s (E.bug "Check: findCase")
+ | c' :: rest when c == c' -> () (* Found *)
+ | _ :: rest -> findCase rest
+ in
+ findCase !statements)
+ cases;
+ | TryFinally (b, h, l) ->
+ currentLoc := l;
+ checkBlock b;
+ checkBlock h
+
+ | TryExcept (b, (il, e), h, l) ->
+ currentLoc := l;
+ checkBlock b;
+ List.iter checkInstr il;
+ checkExpType false e intType;
+ checkBlock h
+
+ | Instr il -> List.iter checkInstr il)
+ () (* argument of withContext *)
+
+and checkBlock (b: block) : unit =
+ List.iter checkStmt b.bstmts
+
+
+and checkInstr (i: instr) =
+ match i with
+ | Set (dest, e, l) ->
+ currentLoc := l;
+ let t = checkLval false dest in
+ (* Not all types can be assigned to *)
+ (match unrollType t with
+ TFun _ -> ignore (warn "Assignment to a function type")
+ | TArray _ -> ignore (warn "Assignment to an array type")
+ | TVoid _ -> ignore (warn "Assignment to a void type")
+ | _ -> ());
+ checkExpType false e t
+
+ | Call(dest, what, args, l) ->
+ currentLoc := l;
+ let (rt, formals, isva) =
+ match checkExp false what with
+ TFun(rt, formals, isva, _) -> rt, formals, isva
+ | _ -> E.s (bug "Call to a non-function")
+ in
+ (* Now check the return value*)
+ (match dest, unrollType rt with
+ None, TVoid _ -> ()
+ | Some _, TVoid _ -> ignore (warn "void value is assigned")
+ | None, _ -> () (* "Call of function is not assigned" *)
+ | Some destlv, rt' ->
+ let desttyp = checkLval false destlv in
+ if typeSig desttyp <> typeSig rt then begin
+ (* Not all types can be assigned to *)
+ (match unrollType desttyp with
+ TFun _ -> ignore (warn "Assignment to a function type")
+ | TArray _ -> ignore (warn "Assignment to an array type")
+ | TVoid _ -> ignore (warn "Assignment to a void type")
+ | _ -> ());
+ (* Not all types can be cast *)
+ (match rt' with
+ TArray _ -> ignore (warn "Cast of an array type")
+ | TFun _ -> ignore (warn "Cast of a function type")
+ | TComp _ -> ignore (warn "Cast of a composite type")
+ | TVoid _ -> ignore (warn "Cast of a void type")
+
+ | _ -> ())
+ end);
+ (* Now check the arguments *)
+ let rec loopArgs formals args =
+ match formals, args with
+ [], _ when (isva || args = []) -> ()
+ | (fn,ft,_) :: formals, a :: args ->
+ checkExpType false a ft;
+ loopArgs formals args
+ | _, _ -> ignore (warn "Not enough arguments")
+ in
+ if formals = None then
+ ignore (warn "Call to function without prototype\n")
+ else
+ loopArgs (argsToList formals) args
+
+ | Asm _ -> () (* Not yet implemented *)
+
+let rec checkGlobal = function
+ GAsm _ -> ()
+ | GPragma _ -> ()
+ | GText _ -> ()
+ | GType (ti, l) ->
+ currentLoc := l;
+ E.withContext (fun _ -> dprintf "GType(%s)" ti.tname)
+ (fun _ ->
+ checkTypeInfo Defined ti;
+ if ti.tname <> "" then defineName ti.tname)
+ ()
+
+ | GCompTag (comp, l) ->
+ currentLoc := l;
+ checkCompInfo Defined comp;
+
+ | GCompTagDecl (comp, l) ->
+ currentLoc := l;
+ checkCompInfo Forward comp;
+
+ | GEnumTag (enum, l) ->
+ currentLoc := l;
+ checkEnumInfo Defined enum
+
+ | GEnumTagDecl (enum, l) ->
+ currentLoc := l;
+ checkEnumInfo Forward enum
+
+ | GVarDecl (vi, l) ->
+ currentLoc := l;
+ (* We might have seen it already *)
+ E.withContext (fun _ -> dprintf "GVarDecl(%s)" vi.vname)
+ (fun _ ->
+ (* If we have seen this vid already then it must be for the exact
+ * same varinfo *)
+ if H.mem varIdsEnv vi.vid then
+ checkVariable vi
+ else begin
+ defineVariable vi;
+ checkAttributes vi.vattr;
+ checkType vi.vtype CTDecl;
+ if not (vi.vglob &&
+ vi.vstorage <> Register) then
+ E.s (bug "Invalid declaration of %s" vi.vname)
+ end)
+ ()
+
+ | GVar (vi, init, l) ->
+ currentLoc := l;
+ (* Maybe this is the first occurrence *)
+ E.withContext (fun _ -> dprintf "GVar(%s)" vi.vname)
+ (fun _ ->
+ checkGlobal (GVarDecl (vi, l));
+ (* Check the initializer *)
+ begin match init.init with
+ None -> ()
+ | Some i -> ignore (checkInitType i vi.vtype)
+ end;
+ (* Cannot be a function *)
+ if isFunctionType vi.vtype then
+ E.s (bug "GVar for a function (%s)\n" vi.vname);
+ )
+ ()
+
+
+ | GFun (fd, l) -> begin
+ currentLoc := l;
+ (* Check if this is the first occurrence *)
+ let vi = fd.svar in
+ let fname = vi.vname in
+ E.withContext (fun _ -> dprintf "GFun(%s)" fname)
+ (fun _ ->
+ checkGlobal (GVarDecl (vi, l));
+ (* Check that the argument types in the type are identical to the
+ * formals *)
+ let rec loopArgs targs formals =
+ match targs, formals with
+ [], [] -> ()
+ | (fn, ft, fa) :: targs, fo :: formals ->
+ if fn <> fo.vname || ft != fo.vtype || fa != fo.vattr then
+ ignore (warnContext
+ "Formal %s not shared (type + locals) in %s"
+ fo.vname fname);
+ loopArgs targs formals
+
+ | _ ->
+ E.s (bug "Type has different number of formals for %s"
+ fname)
+ in
+ begin match vi.vtype with
+ TFun (rt, args, isva, a) -> begin
+ currentReturnType := rt;
+ loopArgs (argsToList args) fd.sformals
+ end
+ | _ -> E.s (bug "Function %s does not have a function type"
+ fname)
+ end;
+ ignore (fd.smaxid >= 0 || E.s (bug "smaxid < 0 for %s" fname));
+ (* Now start a new environment, in a finally clause *)
+ begin try
+ startEnv ();
+ (* Do the locals *)
+ let doLocal tctx v =
+ if v.vglob then
+ ignore (warnContext
+ "Local %s has the vglob flag set" v.vname);
+ if v.vstorage <> NoStorage && v.vstorage <> Register then
+ ignore (warnContext
+ "Local %s has storage %a\n" v.vname
+ d_storage v.vstorage);
+ checkType v.vtype tctx;
+ checkAttributes v.vattr;
+ defineVariable v
+ in
+ List.iter (doLocal CTFArg) fd.sformals;
+ List.iter (doLocal CTDecl) fd.slocals;
+ statements := [];
+ gotoTargets := [];
+ checkBlock fd.sbody;
+ H.clear labels;
+ (* Now verify that we have scanned all targets *)
+ List.iter
+ (fun (lab, t) -> if not (List.memq t !statements) then
+ ignore (warnContext
+ "Target of \"goto %s\" statement does not appear in function body" lab))
+ !gotoTargets;
+ statements := [];
+ gotoTargets := [];
+ (* Done *)
+ endEnv ()
+ with e ->
+ endEnv ();
+ raise e
+ end;
+ ())
+ () (* final argument of withContext *)
+ end
+
+
+let checkFile flags fl =
+ if !E.verboseFlag then ignore (E.log "Checking file %s\n" fl.fileName);
+ valid := true;
+ List.iter
+ (function
+ NoCheckGlobalIds -> checkGlobalIds := false)
+ flags;
+ iterGlobals fl (fun g -> try checkGlobal g with _ -> ());
+ (* Check that for all struct/union tags there is a definition *)
+ H.iter
+ (fun k (comp, isadef) ->
+ if !isadef = Used then
+ begin
+ valid := false;
+ ignore (E.warn "Compinfo %s is referenced but not defined"
+ (compFullName comp))
+ end)
+ compUsed;
+ (* Check that for all enum tags there is a definition *)
+ H.iter
+ (fun k (enum, isadef) ->
+ if !isadef = Used then
+ begin
+ valid := false;
+ ignore (E.warn "Enuminfo %s is referenced but not defined"
+ enum.ename)
+ end)
+ enumUsed;
+ (* Clean the hashes to let the GC do its job *)
+ H.clear typeDefs;
+ H.clear varNamesEnv;
+ H.clear varIdsEnv;
+ H.clear allVarIds;
+ H.clear compNames;
+ H.clear compUsed;
+ H.clear enumUsed;
+ H.clear typUsed;
+ varNamesList := [];
+ if !E.verboseFlag then
+ ignore (E.log "Finished checking file %s\n" fl.fileName);
+ !valid
+
diff --git a/cil/src/check.mli b/cil/src/check.mli
new file mode 100644
index 0000000..fdcb8b8
--- /dev/null
+++ b/cil/src/check.mli
@@ -0,0 +1,45 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+ (* Checks the well-formedness of the file. Prints warnings and
+ * returns false if errors are found *)
+
+type checkFlags =
+ NoCheckGlobalIds (* Do not check that the global ids have the proper
+ * hash value *)
+
+val checkFile: checkFlags list -> Cil.file -> bool
diff --git a/cil/src/cil.ml b/cil/src/cil.ml
new file mode 100644
index 0000000..2c4e12a
--- /dev/null
+++ b/cil/src/cil.ml
@@ -0,0 +1,6427 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+(* MODIF: useLogicalOperators flag set to true by default. *)
+
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+open Escape
+open Pretty
+open Trace (* sm: 'trace' function *)
+module E = Errormsg
+module H = Hashtbl
+module IH = Inthash
+
+(*
+ * CIL: An intermediate language for analyzing C progams.
+ *
+ * Version Tue Dec 12 15:21:52 PST 2000
+ * Scott McPeak, George Necula, Wes Weimer
+ *
+ *)
+
+(* The module Cilversion is generated automatically by Makefile from
+ * information in configure.in *)
+let cilVersion = Cilversion.cilVersion
+let cilVersionMajor = Cilversion.cilVersionMajor
+let cilVersionMinor = Cilversion.cilVersionMinor
+let cilVersionRevision = Cilversion.cilVersionRev
+
+(* A few globals that control the interpretation of C source *)
+let msvcMode = ref false (* Whether the pretty printer should
+ * print output for the MS VC
+ * compiler. Default is GCC *)
+
+let useLogicalOperators = ref (*false*) true
+
+
+module M = Machdep
+(* Cil.initCil will set this to the current machine description.
+ Makefile.cil generates the file obj/@ARCHOS@/machdep.ml,
+ which contains the descriptions of gcc and msvc. *)
+let theMachine : M.mach ref = ref M.gcc
+
+
+let lowerConstants: bool ref = ref true
+ (** Do lower constants (default true) *)
+let insertImplicitCasts: bool ref = ref true
+ (** Do insert implicit casts (default true) *)
+
+
+let little_endian = ref true
+let char_is_unsigned = ref false
+let underscore_name = ref false
+
+type lineDirectiveStyle =
+ | LineComment
+ | LinePreprocessorInput
+ | LinePreprocessorOutput
+
+let lineDirectiveStyle = ref (Some LinePreprocessorInput)
+
+let print_CIL_Input = ref false
+
+let printCilAsIs = ref false
+
+let lineLength = ref 80
+
+(* sm: return the string 's' if we're printing output for gcc, suppres
+ * it if we're printing for CIL to parse back in. the purpose is to
+ * hide things from gcc that it complains about, but still be able
+ * to do lossless transformations when CIL is the consumer *)
+let forgcc (s: string) : string =
+ if (!print_CIL_Input) then "" else s
+
+
+let debugConstFold = false
+
+(** The Abstract Syntax of CIL *)
+
+
+(** The top-level representation of a CIL source file. Its main contents is
+ the list of global declarations and definitions. *)
+type file =
+ { mutable fileName: string; (** The complete file name *)
+ mutable globals: global list; (** List of globals as they will appear
+ in the printed file *)
+ mutable globinit: fundec option;
+ (** An optional global initializer function. This is a function where
+ * you can put stuff that must be executed before the program is
+ * started. This function, is conceptually at the end of the file,
+ * although it is not part of the globals list. Use {!Cil.getGlobInit}
+ * to create/get one. *)
+ mutable globinitcalled: bool;
+ (** Whether the global initialization function is called in main. This
+ should always be false if there is no global initializer. When
+ you create a global initialization CIL will try to insert code in
+ main to call it. *)
+ }
+
+and comment = location * string
+
+(** The main type for representing global declarations and definitions. A list
+ of these form a CIL file. The order of globals in the file is generally
+ important. *)
+and global =
+ | GType of typeinfo * location
+ (** A typedef. All uses of type names (through the [TNamed] constructor)
+ must be preceeded in the file by a definition of the name. The string
+ is the defined name and always not-empty. *)
+
+ | GCompTag of compinfo * location
+ (** Defines a struct/union tag with some fields. There must be one of
+ these for each struct/union tag that you use (through the [TComp]
+ constructor) since this is the only context in which the fields are
+ printed. Consequently nested structure tag definitions must be
+ broken into individual definitions with the innermost structure
+ defined first. *)
+
+ | GCompTagDecl of compinfo * location
+ (** Declares a struct/union tag. Use as a forward declaration. This is
+ * printed without the fields. *)
+
+ | GEnumTag of enuminfo * location
+ (** Declares an enumeration tag with some fields. There must be one of
+ these for each enumeration tag that you use (through the [TEnum]
+ constructor) since this is the only context in which the items are
+ printed. *)
+
+ | GEnumTagDecl of enuminfo * location
+ (** Declares an enumeration tag. Use as a forward declaration. This is
+ * printed without the items. *)
+
+ | GVarDecl of varinfo * location
+ (** A variable declaration (not a definition). If the variable has a
+ function type then this is a prototype. There can be several
+ declarations and at most one definition for a given variable. If both
+ forms appear then they must share the same varinfo structure. A
+ prototype shares the varinfo with the fundec of the definition. Either
+ has storage Extern or there must be a definition in this file *)
+
+ | GVar of varinfo * initinfo * location
+ (** A variable definition. Can have an initializer. The initializer is
+ * updateable so that you can change it without requiring to recreate
+ * the list of globals. There can be at most one definition for a
+ * variable in an entire program. Cannot have storage Extern or function
+ * type. *)
+
+
+ | GFun of fundec * location
+ (** A function definition. *)
+
+ | GAsm of string * location (** Global asm statement. These ones
+ can contain only a template *)
+ | GPragma of attribute * location (** Pragmas at top level. Use the same
+ syntax as attributes *)
+ | GText of string (** Some text (printed verbatim) at
+ top level. E.g., this way you can
+ put comments in the output. *)
+
+
+(** The various types available. Every type is associated with a list of
+ * attributes, which are always kept in sorted order. Use {!Cil.addAttribute}
+ * and {!Cil.addAttributes} to construct list of attributes. If you want to
+ * inspect a type, you should use {!Cil.unrollType} to see through the uses
+ * of named types. *)
+and typ =
+ TVoid of attributes (** Void type *)
+ | TInt of ikind * attributes (** An integer type. The kind specifies
+ the sign and width. *)
+ | TFloat of fkind * attributes (** A floating-point type. The kind
+ specifies the precision. *)
+
+ | TPtr of typ * attributes
+ (** Pointer type. *)
+
+ | TArray of typ * exp option * attributes
+ (** Array type. It indicates the base type and the array length. *)
+
+ | TFun of typ * (string * typ * attributes) list option * bool * attributes
+ (** Function type. Indicates the type of the result, the name, type
+ * and name attributes of the formal arguments ([None] if no
+ * arguments were specified, as in a function whose definition or
+ * prototype we have not seen; [Some \[\]] means void). Use
+ * {!Cil.argsToList} to obtain a list of arguments. The boolean
+ * indicates if it is a variable-argument function. If this is the
+ * type of a varinfo for which we have a function declaration then
+ * the information for the formals must match that in the
+ * function's sformals. *)
+
+ | TNamed of typeinfo * attributes
+ (* The use of a named type. All uses of the same type name must
+ * share the typeinfo. Each such type name must be preceeded
+ * in the file by a [GType] global. This is printed as just the
+ * type name. The actual referred type is not printed here and is
+ * carried only to simplify processing. To see through a sequence
+ * of named type references, use {!Cil.unrollType}. The attributes
+ * are in addition to those given when the type name was defined. *)
+
+ | TComp of compinfo * attributes
+ (** A reference to a struct or a union type. All references to the
+ same struct or union must share the same compinfo among them and
+ with a [GCompTag] global that preceeds all uses (except maybe
+ those that are pointers to the composite type). The attributes
+ given are those pertaining to this use of the type and are in
+ addition to the attributes that were given at the definition of
+ the type and which are stored in the compinfo. *)
+
+ | TEnum of enuminfo * attributes
+ (** A reference to an enumeration type. All such references must
+ share the enuminfo among them and with a [GEnumTag] global that
+ preceeds all uses. The attributes refer to this use of the
+ enumeration and are in addition to the attributes of the
+ enumeration itself, which are stored inside the enuminfo *)
+
+
+
+ | TBuiltin_va_list of attributes
+ (** This is the same as the gcc's type with the same name *)
+
+(** Various kinds of integers *)
+and ikind =
+ IChar (** [char] *)
+ | ISChar (** [signed char] *)
+ | IUChar (** [unsigned char] *)
+ | IInt (** [int] *)
+ | IUInt (** [unsigned int] *)
+ | IShort (** [short] *)
+ | IUShort (** [unsigned short] *)
+ | ILong (** [long] *)
+ | IULong (** [unsigned long] *)
+ | ILongLong (** [long long] (or [_int64] on Microsoft Visual C) *)
+ | IULongLong (** [unsigned long long] (or [unsigned _int64] on Microsoft
+ Visual C) *)
+
+(** Various kinds of floating-point numbers*)
+and fkind =
+ FFloat (** [float] *)
+ | FDouble (** [double] *)
+ | FLongDouble (** [long double] *)
+
+(** An attribute has a name and some optional parameters *)
+and attribute = Attr of string * attrparam list
+
+(** Attributes are lists sorted by the attribute name *)
+and attributes = attribute list
+
+(** The type of parameters in attributes *)
+and attrparam =
+ | AInt of int (** An integer constant *)
+ | AStr of string (** A string constant *)
+ | ACons of string * attrparam list (** Constructed attributes. These
+ are printed [foo(a1,a2,...,an)].
+ The list of parameters can be
+ empty and in that case the
+ parentheses are not printed. *)
+ | ASizeOf of typ (** A way to talk about types *)
+ | ASizeOfE of attrparam
+ | ASizeOfS of typsig (** Replacement for ASizeOf in type
+ signatures. Only used for
+ attributes inside typsigs.*)
+ | AAlignOf of typ
+ | AAlignOfE of attrparam
+ | AAlignOfS of typsig
+ | AUnOp of unop * attrparam
+ | ABinOp of binop * attrparam * attrparam
+ | ADot of attrparam * string (** a.foo **)
+
+
+(** Information about a composite type (a struct or a union). Use
+ {!Cil.mkCompInfo}
+ to create non-recursive or (potentially) recursive versions of this. Make
+ sure you have a [GCompTag] for each one of these. *)
+and compinfo = {
+ mutable cstruct: bool; (** True if struct, False if union *)
+ mutable cname: string; (** The name. Always non-empty. Use
+ * {!Cil.compFullName} to get the
+ * full name of a comp (along with
+ * the struct or union) *)
+ mutable ckey: int; (** A unique integer constructed from
+ * the name. Use {!Hashtbl.hash} on
+ * the string returned by
+ * {!Cil.compFullName}. All compinfo
+ * for a given key are shared. *)
+ mutable cfields: fieldinfo list; (** Information about the fields *)
+ mutable cattr: attributes; (** The attributes that are defined at
+ the same time as the composite
+ type *)
+ mutable cdefined: bool; (** Whether this is a defined
+ * compinfo. *)
+ mutable creferenced: bool; (** True if used. Initially set to
+ * false *)
+ }
+
+(** Information about a struct/union field *)
+and fieldinfo = {
+ mutable fcomp: compinfo; (** The compinfo of the host. Note
+ that this must be shared with the
+ host since there can be only one
+ compinfo for a given id *)
+ mutable fname: string; (** The name of the field. Might be
+ * the value of
+ * {!Cil.missingFieldName} in which
+ * case it must be a bitfield and is
+ * not printed and it does not
+ * participate in initialization *)
+ mutable ftype: typ; (** The type *)
+ mutable fbitfield: int option; (** If a bitfield then ftype should be
+ an integer type *)
+ mutable fattr: attributes; (** The attributes for this field
+ * (not for its type) *)
+ mutable floc: location; (** The location where this field
+ * is defined *)
+}
+
+
+
+(** Information about an enumeration. This is shared by all references to an
+ enumeration. Make sure you have a [GEnumTag] for each of of these. *)
+and enuminfo = {
+ mutable ename: string; (** The name. Always non-empty *)
+ mutable eitems: (string * exp * location) list; (** Items with names
+ and values. This list
+ should be
+ non-empty. The item
+ values must be
+ compile-time
+ constants. *)
+ mutable eattr: attributes; (** Attributes *)
+ mutable ereferenced: bool; (** True if used. Initially set to false*)
+}
+
+(** Information about a defined type *)
+and typeinfo = {
+ mutable tname: string;
+ (** The name. Can be empty only in a [GType] when introducing a composite
+ * or enumeration tag. If empty cannot be refered to from the file *)
+ mutable ttype: typ;
+ (** The actual type. *)
+ mutable treferenced: bool;
+ (** True if used. Initially set to false*)
+}
+
+
+(** Information about a variable. These structures are shared by all
+ * references to the variable. So, you can change the name easily, for
+ * example. Use one of the {!Cil.makeLocalVar}, {!Cil.makeTempVar} or
+ * {!Cil.makeGlobalVar} to create instances of this data structure. *)
+and varinfo = {
+ mutable vname: string; (** The name of the variable. Cannot
+ * be empty. *)
+ mutable vtype: typ; (** The declared type of the
+ * variable. *)
+ mutable vattr: attributes; (** A list of attributes associated
+ * with the variable. *)
+ mutable vstorage: storage; (** The storage-class *)
+ (* The other fields are not used in varinfo when they appear in the formal
+ * argument list in a [TFun] type *)
+
+
+ mutable vglob: bool; (** True if this is a global variable*)
+
+ (** Whether this varinfo is for an inline function. *)
+ mutable vinline: bool;
+
+ mutable vdecl: location; (** Location of variable declaration *)
+
+ mutable vid: int; (** A unique integer identifier. *)
+ mutable vaddrof: bool; (** True if the address of this
+ variable is taken. CIL will set
+ * these flags when it parses C, but
+ * you should make sure to set the
+ * flag whenever your transformation
+ * create [AddrOf] expression. *)
+
+ mutable vreferenced: bool; (** True if this variable is ever
+ referenced. This is computed by
+ [removeUnusedVars]. It is safe to
+ just initialize this to False *)
+}
+
+(** Storage-class information *)
+and storage =
+ NoStorage | (** The default storage. Nothing is
+ * printed *)
+ Static |
+ Register |
+ Extern
+
+
+(** Expressions (Side-effect free)*)
+and exp =
+ Const of constant (** Constant *)
+ | Lval of lval (** Lvalue *)
+ | SizeOf of typ (** sizeof(<type>). Has [unsigned
+ * int] type (ISO 6.5.3.4). This is
+ * not turned into a constant because
+ * some transformations might want to
+ * change types *)
+
+ | SizeOfE of exp (** sizeof(<expression>) *)
+ | SizeOfStr of string
+ (** sizeof(string_literal). We separate this case out because this is the
+ * only instance in which a string literal should not be treated as
+ * having type pointer to character. *)
+
+ | AlignOf of typ (** Has [unsigned int] type *)
+ | AlignOfE of exp
+
+
+ | UnOp of unop * exp * typ (** Unary operation. Includes
+ the type of the result *)
+
+ | BinOp of binop * exp * exp * typ
+ (** Binary operation. Includes the
+ type of the result. The arithemtic
+ conversions are made explicit
+ for the arguments *)
+ | CastE of typ * exp (** Use {!Cil.mkCast} to make casts *)
+
+ | AddrOf of lval (** Always use {!Cil.mkAddrOf} to
+ * construct one of these. Apply to an
+ * lvalue of type [T] yields an
+ * expression of type [TPtr(T)] *)
+
+ | StartOf of lval (** There is no C correspondent for this. C has
+ * implicit coercions from an array to the address
+ * of the first element. [StartOf] is used in CIL to
+ * simplify type checking and is just an explicit
+ * form of the above mentioned implicit conversion.
+ * It is not printed. Given an lval of type
+ * [TArray(T)] produces an expression of type
+ * [TPtr(T)]. *)
+
+
+(** Literal constants *)
+and constant =
+ | CInt64 of int64 * ikind * string option
+ (** Integer constant. Give the ikind (see ISO9899 6.1.3.2)
+ * and the textual representation, if available. Use
+ * {!Cil.integer} or {!Cil.kinteger} to create these. Watch
+ * out for integers that cannot be represented on 64 bits.
+ * OCAML does not give Overflow exceptions. *)
+ | CStr of string (** String constant (of pointer type) *)
+ | CWStr of int64 list (** Wide string constant (of type "wchar_t *") *)
+ | CChr of char (** Character constant. This has type int, so use
+ * charConstToInt to read the value in case
+ * sign-extension is needed. *)
+ | CReal of float * fkind * string option (** Floating point constant. Give
+ the fkind (see ISO 6.4.4.2) and
+ also the textual representation,
+ if available *)
+ | CEnum of exp * string * enuminfo
+ (** An enumeration constant with the given value, name, from the given
+ * enuminfo. This is not used if {!Cil.lowerEnum} is false (default).
+ * Use {!Cillower.lowerEnumVisitor} to replace these with integer
+ * constants. *)
+
+(** Unary operators *)
+and unop =
+ Neg (** Unary minus *)
+ | BNot (** Bitwise complement (~) *)
+ | LNot (** Logical Not (!) *)
+
+(** Binary operations *)
+and binop =
+ PlusA (** arithmetic + *)
+ | PlusPI (** pointer + integer *)
+ | IndexPI (** pointer + integer but only when
+ * it arises from an expression
+ * [e\[i\]] when [e] is a pointer and
+ * not an array. This is semantically
+ * the same as PlusPI but CCured uses
+ * this as a hint that the integer is
+ * probably positive. *)
+ | MinusA (** arithmetic - *)
+ | MinusPI (** pointer - integer *)
+ | MinusPP (** pointer - pointer *)
+ | Mult (** * *)
+ | Div (** / *)
+ | Mod (** % *)
+ | Shiftlt (** shift left *)
+ | Shiftrt (** shift right *)
+
+ | Lt (** < (arithmetic comparison) *)
+ | Gt (** > (arithmetic comparison) *)
+ | Le (** <= (arithmetic comparison) *)
+ | Ge (** > (arithmetic comparison) *)
+ | Eq (** == (arithmetic comparison) *)
+ | Ne (** != (arithmetic comparison) *)
+ | BAnd (** bitwise and *)
+ | BXor (** exclusive-or *)
+ | BOr (** inclusive-or *)
+
+ | LAnd (** logical and *)
+ | LOr (** logical or *)
+
+
+
+
+(** An lvalue denotes the contents of a range of memory addresses. This range
+ * is denoted as a host object along with an offset within the object. The
+ * host object can be of two kinds: a local or global variable, or an object
+ * whose address is in a pointer expression. We distinguish the two cases so
+ * that we can tell quickly whether we are accessing some component of a
+ * variable directly or we are accessing a memory location through a pointer.*)
+and lval =
+ lhost * offset
+
+(** The host part of an {!Cil.lval}. *)
+and lhost =
+ | Var of varinfo
+ (** The host is a variable. *)
+
+ | Mem of exp
+ (** The host is an object of type [T] when the expression has pointer
+ * [TPtr(T)]. *)
+
+
+(** The offset part of an {!Cil.lval}. Each offset can be applied to certain
+ * kinds of lvalues and its effect is that it advances the starting address
+ * of the lvalue and changes the denoted type, essentially focussing to some
+ * smaller lvalue that is contained in the original one. *)
+and offset =
+ | NoOffset (** No offset. Can be applied to any lvalue and does
+ * not change either the starting address or the type.
+ * This is used when the lval consists of just a host
+ * or as a terminator in a list of other kinds of
+ * offsets. *)
+
+ | Field of fieldinfo * offset
+ (** A field offset. Can be applied only to an lvalue
+ * that denotes a structure or a union that contains
+ * the mentioned field. This advances the offset to the
+ * beginning of the mentioned field and changes the
+ * type to the type of the mentioned field. *)
+
+ | Index of exp * offset
+ (** An array index offset. Can be applied only to an
+ * lvalue that denotes an array. This advances the
+ * starting address of the lval to the beginning of the
+ * mentioned array element and changes the denoted type
+ * to be the type of the array element *)
+
+
+
+(* The following equivalences hold *)
+(* Mem(AddrOf(Mem a, aoff)), off = Mem a, aoff + off *)
+(* Mem(AddrOf(Var v, aoff)), off = Var v, aoff + off *)
+(* AddrOf (Mem a, NoOffset) = a *)
+
+(** Initializers for global variables. You can create an initializer with
+ * {!Cil.makeZeroInit}. *)
+and init =
+ | SingleInit of exp (** A single initializer *)
+ | CompoundInit of typ * (offset * init) list
+ (** Used only for initializers of structures, unions and arrays.
+ * The offsets are all of the form [Field(f, NoOffset)] or
+ * [Index(i, NoOffset)] and specify the field or the index being
+ * initialized. For structures all fields
+ * must have an initializer (except the unnamed bitfields), in
+ * the proper order. This is necessary since the offsets are not
+ * printed. For arrays the list must contain a prefix of the
+ * initializers; the rest are 0-initialized.
+ * For unions there must be exactly one initializer. If
+ * the initializer is not for the first field then a field
+ * designator is printed, so you better be on GCC since MSVC does
+ * not understand this. You can scan an initializer list with
+ * {!Cil.foldLeftCompound}. *)
+
+(** We want to be able to update an initializer in a global variable, so we
+ * define it as a mutable field *)
+and initinfo = {
+ mutable init : init option;
+ }
+
+
+(** Function definitions. *)
+and fundec =
+ { mutable svar: varinfo;
+ (** Holds the name and type as a variable, so we can refer to it
+ * easily from the program. All references to this function either
+ * in a function call or in a prototype must point to the same
+ * varinfo. *)
+ mutable sformals: varinfo list;
+ (** Formals. These must be shared with the formals that appear in the
+ * type of the function. Use {!Cil.setFormals} or
+ * {!Cil.setFunctionType} to set these
+ * formals and ensure that they are reflected in the function type.
+ * Do not make copies of these because the body refers to them. *)
+ mutable slocals: varinfo list;
+ (** Locals. Does not include the sformals. Do not make copies of
+ * these because the body refers to them. *)
+ mutable smaxid: int; (** Max local id. Starts at 0. *)
+ mutable sbody: block; (** The function body. *)
+ mutable smaxstmtid: int option; (** max id of a (reachable) statement
+ * in this function, if we have
+ * computed it. range = 0 ...
+ * (smaxstmtid-1). This is computed by
+ * {!Cil.computeCFGInfo}. *)
+ mutable sallstmts: stmt list; (** After you call {!Cil.computeCFGInfo}
+ * this field is set to contain all
+ * statements in the function *)
+ }
+
+
+(** A block is a sequence of statements with the control falling through from
+ one element to the next *)
+and block =
+ { mutable battrs: attributes; (** Attributes for the block *)
+ mutable bstmts: stmt list; (** The statements comprising the block*)
+ }
+
+
+(** Statements.
+ The statement is the structural unit in the control flow graph. Use mkStmt
+ to make a statement and then fill in the fields. *)
+and stmt = {
+ mutable labels: label list; (** Whether the statement starts with
+ some labels, case statements or
+ default statement *)
+ mutable skind: stmtkind; (** The kind of statement *)
+
+ (* Now some additional control flow information. Initially this is not
+ * filled in. *)
+ mutable sid: int; (** A number (>= 0) that is unique
+ in a function. *)
+ mutable succs: stmt list; (** The successor statements. They can
+ always be computed from the skind
+ and the context in which this
+ statement appears *)
+ mutable preds: stmt list; (** The inverse of the succs function*)
+ }
+
+(** Labels *)
+and label =
+ Label of string * location * bool
+ (** A real label. If the bool is "true", the label is from the
+ * input source program. If the bool is "false", the label was
+ * created by CIL or some other transformation *)
+ | Case of exp * location (** A case statement *)
+ | Default of location (** A default statement *)
+
+
+
+(* The various kinds of statements *)
+and stmtkind =
+ | Instr of instr list (** A group of instructions that do not
+ contain control flow. Control
+ implicitly falls through. *)
+ | Return of exp option * location (** The return statement. This is a
+ leaf in the CFG. *)
+
+ | Goto of stmt ref * location (** A goto statement. Appears from
+ actual goto's in the code. *)
+ | Break of location (** A break to the end of the nearest
+ enclosing loop or Switch *)
+ | Continue of location (** A continue to the start of the
+ nearest enclosing loop *)
+ | If of exp * block * block * location (** A conditional.
+ Two successors, the "then" and
+ the "else" branches. Both
+ branches fall-through to the
+ successor of the If statement *)
+ | Switch of exp * block * (stmt list) * location
+ (** A switch statement. The block
+ contains within all of the cases.
+ We also have direct pointers to the
+ statements that implement the
+ cases. Which cases they implement
+ you can get from the labels of the
+ statement *)
+
+(*
+ | Loop of block * location * (stmt option) * (stmt option)
+ (** A [while(1)] loop. The
+ * termination test is implemented
+ * in the body of a loop using a
+ * [Break] statement. If
+ * prepareCFG has been called, the
+ * first stmt option will point to
+ * the stmt containing the
+ * continue label for this loop
+ * and the second will point to
+ * the stmt containing the break
+ * label for this loop. *)
+*)
+ | While of exp * block * location (** A while loop. *)
+ | DoWhile of exp * block * location (** A do...while loop. *)
+ | For of block * exp * block * block * location (** A for loop. *)
+
+ | Block of block (** Just a block of statements. Use it
+ as a way to keep some attributes
+ local *)
+ (** On MSVC we support structured exception handling. This is what you
+ * might expect. Control can get into the finally block either from the
+ * end of the body block, or if an exception is thrown. The location
+ * corresponds to the try keyword. *)
+ | TryFinally of block * block * location
+
+ (** On MSVC we support structured exception handling. The try/except
+ * statement is a bit tricky:
+ __try { blk }
+ __except (e) {
+ handler
+ }
+
+ The argument to __except must be an expression. However, we keep a
+ list of instructions AND an expression in case you need to make
+ function calls. We'll print those as a comma expression. The control
+ can get to the __except expression only if an exception is thrown.
+ After that, depending on the value of the expression the control
+ goes to the handler, propagates the exception, or retries the
+ exception !!! The location corresponds to the try keyword.
+ *)
+ | TryExcept of block * (instr list * exp) * block * location
+
+
+(** Instructions. They may cause effects directly but may not have control
+ flow.*)
+and instr =
+ Set of lval * exp * location (** An assignment. A cast is present
+ if the exp has different type
+ from lval *)
+ | Call of lval option * exp * exp list * location
+ (** optional: result is an lval. A cast might be
+ necessary if the declared result type of the
+ function is not the same as that of the
+ destination. If the function is declared then
+ casts are inserted for those arguments that
+ correspond to declared formals. (The actual
+ number of arguments might be smaller or larger
+ than the declared number of arguments. C allows
+ this.) If the type of the result variable is not
+ the same as the declared type of the function
+ result then an implicit cast exists. *)
+
+ (* See the GCC specification for the meaning of ASM.
+ * If the source is MS VC then only the templates
+ * are used *)
+ (* sm: I've added a notes.txt file which contains more
+ * information on interpreting Asm instructions *)
+ | Asm of attributes * (* Really only const and volatile can appear
+ * here *)
+ string list * (* templates (CR-separated) *)
+ (string * lval) list * (* outputs must be lvals with
+ * constraints. I would like these
+ * to be actually variables, but I
+ * run into some trouble with ASMs
+ * in the Linux sources *)
+ (string * exp) list * (* inputs with constraints *)
+ string list * (* register clobbers *)
+ location
+ (** An inline assembly instruction. The arguments are (1) a list of
+ attributes (only const and volatile can appear here and only for
+ GCC), (2) templates (CR-separated), (3) a list of
+ outputs, each of which is an lvalue with a constraint, (4) a list
+ of input expressions along with constraints, (5) clobbered
+ registers, and (5) location information *)
+
+
+
+(** Describes a location in a source file *)
+and location = {
+ line: int; (** The line number. -1 means "do not know" *)
+ file: string; (** The name of the source file*)
+ byte: int; (** The byte position in the source file *)
+}
+
+(* Type signatures. Two types are identical iff they have identical
+ * signatures *)
+and typsig =
+ TSArray of typsig * int64 option * attribute list
+ | TSPtr of typsig * attribute list
+ | TSComp of bool * string * attribute list
+ | TSFun of typsig * typsig list * bool * attribute list
+ | TSEnum of string * attribute list
+ | TSBase of typ
+
+
+
+(** To be able to add/remove features easily, each feature should be package
+ * as an interface with the following interface. These features should be *)
+type featureDescr = {
+ fd_enabled: bool ref;
+ (** The enable flag. Set to default value *)
+
+ fd_name: string;
+ (** This is used to construct an option "--doxxx" and "--dontxxx" that
+ * enable and disable the feature *)
+
+ fd_description: string;
+ (* A longer name that can be used to document the new options *)
+
+ fd_extraopt: (string * Arg.spec * string) list;
+ (** Additional command line options *)
+
+ fd_doit: (file -> unit);
+ (** This performs the transformation *)
+
+ fd_post_check: bool;
+ (* Whether to perform a CIL consistency checking after this stage, if
+ * checking is enabled (--check is passed to cilly) *)
+}
+
+let locUnknown = { line = -1;
+ file = "";
+ byte = -1;}
+
+(* A reference to the current location *)
+let currentLoc : location ref = ref locUnknown
+
+(* A reference to the current global being visited *)
+let currentGlobal: global ref = ref (GText "dummy")
+
+
+let compareLoc (a: location) (b: location) : int =
+ let namecmp = compare a.file b.file in
+ if namecmp != 0
+ then namecmp
+ else
+ let linecmp = a.line - b.line in
+ if linecmp != 0
+ then linecmp
+ else a.byte - b.byte
+
+let argsToList : (string * typ * attributes) list option
+ -> (string * typ * attributes) list
+ = function
+ None -> []
+ | Some al -> al
+
+
+(* A hack to allow forward reference of d_exp *)
+let pd_exp : (unit -> exp -> doc) ref =
+ ref (fun _ -> E.s (E.bug "pd_exp not initialized"))
+
+(** Different visiting actions. 'a will be instantiated with [exp], [instr],
+ etc. *)
+type 'a visitAction =
+ SkipChildren (** Do not visit the children. Return
+ the node as it is. *)
+ | DoChildren (** Continue with the children of this
+ node. Rebuild the node on return
+ if any of the children changes
+ (use == test) *)
+ | ChangeTo of 'a (** Replace the expression with the
+ given one *)
+ | ChangeDoChildrenPost of 'a * ('a -> 'a) (** First consider that the entire
+ exp is replaced by the first
+ parameter. Then continue with
+ the children. On return rebuild
+ the node if any of the children
+ has changed and then apply the
+ function on the node *)
+
+
+
+(* sm/gn: cil visitor interface for traversing Cil trees. *)
+(* Use visitCilStmt and/or visitCilFile to use this. *)
+(* Some of the nodes are changed in place if the children are changed. Use
+ * one of Change... actions if you want to copy the node *)
+
+(** A visitor interface for traversing CIL trees. Create instantiations of
+ * this type by specializing the class {!Cil.nopCilVisitor}. *)
+class type cilVisitor = object
+
+ method vvdec: varinfo -> varinfo visitAction
+ (** Invoked for each variable declaration. The subtrees to be traversed
+ * are those corresponding to the type and attributes of the variable.
+ * Note that variable declarations are all the [GVar], [GVarDecl], [GFun],
+ * all the [varinfo] in formals of function types, and the formals and
+ * locals for function definitions. This means that the list of formals
+ * in a function definition will be traversed twice, once as part of the
+ * function type and second as part of the formals in a function
+ * definition. *)
+
+ method vvrbl: varinfo -> varinfo visitAction
+ (** Invoked on each variable use. Here only the [SkipChildren] and
+ * [ChangeTo] actions make sense since there are no subtrees. Note that
+ * the type and attributes of the variable are not traversed for a
+ * variable use *)
+
+ method vexpr: exp -> exp visitAction
+ (** Invoked on each expression occurence. The subtrees are the
+ * subexpressions, the types (for a [Cast] or [SizeOf] expression) or the
+ * variable use. *)
+
+ method vlval: lval -> lval visitAction
+ (** Invoked on each lvalue occurence *)
+
+ method voffs: offset -> offset visitAction
+ (** Invoked on each offset occurrence that is *not* as part
+ * of an initializer list specification, i.e. in an lval or
+ * recursively inside an offset. *)
+
+ method vinitoffs: offset -> offset visitAction
+ (** Invoked on each offset appearing in the list of a
+ * CompoundInit initializer. *)
+
+ method vinst: instr -> instr list visitAction
+ (** Invoked on each instruction occurrence. The [ChangeTo] action can
+ * replace this instruction with a list of instructions *)
+
+ method vstmt: stmt -> stmt visitAction
+ (** Control-flow statement. *)
+
+ method vblock: block -> block visitAction (** Block. Replaced in
+ place. *)
+ method vfunc: fundec -> fundec visitAction (** Function definition.
+ Replaced in place. *)
+ method vglob: global -> global list visitAction (** Global (vars, types,
+ etc.) *)
+ method vinit: init -> init visitAction (** Initializers for globals *)
+ method vtype: typ -> typ visitAction (** Use of some type. Note
+ * that for structure/union
+ * and enumeration types the
+ * definition of the
+ * composite type is not
+ * visited. Use [vglob] to
+ * visit it. *)
+ method vattr: attribute -> attribute list visitAction
+ (** Attribute. Each attribute can be replaced by a list *)
+ method vattrparam: attrparam -> attrparam visitAction
+ (** Attribute parameters. *)
+
+ (** Add here instructions while visiting to queue them to
+ * preceede the current statement or instruction being processed *)
+ method queueInstr: instr list -> unit
+
+ (** Gets the queue of instructions and resets the queue *)
+ method unqueueInstr: unit -> instr list
+
+end
+
+(* the default visitor does nothing at each node, but does *)
+(* not stop; hence they return true *)
+class nopCilVisitor : cilVisitor = object
+ method vvrbl (v:varinfo) = DoChildren (* variable *)
+ method vvdec (v:varinfo) = DoChildren (* variable
+ * declaration *)
+ method vexpr (e:exp) = DoChildren (* expression *)
+ method vlval (l:lval) = DoChildren (* lval (base is 1st
+ * field) *)
+ method voffs (o:offset) = DoChildren (* lval or recursive offset *)
+ method vinitoffs (o:offset) = DoChildren (* initializer offset *)
+ method vinst (i:instr) = DoChildren (* imperative instruction *)
+ method vstmt (s:stmt) = DoChildren (* constrol-flow statement *)
+ method vblock (b: block) = DoChildren
+ method vfunc (f:fundec) = DoChildren (* function definition *)
+ method vglob (g:global) = DoChildren (* global (vars, types, etc.) *)
+ method vinit (i:init) = DoChildren (* global initializers *)
+ method vtype (t:typ) = DoChildren (* use of some type *)
+ method vattr (a: attribute) = DoChildren
+ method vattrparam (a: attrparam) = DoChildren
+
+ val mutable instrQueue = []
+
+ method queueInstr (il: instr list) =
+ List.iter (fun i -> instrQueue <- i :: instrQueue) il
+
+ method unqueueInstr () =
+ let res = List.rev instrQueue in
+ instrQueue <- [];
+ res
+
+end
+
+let assertEmptyQueue vis =
+ if vis#unqueueInstr () <> [] then
+ (* Either a visitor inserted an instruction somewhere that it shouldn't
+ have (i.e. at the top level rather than inside of a statement), or
+ there's a bug in the visitor engine. *)
+ E.s (E.bug "Visitor's instruction queue is not empty.\n You should only use queueInstr inside a function body!");
+ ()
+
+
+let lu = locUnknown
+
+(* sm: utility *)
+let startsWith (prefix: string) (s: string) : bool =
+(
+ let prefixLen = (String.length prefix) in
+ (String.length s) >= prefixLen &&
+ (String.sub s 0 prefixLen) = prefix
+)
+
+
+let get_instrLoc (inst : instr) =
+ match inst with
+ Set(_, _, loc) -> loc
+ | Call(_, _, _, loc) -> loc
+ | Asm(_, _, _, _, _, loc) -> loc
+let get_globalLoc (g : global) =
+ match g with
+ | GFun(_,l) -> (l)
+ | GType(_,l) -> (l)
+ | GEnumTag(_,l) -> (l)
+ | GEnumTagDecl(_,l) -> (l)
+ | GCompTag(_,l) -> (l)
+ | GCompTagDecl(_,l) -> (l)
+ | GVarDecl(_,l) -> (l)
+ | GVar(_,_,l) -> (l)
+ | GAsm(_,l) -> (l)
+ | GPragma(_,l) -> (l)
+ | GText(_) -> locUnknown
+
+let rec get_stmtLoc (statement : stmtkind) =
+ match statement with
+ Instr([]) -> lu
+ | Instr(hd::tl) -> get_instrLoc(hd)
+ | Return(_, loc) -> loc
+ | Goto(_, loc) -> loc
+ | Break(loc) -> loc
+ | Continue(loc) -> loc
+ | If(_, _, _, loc) -> loc
+ | Switch (_, _, _, loc) -> loc
+(*
+ | Loop (_, loc, _, _) -> loc
+*)
+ | While (_, _, loc) -> loc
+ | DoWhile (_, _, loc) -> loc
+ | For (_, _, _, _, loc) -> loc
+ | Block b -> if b.bstmts == [] then lu
+ else get_stmtLoc ((List.hd b.bstmts).skind)
+ | TryFinally (_, _, l) -> l
+ | TryExcept (_, _, _, l) -> l
+
+
+(* The next variable identifier to use. Counts up *)
+let nextGlobalVID = ref 1
+
+(* The next compindo identifier to use. Counts up. *)
+let nextCompinfoKey = ref 1
+
+(* Some error reporting functions *)
+let d_loc (_: unit) (loc: location) : doc =
+ text loc.file ++ chr ':' ++ num loc.line
+
+let d_thisloc (_: unit) : doc = d_loc () !currentLoc
+
+let error (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ E.hadErrors := true;
+ ignore (eprintf "@!%t: Error: %a@!"
+ d_thisloc insert d);
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let unimp (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ E.hadErrors := true;
+ ignore (eprintf "@!%t: Unimplemented: %a@!"
+ d_thisloc insert d);
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let bug (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ E.hadErrors := true;
+ ignore (eprintf "@!%t: Bug: %a@!"
+ d_thisloc insert d);
+ E.showContext ();
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let errorLoc (loc: location) (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ E.hadErrors := true;
+ ignore (eprintf "@!%a: Error: %a@!"
+ d_loc loc insert d);
+ E.showContext ();
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let warn (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ ignore (eprintf "@!%t: Warning: %a@!"
+ d_thisloc insert d);
+ nil
+ in
+ Pretty.gprintf f fmt
+
+
+let warnOpt (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ if !E.warnFlag then
+ ignore (eprintf "@!%t: Warning: %a@!"
+ d_thisloc insert d);
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let warnContext (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ ignore (eprintf "@!%t: Warning: %a@!"
+ d_thisloc insert d);
+ E.showContext ();
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let warnContextOpt (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ if !E.warnFlag then
+ ignore (eprintf "@!%t: Warning: %a@!"
+ d_thisloc insert d);
+ E.showContext ();
+ nil
+ in
+ Pretty.gprintf f fmt
+
+let warnLoc (loc: location) (fmt : ('a,unit,doc) format) : 'a =
+ let f d =
+ ignore (eprintf "@!%a: Warning: %a@!"
+ d_loc loc insert d);
+ E.showContext ();
+ nil
+ in
+ Pretty.gprintf f fmt
+
+
+
+(* Construct an integer. Use only for values that fit on 31 bits.
+ For larger values, use kinteger *)
+let integer (i: int) = Const (CInt64(Int64.of_int i, IInt, None))
+
+let zero = integer 0
+let one = integer 1
+let mone = integer (-1)
+
+(** Given the character c in a (CChr c), sign-extend it to 32 bits.
+ (This is the official way of interpreting character constants, according to
+ ISO C 6.4.4.4.10, which says that character constants are chars cast to ints)
+ Returns CInt64(sign-extened c, IInt, None) *)
+let charConstToInt (c: char) : constant =
+ let c' = Char.code c in
+ let value =
+ if c' < 128
+ then Int64.of_int c'
+ else Int64.of_int (c' - 256)
+ in
+ CInt64(value, IInt, None)
+
+
+let rec isInteger = function
+ | Const(CInt64 (n,_,_)) -> Some n
+ | Const(CChr c) -> isInteger (Const (charConstToInt c)) (* sign-extend *)
+ | Const(CEnum(v, s, ei)) -> isInteger v
+ | CastE(_, e) -> isInteger e
+ | _ -> None
+
+
+
+let rec isZero (e: exp) : bool = isInteger e = Some Int64.zero
+
+let voidType = TVoid([])
+let intType = TInt(IInt,[])
+let uintType = TInt(IUInt,[])
+let longType = TInt(ILong,[])
+let ulongType = TInt(IULong,[])
+let charType = TInt(IChar, [])
+
+let charPtrType = TPtr(charType,[])
+let charConstPtrType = TPtr(TInt(IChar, [Attr("const", [])]),[])
+let stringLiteralType = ref charPtrType
+
+let voidPtrType = TPtr(voidType, [])
+let intPtrType = TPtr(intType, [])
+let uintPtrType = TPtr(uintType, [])
+
+let doubleType = TFloat(FDouble, [])
+
+
+(* An integer type that fits pointers. Initialized by initCIL *)
+let upointType = ref voidType
+
+(* An integer type that fits wchar_t. Initialized by initCIL *)
+let wcharKind = ref IChar
+let wcharType = ref voidType
+
+
+(* An integer type that is the type of sizeof. Initialized by initCIL *)
+let typeOfSizeOf = ref voidType
+let kindOfSizeOf = ref IUInt
+
+let initCIL_called = ref false
+
+(** Returns true if and only if the given integer type is signed. *)
+let isSigned = function
+ | IUChar
+ | IUShort
+ | IUInt
+ | IULong
+ | IULongLong ->
+ false
+ | ISChar
+ | IShort
+ | IInt
+ | ILong
+ | ILongLong ->
+ true
+ | IChar ->
+ not !theMachine.M.char_is_unsigned
+
+let mkStmt (sk: stmtkind) : stmt =
+ { skind = sk;
+ labels = [];
+ sid = -1; succs = []; preds = [] }
+
+let mkBlock (slst: stmt list) : block =
+ { battrs = []; bstmts = slst; }
+
+let mkEmptyStmt () = mkStmt (Instr [])
+let mkStmtOneInstr (i: instr) = mkStmt (Instr [i])
+
+let dummyInstr = (Asm([], ["dummy statement!!"], [], [], [], lu))
+let dummyStmt = mkStmt (Instr [dummyInstr])
+
+let compactStmts (b: stmt list) : stmt list =
+ (* Try to compress statements. Scan the list of statements and remember
+ * the last instrunction statement encountered, along with a Clist of
+ * instructions in it. *)
+ let rec compress (lastinstrstmt: stmt) (* Might be dummStmt *)
+ (lastinstrs: instr Clist.clist)
+ (body: stmt list) =
+ let finishLast (tail: stmt list) : stmt list =
+ if lastinstrstmt == dummyStmt then tail
+ else begin
+ lastinstrstmt.skind <- Instr (Clist.toList lastinstrs);
+ lastinstrstmt :: tail
+ end
+ in
+ match body with
+ [] -> finishLast []
+ | ({skind=Instr il} as s) :: rest ->
+ let ils = Clist.fromList il in
+ if lastinstrstmt != dummyStmt && s.labels == [] then
+ compress lastinstrstmt (Clist.append lastinstrs ils) rest
+ else
+ finishLast (compress s ils rest)
+
+ | s :: rest ->
+ let res = s :: compress dummyStmt Clist.empty rest in
+ finishLast res
+ in
+ compress dummyStmt Clist.empty b
+
+
+(** Construct sorted lists of attributes ***)
+let rec addAttribute (Attr(an, _) as a: attribute) (al: attributes) =
+ let rec insertSorted = function
+ [] -> [a]
+ | ((Attr(an0, _) as a0) :: rest) as l ->
+ if an < an0 then a :: l
+ else if Util.equals a a0 then l (* Do not add if already in there *)
+ else a0 :: insertSorted rest (* Make sure we see all attributes with
+ * this name *)
+ in
+ insertSorted al
+
+(** The second attribute list is sorted *)
+and addAttributes al0 (al: attributes) : attributes =
+ if al0 == [] then al else
+ List.fold_left (fun acc a -> addAttribute a acc) al al0
+
+and dropAttribute (an: string) (al: attributes) =
+ List.filter (fun (Attr(an', _)) -> an <> an') al
+
+and dropAttributes (anl: string list) (al: attributes) =
+ List.fold_left (fun acc an -> dropAttribute an acc) al anl
+
+and filterAttributes (s: string) (al: attribute list) : attribute list =
+ List.filter (fun (Attr(an, _)) -> an = s) al
+
+(* sm: *)
+let hasAttribute s al =
+ (filterAttributes s al <> [])
+
+
+type attributeClass =
+ AttrName of bool
+ (* Attribute of a name. If argument is true and we are on MSVC then
+ * the attribute is printed using __declspec as part of the storage
+ * specifier *)
+ | AttrFunType of bool
+ (* Attribute of a function type. If argument is true and we are on
+ * MSVC then the attribute is printed just before the function name *)
+
+ | AttrType (* Attribute of a type *)
+
+(* This table contains the mapping of predefined attributes to classes.
+ * Extend this table with more attributes as you need. This table is used to
+ * determine how to associate attributes with names or type during cabs2cil
+ * conversion *)
+let attributeHash: (string, attributeClass) H.t =
+ let table = H.create 13 in
+ List.iter (fun a -> H.add table a (AttrName false))
+ [ "section"; "constructor"; "destructor"; "unused"; "used"; "weak";
+ "no_instrument_function"; "alias"; "no_check_memory_usage";
+ "exception"; "model"; (* "restrict"; *)
+ "aconst"; "__asm__" (* Gcc uses this to specifiy the name to be used in
+ * assembly for a global *)];
+
+ (* Now come the MSVC declspec attributes *)
+ List.iter (fun a -> H.add table a (AttrName true))
+ [ "thread"; "naked"; "dllimport"; "dllexport";
+ "selectany"; "allocate"; "nothrow"; "novtable"; "property"; "noreturn";
+ "uuid"; "align" ];
+
+ List.iter (fun a -> H.add table a (AttrFunType false))
+ [ "format"; "regparm"; "longcall";
+ "noinline"; "always_inline"; ];
+
+ List.iter (fun a -> H.add table a (AttrFunType true))
+ [ "stdcall";"cdecl"; "fastcall" ];
+
+ List.iter (fun a -> H.add table a AttrType)
+ [ "const"; "volatile"; "restrict"; "mode" ];
+ table
+
+
+(* Partition the attributes into classes *)
+let partitionAttributes
+ ~(default:attributeClass)
+ (attrs: attribute list) :
+ attribute list * attribute list * attribute list =
+ let rec loop (n,f,t) = function
+ [] -> n, f, t
+ | (Attr(an, _) as a) :: rest ->
+ match (try H.find attributeHash an with Not_found -> default) with
+ AttrName _ -> loop (addAttribute a n, f, t) rest
+ | AttrFunType _ ->
+ loop (n, addAttribute a f, t) rest
+ | AttrType -> loop (n, f, addAttribute a t) rest
+ in
+ loop ([], [], []) attrs
+
+
+(* Get the full name of a comp *)
+let compFullName comp =
+ (if comp.cstruct then "struct " else "union ") ^ comp.cname
+
+
+let missingFieldName = "___missing_field_name"
+
+(** Creates a a (potentially recursive) composite type. Make sure you add a
+ * GTag for it to the file! **)
+let mkCompInfo
+ (isstruct: bool)
+ (n: string)
+ (* fspec is a function that when given a forward
+ * representation of the structure type constructs the type of
+ * the fields. The function can ignore this argument if not
+ * constructing a recursive type. *)
+ (mkfspec: compinfo -> (string * typ * int option * attribute list *
+ location) list)
+ (a: attribute list) : compinfo =
+
+ (* make an new name for anonymous structs *)
+ if n = "" then
+ E.s (E.bug "mkCompInfo: missing structure name\n");
+ (* Make a new self cell and a forward reference *)
+ let comp =
+ { cstruct = isstruct; cname = ""; ckey = 0; cfields = [];
+ cattr = a; creferenced = false;
+ (* Make this compinfo undefined by default *)
+ cdefined = false; }
+ in
+ comp.cname <- n;
+ comp.ckey <- !nextCompinfoKey;
+ incr nextCompinfoKey;
+ let flds =
+ List.map (fun (fn, ft, fb, fa, fl) ->
+ { fcomp = comp;
+ ftype = ft;
+ fname = fn;
+ fbitfield = fb;
+ fattr = fa;
+ floc = fl}) (mkfspec comp) in
+ comp.cfields <- flds;
+ if flds <> [] then comp.cdefined <- true;
+ comp
+
+(** Make a copy of a compinfo, changing the name and the key *)
+let copyCompInfo (ci: compinfo) (n: string) : compinfo =
+ let ci' = {ci with cname = n;
+ ckey = !nextCompinfoKey; } in
+ incr nextCompinfoKey;
+ (* Copy the fields and set the new pointers to parents *)
+ ci'.cfields <- List.map (fun f -> {f with fcomp = ci'}) ci'.cfields;
+ ci'
+
+(**** Utility functions ******)
+
+let rec typeAttrs = function
+ TVoid a -> a
+ | TInt (_, a) -> a
+ | TFloat (_, a) -> a
+ | TNamed (t, a) -> addAttributes a (typeAttrs t.ttype)
+ | TPtr (_, a) -> a
+ | TArray (_, _, a) -> a
+ | TComp (comp, a) -> addAttributes comp.cattr a
+ | TEnum (enum, a) -> addAttributes enum.eattr a
+ | TFun (_, _, _, a) -> a
+ | TBuiltin_va_list a -> a
+
+
+let setTypeAttrs t a =
+ match t with
+ TVoid _ -> TVoid a
+ | TInt (i, _) -> TInt (i, a)
+ | TFloat (f, _) -> TFloat (f, a)
+ | TNamed (t, _) -> TNamed(t, a)
+ | TPtr (t', _) -> TPtr(t', a)
+ | TArray (t', l, _) -> TArray(t', l, a)
+ | TComp (comp, _) -> TComp (comp, a)
+ | TEnum (enum, _) -> TEnum (enum, a)
+ | TFun (r, args, v, _) -> TFun(r,args,v,a)
+ | TBuiltin_va_list _ -> TBuiltin_va_list a
+
+
+let typeAddAttributes a0 t =
+begin
+ match a0 with
+ | [] ->
+ (* no attributes, keep same type *)
+ t
+ | _ ->
+ (* anything else: add a0 to existing attributes *)
+ let add (a: attributes) = addAttributes a0 a in
+ match t with
+ TVoid a -> TVoid (add a)
+ | TInt (ik, a) -> TInt (ik, add a)
+ | TFloat (fk, a) -> TFloat (fk, add a)
+ | TEnum (enum, a) -> TEnum (enum, add a)
+ | TPtr (t, a) -> TPtr (t, add a)
+ | TArray (t, l, a) -> TArray (t, l, add a)
+ | TFun (t, args, isva, a) -> TFun(t, args, isva, add a)
+ | TComp (comp, a) -> TComp (comp, add a)
+ | TNamed (t, a) -> TNamed (t, add a)
+ | TBuiltin_va_list a -> TBuiltin_va_list (add a)
+end
+
+let typeRemoveAttributes (anl: string list) t =
+ let drop (al: attributes) = dropAttributes anl al in
+ match t with
+ TVoid a -> TVoid (drop a)
+ | TInt (ik, a) -> TInt (ik, drop a)
+ | TFloat (fk, a) -> TFloat (fk, drop a)
+ | TEnum (enum, a) -> TEnum (enum, drop a)
+ | TPtr (t, a) -> TPtr (t, drop a)
+ | TArray (t, l, a) -> TArray (t, l, drop a)
+ | TFun (t, args, isva, a) -> TFun(t, args, isva, drop a)
+ | TComp (comp, a) -> TComp (comp, drop a)
+ | TNamed (t, a) -> TNamed (t, drop a)
+ | TBuiltin_va_list a -> TBuiltin_va_list (drop a)
+
+let unrollType (t: typ) : typ =
+ let rec withAttrs (al: attributes) (t: typ) : typ =
+ match t with
+ TNamed (r, a') -> withAttrs (addAttributes al a') r.ttype
+ | x -> typeAddAttributes al x
+ in
+ withAttrs [] t
+
+let rec unrollTypeDeep (t: typ) : typ =
+ let rec withAttrs (al: attributes) (t: typ) : typ =
+ match t with
+ TNamed (r, a') -> withAttrs (addAttributes al a') r.ttype
+ | TPtr(t, a') -> TPtr(unrollTypeDeep t, addAttributes al a')
+ | TArray(t, l, a') -> TArray(unrollTypeDeep t, l, addAttributes al a')
+ | TFun(rt, args, isva, a') ->
+ TFun (unrollTypeDeep rt,
+ (match args with
+ None -> None
+ | Some argl ->
+ Some (List.map (fun (an,at,aa) ->
+ (an, unrollTypeDeep at, aa)) argl)),
+ isva,
+ addAttributes al a')
+ | x -> typeAddAttributes al x
+ in
+ withAttrs [] t
+
+let isVoidType t =
+ match unrollType t with
+ TVoid _ -> true
+ | _ -> false
+let isVoidPtrType t =
+ match unrollType t with
+ TPtr(tau,_) when isVoidType tau -> true
+ | _ -> false
+
+let var vi : lval = (Var vi, NoOffset)
+(* let assign vi e = Instrs(Set (var vi, e), lu) *)
+
+let mkString s = Const(CStr s)
+
+
+let mkWhile ~(guard:exp) ~(body: stmt list) : stmt list =
+ (* Do it like this so that the pretty printer recognizes it *)
+(*
+ [ mkStmt (Loop (mkBlock (mkStmt (If(guard,
+ mkBlock [ mkEmptyStmt () ],
+ mkBlock [ mkStmt (Break lu)], lu)) ::
+ body), lu, None, None)) ]
+*)
+ [ mkStmt (While (guard, mkBlock body, lu)) ]
+
+
+
+let mkFor ~(start: stmt list) ~(guard: exp) ~(next: stmt list)
+ ~(body: stmt list) : stmt list =
+ (start @
+ (mkWhile guard (body @ next)))
+
+
+let mkForIncr ~(iter : varinfo) ~(first: exp) ~stopat:(past: exp) ~(incr: exp)
+ ~(body: stmt list) : stmt list =
+ (* See what kind of operator we need *)
+ let compop, nextop =
+ match unrollType iter.vtype with
+ TPtr _ -> Lt, PlusPI
+ | _ -> Lt, PlusA
+ in
+ mkFor
+ [ mkStmt (Instr [(Set (var iter, first, lu))]) ]
+ (BinOp(compop, Lval(var iter), past, intType))
+ [ mkStmt (Instr [(Set (var iter,
+ (BinOp(nextop, Lval(var iter), incr, iter.vtype)),
+ lu))])]
+ body
+
+
+let rec stripCasts (e: exp) =
+ match e with CastE(_, e') -> stripCasts e' | _ -> e
+
+
+
+(* the name of the C function we call to get ccgr ASTs
+external parse : string -> file = "cil_main"
+*)
+(*
+ Pretty Printing
+ *)
+
+let d_ikind () = function
+ IChar -> text "char"
+ | ISChar -> text "signed char"
+ | IUChar -> text "unsigned char"
+ | IInt -> text "int"
+ | IUInt -> text "unsigned int"
+ | IShort -> text "short"
+ | IUShort -> text "unsigned short"
+ | ILong -> text "long"
+ | IULong -> text "unsigned long"
+ | ILongLong ->
+ if !msvcMode then text "__int64" else text "long long"
+ | IULongLong ->
+ if !msvcMode then text "unsigned __int64"
+ else text "unsigned long long"
+
+let d_fkind () = function
+ FFloat -> text "float"
+ | FDouble -> text "double"
+ | FLongDouble -> text "long double"
+
+let d_storage () = function
+ NoStorage -> nil
+ | Static -> text "static "
+ | Extern -> text "extern "
+ | Register -> text "register "
+
+(* sm: need this value below *)
+let mostNeg32BitInt : int64 = (Int64.of_string "-0x80000000")
+let mostNeg64BitInt : int64 = (Int64.of_string "-0x8000000000000000")
+
+(* constant *)
+let d_const () c =
+ match c with
+ CInt64(_, _, Some s) -> text s (* Always print the text if there is one *)
+ | CInt64(i, ik, None) ->
+ (** We must make sure to capture the type of the constant. For some
+ * constants this is done with a suffix, for others with a cast prefix.*)
+ let suffix : string =
+ match ik with
+ IUInt -> "U"
+ | ILong -> "L"
+ | IULong -> "UL"
+ | ILongLong -> if !msvcMode then "L" else "LL"
+ | IULongLong -> if !msvcMode then "UL" else "ULL"
+ | _ -> ""
+ in
+ let prefix : string =
+ if suffix <> "" then ""
+ else if ik = IInt then ""
+ else "(" ^ (sprint !lineLength (d_ikind () ik)) ^ ")"
+ in
+ (* Watch out here for negative integers that we should be printing as
+ * large positive ones *)
+ if i < Int64.zero
+ && (match ik with
+ IUInt | IULong | IULongLong | IUChar | IUShort -> true | _ -> false) then
+ let high = Int64.shift_right i 32 in
+ if ik <> IULongLong && ik <> ILongLong && high = Int64.of_int (-1) then
+ (* Print only the low order 32 bits *)
+ text (prefix ^ "0x" ^
+ (Int64.format "%x"
+ (Int64.logand i (Int64.shift_right_logical high 32))
+ ^ suffix))
+ else
+ text (prefix ^ "0x" ^ Int64.format "%x" i ^ suffix)
+ else (
+ if (i = mostNeg32BitInt) then
+ (* sm: quirk here: if you print -2147483648 then this is two tokens *)
+ (* in C, and the second one is too large to represent in a signed *)
+ (* int.. so we do what's done in limits.h, and print (-2147483467-1); *)
+ (* in gcc this avoids a warning, but it might avoid a real problem *)
+ (* on another compiler or a 64-bit architecture *)
+ text (prefix ^ "(-0x7FFFFFFF-1)")
+ else if (i = mostNeg64BitInt) then
+ (* The same is true of the largest 64-bit negative. *)
+ text (prefix ^ "(-0x7FFFFFFFFFFFFFFF-1)")
+ else
+ text (prefix ^ (Int64.to_string i ^ suffix))
+ )
+
+ | CStr(s) -> text ("\"" ^ escape_string s ^ "\"")
+ | CWStr(s) ->
+ (* text ("L\"" ^ escape_string s ^ "\"") *)
+ (List.fold_left (fun acc elt ->
+ acc ++
+ if (elt >= Int64.zero &&
+ elt <= (Int64.of_int 255)) then
+ text (escape_char (Char.chr (Int64.to_int elt)))
+ else
+ ( text (Printf.sprintf "\\x%LX\"" elt) ++ break ++
+ (text "\""))
+ ) (text "L\"") s ) ++ text "\""
+ (* we cannot print L"\xabcd" "feedme" as L"\xabcdfeedme" --
+ * the former has 7 wide characters and the later has 3. *)
+
+ | CChr(c) -> text ("'" ^ escape_char c ^ "'")
+ | CReal(_, _, Some s) -> text s
+ | CReal(f, _, None) -> text (string_of_float f)
+ | CEnum(_, s, ei) -> text s
+
+
+(* Parentheses level. An expression "a op b" is printed parenthesized if its
+ * parentheses level is >= that that of its context. Identifiers have the
+ * lowest level and weakly binding operators (e.g. |) have the largest level.
+ * The correctness criterion is that a smaller level MUST correspond to a
+ * stronger precedence!
+ *)
+let derefStarLevel = 20
+let indexLevel = 20
+let arrowLevel = 20
+let addrOfLevel = 30
+let additiveLevel = 60
+let comparativeLevel = 70
+let bitwiseLevel = 75
+let getParenthLevel = function
+ | BinOp((LAnd | LOr), _,_,_) -> 80
+ (* Bit operations. *)
+ | BinOp((BOr|BXor|BAnd),_,_,_) -> bitwiseLevel (* 75 *)
+
+ (* Comparisons *)
+ | BinOp((Eq|Ne|Gt|Lt|Ge|Le),_,_,_) ->
+ comparativeLevel (* 70 *)
+ (* Additive. Shifts can have higher
+ * level than + or - but I want
+ * parentheses around them *)
+ | BinOp((MinusA|MinusPP|MinusPI|PlusA|
+ PlusPI|IndexPI|Shiftlt|Shiftrt),_,_,_)
+ -> additiveLevel (* 60 *)
+
+ (* Multiplicative *)
+ | BinOp((Div|Mod|Mult),_,_,_) -> 40
+
+ (* Unary *)
+ | CastE(_,_) -> 30
+ | AddrOf(_) -> 30
+ | StartOf(_) -> 30
+ | UnOp((Neg|BNot|LNot),_,_) -> 30
+
+ (* Lvals *)
+ | Lval(Mem _ , _) -> 20
+ | Lval(Var _, (Field _|Index _)) -> 20
+ | SizeOf _ | SizeOfE _ | SizeOfStr _ -> 20
+ | AlignOf _ | AlignOfE _ -> 20
+
+ | Lval(Var _, NoOffset) -> 0 (* Plain variables *)
+ | Const _ -> 0 (* Constants *)
+
+
+
+(* Separate out the storage-modifier name attributes *)
+let separateStorageModifiers (al: attribute list) =
+ let isstoragemod (Attr(an, _): attribute) : bool =
+ try
+ match H.find attributeHash an with
+ AttrName issm -> issm
+ | _ -> E.s (E.bug "separateStorageModifier: %s is not a name attribute" an)
+ with Not_found -> false
+ in
+ let stom, rest = List.partition isstoragemod al in
+ if not !msvcMode then
+ stom, rest
+ else
+ (* Put back the declspec. Put it without the leading __ since these will
+ * be added later *)
+ let stom' =
+ List.map (fun (Attr(an, args)) ->
+ Attr("declspec", [ACons(an, args)])) stom in
+ stom', rest
+
+
+let isIntegralType t =
+ match unrollType t with
+ (TInt _ | TEnum _) -> true
+ | _ -> false
+
+let isArithmeticType t =
+ match unrollType t with
+ (TInt _ | TEnum _ | TFloat _) -> true
+ | _ -> false
+
+
+let isPointerType t =
+ match unrollType t with
+ TPtr _ -> true
+ | _ -> false
+
+let isFunctionType t =
+ match unrollType t with
+ TFun _ -> true
+ | _ -> false
+
+(**** Compute the type of an expression ****)
+let rec typeOf (e: exp) : typ =
+ match e with
+ | Const(CInt64 (_, ik, _)) -> TInt(ik, [])
+
+ (* Character constants have type int. ISO/IEC 9899:1999 (E),
+ * section 6.4.4.4 [Character constants], paragraph 10, if you
+ * don't believe me. *)
+ | Const(CChr _) -> intType
+
+ (* The type of a string is a pointer to characters ! The only case when
+ * you would want it to be an array is as an argument to sizeof, but we
+ * have SizeOfStr for that *)
+ | Const(CStr s) -> !stringLiteralType
+
+ | Const(CWStr s) -> TPtr(!wcharType,[])
+
+ | Const(CReal (_, fk, _)) -> TFloat(fk, [])
+
+ | Const(CEnum(_, _, ei)) -> TEnum(ei, [])
+
+ | Lval(lv) -> typeOfLval lv
+ | SizeOf _ | SizeOfE _ | SizeOfStr _ -> !typeOfSizeOf
+ | AlignOf _ | AlignOfE _ -> !typeOfSizeOf
+ | UnOp (_, _, t) -> t
+ | BinOp (_, _, _, t) -> t
+ | CastE (t, _) -> t
+ | AddrOf (lv) -> TPtr(typeOfLval lv, [])
+ | StartOf (lv) -> begin
+ match unrollType (typeOfLval lv) with
+ TArray (t,_, _) -> TPtr(t, [])
+ | _ -> E.s (E.bug "typeOf: StartOf on a non-array")
+ end
+
+and typeOfInit (i: init) : typ =
+ match i with
+ SingleInit e -> typeOf e
+ | CompoundInit (t, _) -> t
+
+and typeOfLval = function
+ Var vi, off -> typeOffset vi.vtype off
+ | Mem addr, off -> begin
+ match unrollType (typeOf addr) with
+ TPtr (t, _) -> typeOffset t off
+ | _ -> E.s (bug "typeOfLval: Mem on a non-pointer")
+ end
+
+and typeOffset basetyp =
+ let blendAttributes baseAttrs =
+ let (_, _, contageous) =
+ partitionAttributes ~default:(AttrName false) baseAttrs in
+ typeAddAttributes contageous
+ in
+ function
+ NoOffset -> basetyp
+ | Index (_, o) -> begin
+ match unrollType basetyp with
+ TArray (t, _, baseAttrs) ->
+ let elementType = typeOffset t o in
+ blendAttributes baseAttrs elementType
+ | t -> E.s (E.bug "typeOffset: Index on a non-array")
+ end
+ | Field (fi, o) ->
+ match unrollType basetyp with
+ TComp (_, baseAttrs) ->
+ let fieldType = typeOffset fi.ftype o in
+ blendAttributes baseAttrs fieldType
+ | _ -> E.s (bug "typeOffset: Field on a non-compound")
+
+
+(**
+ **
+ ** MACHINE DEPENDENT PART
+ **
+ **)
+exception SizeOfError of string * typ
+
+
+(* Get the minimum aligment in bytes for a given type *)
+let rec alignOf_int = function
+ | TInt((IChar|ISChar|IUChar), _) -> 1
+ | TInt((IShort|IUShort), _) -> !theMachine.M.alignof_short
+ | TInt((IInt|IUInt), _) -> !theMachine.M.alignof_int
+ | TInt((ILong|IULong), _) -> !theMachine.M.alignof_long
+ | TInt((ILongLong|IULongLong), _) -> !theMachine.M.alignof_longlong
+ | TEnum _ -> !theMachine.M.alignof_enum
+ | TFloat(FFloat, _) -> !theMachine.M.alignof_float
+ | TFloat(FDouble, _) -> !theMachine.M.alignof_double
+ | TFloat(FLongDouble, _) -> !theMachine.M.alignof_longdouble
+ | TNamed (t, _) -> alignOf_int t.ttype
+ | TArray (t, _, _) -> alignOf_int t
+ | TPtr _ | TBuiltin_va_list _ -> !theMachine.M.alignof_ptr
+
+ (* For composite types get the maximum alignment of any field inside *)
+ | TComp (c, _) ->
+ (* On GCC the zero-width fields do not contribute to the alignment. On
+ * MSVC only those zero-width that _do_ appear after other
+ * bitfields contribute to the alignment. So we drop those that
+ * do not occur after othe bitfields *)
+ let rec dropZeros (afterbitfield: bool) = function
+ | f :: rest when f.fbitfield = Some 0 && not afterbitfield ->
+ dropZeros afterbitfield rest
+ | f :: rest -> f :: dropZeros (f.fbitfield <> None) rest
+ | [] -> []
+ in
+ let fields = dropZeros false c.cfields in
+ List.fold_left
+ (fun sofar f ->
+ (* Bitfields with zero width do not contribute to the alignment in
+ * GCC *)
+ if not !msvcMode && f.fbitfield = Some 0 then sofar else
+ max sofar (alignOf_int f.ftype)) 1 fields
+ (* These are some error cases *)
+ | TFun _ when not !msvcMode -> !theMachine.M.alignof_fun
+
+ | TFun _ as t -> raise (SizeOfError ("function", t))
+ | TVoid _ as t -> raise (SizeOfError ("void", t))
+
+
+let bitsSizeOfInt (ik: ikind): int =
+ match ik with
+ | IChar | ISChar | IUChar -> 8
+ | IInt | IUInt -> 8 * !theMachine.M.sizeof_int
+ | IShort | IUShort -> 8 * !theMachine.M.sizeof_short
+ | ILong | IULong -> 8 * !theMachine.M.sizeof_long
+ | ILongLong | IULongLong -> 8 * !theMachine.M.sizeof_longlong
+
+(* Represents an integer as for a given kind.
+ Returns a flag saying whether the value was changed
+ during truncation (because it was too large to fit in k). *)
+let truncateInteger64 (k: ikind) (i: int64) : int64 * bool =
+ let nrBits = bitsSizeOfInt k in
+ let signed = isSigned k in
+ if nrBits = 64 then
+ i, false
+ else begin
+ let i1 = Int64.shift_left i (64 - nrBits) in
+ let i2 =
+ if signed then Int64.shift_right i1 (64 - nrBits)
+ else Int64.shift_right_logical i1 (64 - nrBits)
+ in
+ let truncated =
+ if i2 = i then false
+ else
+ (* Examine the bits that we chopped off. If they are all zero, then
+ * any difference between i2 and i is due to a simple sign-extension.
+ * e.g. casting the constant 0x80000000 to int makes it
+ * 0xffffffff80000000.
+ * Suppress the truncation warning in this case. *)
+ let chopped = Int64.shift_right_logical i (64 - nrBits)
+ in chopped <> Int64.zero
+ in
+ i2, truncated
+ end
+
+(* Construct an integer constant with possible truncation *)
+let kinteger64 (k: ikind) (i: int64) : exp =
+ let i', truncated = truncateInteger64 k i in
+ if truncated then
+ ignore (warnOpt "Truncating integer %s to %s\n"
+ (Int64.format "0x%x" i) (Int64.format "0x%x" i'));
+ Const (CInt64(i', k, None))
+
+(* Construct an integer of a given kind. *)
+let kinteger (k: ikind) (i: int) = kinteger64 k (Int64.of_int i)
+
+
+type offsetAcc =
+ { oaFirstFree: int; (* The first free bit *)
+ oaLastFieldStart: int; (* Where the previous field started *)
+ oaLastFieldWidth: int; (* The width of the previous field. Might not
+ * be same as FirstFree - FieldStart because
+ * of internal padding *)
+ oaPrevBitPack: (int * ikind * int) option; (* If the previous fields
+ * were packed bitfields,
+ * the bit where packing
+ * has started, the ikind
+ * of the bitfield and the
+ * width of the ikind *)
+ }
+
+
+(* GCC version *)
+(* Does not use the sofar.oaPrevBitPack *)
+let rec offsetOfFieldAcc_GCC (fi: fieldinfo)
+ (sofar: offsetAcc) : offsetAcc =
+ (* field type *)
+ let ftype = unrollType fi.ftype in
+ let ftypeAlign = 8 * alignOf_int ftype in
+ let ftypeBits = bitsSizeOf ftype in
+(*
+ if fi.fcomp.cname = "comp2468" ||
+ fi.fcomp.cname = "comp2469" ||
+ fi.fcomp.cname = "comp2470" ||
+ fi.fcomp.cname = "comp2471" ||
+ fi.fcomp.cname = "comp2472" ||
+ fi.fcomp.cname = "comp2473" ||
+ fi.fcomp.cname = "comp2474" ||
+ fi.fcomp.cname = "comp2475" ||
+ fi.fcomp.cname = "comp2476" ||
+ fi.fcomp.cname = "comp2477" ||
+ fi.fcomp.cname = "comp2478" then
+
+ ignore (E.log "offsetOfFieldAcc_GCC(%s of %s:%a%a,firstFree=%d,pack=%a)\n"
+ fi.fname fi.fcomp.cname
+ d_type ftype
+ insert
+ (match fi.fbitfield with
+ None -> nil
+ | Some wdthis -> dprintf ":%d" wdthis)
+ sofar.oaFirstFree
+ insert
+ (match sofar.oaPrevBitPack with
+ None -> text "None"
+ | Some (packstart, _, wdpack) ->
+ dprintf "Some(packstart=%d,wd=%d)"
+ packstart wdpack));
+*)
+ match ftype, fi.fbitfield with
+ (* A width of 0 means that we must end the current packing. It seems that
+ * GCC pads only up to the alignment boundary for the type of this field.
+ * *)
+ | _, Some 0 ->
+ let firstFree = addTrailing sofar.oaFirstFree ftypeAlign in
+ { oaFirstFree = firstFree;
+ oaLastFieldStart = firstFree;
+ oaLastFieldWidth = 0;
+ oaPrevBitPack = None }
+
+ (* A bitfield cannot span more alignment boundaries of its type than the
+ * type itself *)
+ | _, Some wdthis
+ when (sofar.oaFirstFree + wdthis + ftypeAlign - 1) / ftypeAlign
+ - sofar.oaFirstFree / ftypeAlign > ftypeBits / ftypeAlign ->
+ let start = addTrailing sofar.oaFirstFree ftypeAlign in
+ { oaFirstFree = start + wdthis;
+ oaLastFieldStart = start;
+ oaLastFieldWidth = wdthis;
+ oaPrevBitPack = None }
+
+ (* Try a simple method. Just put the field down *)
+ | _, Some wdthis ->
+ { oaFirstFree = sofar.oaFirstFree + wdthis;
+ oaLastFieldStart = sofar.oaFirstFree;
+ oaLastFieldWidth = wdthis;
+ oaPrevBitPack = None
+ }
+
+ (* Non-bitfield *)
+ | _, None ->
+ (* Align this field *)
+ let newStart = addTrailing sofar.oaFirstFree ftypeAlign in
+ { oaFirstFree = newStart + ftypeBits;
+ oaLastFieldStart = newStart;
+ oaLastFieldWidth = ftypeBits;
+ oaPrevBitPack = None;
+ }
+
+(* MSVC version *)
+and offsetOfFieldAcc_MSVC (fi: fieldinfo)
+ (sofar: offsetAcc) : offsetAcc =
+ (* field type *)
+ let ftype = unrollType fi.ftype in
+ let ftypeAlign = 8 * alignOf_int ftype in
+ let ftypeBits = bitsSizeOf ftype in
+(*
+ ignore (E.log "offsetOfFieldAcc_MSVC(%s of %s:%a%a,firstFree=%d, pack=%a)\n"
+ fi.fname fi.fcomp.cname
+ d_type ftype
+ insert
+ (match fi.fbitfield with
+ None -> nil
+ | Some wdthis -> dprintf ":%d" wdthis)
+ sofar.oaFirstFree
+ insert
+ (match sofar.oaPrevBitPack with
+ None -> text "None"
+ | Some (prevpack, _, wdpack) -> dprintf "Some(prev=%d,wd=%d)"
+ prevpack wdpack));
+*)
+ match ftype, fi.fbitfield, sofar.oaPrevBitPack with
+ (* Ignore zero-width bitfields that come after non-bitfields *)
+ | TInt (ikthis, _), Some 0, None ->
+ let firstFree = sofar.oaFirstFree in
+ { oaFirstFree = firstFree;
+ oaLastFieldStart = firstFree;
+ oaLastFieldWidth = 0;
+ oaPrevBitPack = None }
+
+ (* If we are in a bitpack and we see a bitfield for a type with the
+ * different width than the pack, then we finish the pack and retry *)
+ | _, Some _, Some (packstart, _, wdpack) when wdpack != ftypeBits ->
+ let firstFree =
+ if sofar.oaFirstFree = packstart then packstart else
+ packstart + wdpack
+ in
+ offsetOfFieldAcc_MSVC fi
+ { oaFirstFree = addTrailing firstFree ftypeAlign;
+ oaLastFieldStart = sofar.oaLastFieldStart;
+ oaLastFieldWidth = sofar.oaLastFieldWidth;
+ oaPrevBitPack = None }
+
+ (* A width of 0 means that we must end the current packing. *)
+ | TInt (ikthis, _), Some 0, Some (packstart, _, wdpack) ->
+ let firstFree =
+ if sofar.oaFirstFree = packstart then packstart else
+ packstart + wdpack
+ in
+ let firstFree = addTrailing firstFree ftypeAlign in
+ { oaFirstFree = firstFree;
+ oaLastFieldStart = firstFree;
+ oaLastFieldWidth = 0;
+ oaPrevBitPack = Some (firstFree, ikthis, ftypeBits) }
+
+ (* Check for a bitfield that fits in the current pack after some other
+ * bitfields *)
+ | TInt(ikthis, _), Some wdthis, Some (packstart, ikprev, wdpack)
+ when packstart + wdpack >= sofar.oaFirstFree + wdthis ->
+ { oaFirstFree = sofar.oaFirstFree + wdthis;
+ oaLastFieldStart = sofar.oaFirstFree;
+ oaLastFieldWidth = wdthis;
+ oaPrevBitPack = sofar.oaPrevBitPack
+ }
+
+
+ | _, _, Some (packstart, _, wdpack) -> (* Finish up the bitfield pack and
+ * restart. *)
+ let firstFree =
+ if sofar.oaFirstFree = packstart then packstart else
+ packstart + wdpack
+ in
+ offsetOfFieldAcc_MSVC fi
+ { oaFirstFree = addTrailing firstFree ftypeAlign;
+ oaLastFieldStart = sofar.oaLastFieldStart;
+ oaLastFieldWidth = sofar.oaLastFieldWidth;
+ oaPrevBitPack = None }
+
+ (* No active bitfield pack. But we are seeing a bitfield. *)
+ | TInt(ikthis, _), Some wdthis, None ->
+ let firstFree = addTrailing sofar.oaFirstFree ftypeAlign in
+ { oaFirstFree = firstFree + wdthis;
+ oaLastFieldStart = firstFree;
+ oaLastFieldWidth = wdthis;
+ oaPrevBitPack = Some (firstFree, ikthis, ftypeBits); }
+
+ (* No active bitfield pack. Non-bitfield *)
+ | _, None, None ->
+ (* Align this field *)
+ let firstFree = addTrailing sofar.oaFirstFree ftypeAlign in
+ { oaFirstFree = firstFree + ftypeBits;
+ oaLastFieldStart = firstFree;
+ oaLastFieldWidth = ftypeBits;
+ oaPrevBitPack = None;
+ }
+
+ | _, Some _, None -> E.s (E.bug "offsetAcc")
+
+
+and offsetOfFieldAcc ~(fi: fieldinfo)
+ ~(sofar: offsetAcc) : offsetAcc =
+ if !msvcMode then offsetOfFieldAcc_MSVC fi sofar
+ else offsetOfFieldAcc_GCC fi sofar
+
+(* The size of a type, in bits. If struct or array then trailing padding is
+ * added *)
+and bitsSizeOf t =
+ if not !initCIL_called then
+ E.s (E.error "You did not call Cil.initCIL before using the CIL library");
+ match t with
+ | TInt (ik,_) -> bitsSizeOfInt ik
+ | TFloat(FDouble, _) -> 8 * !theMachine.M.sizeof_double
+ | TFloat(FLongDouble, _) -> 8 * !theMachine.M.sizeof_longdouble
+ | TFloat _ -> 8 * !theMachine.M.sizeof_float
+ | TEnum _ -> 8 * !theMachine.M.sizeof_enum
+ | TPtr _ -> 8 * !theMachine.M.sizeof_ptr
+ | TBuiltin_va_list _ -> 8 * !theMachine.M.sizeof_ptr
+ | TNamed (t, _) -> bitsSizeOf t.ttype
+ | TComp (comp, _) when comp.cfields == [] -> begin
+ (* Empty structs are allowed in msvc mode *)
+ if not comp.cdefined && not !msvcMode then
+ raise (SizeOfError ("abstract type", t)) (*abstract type*)
+ else
+ 0
+ end
+
+ | TComp (comp, _) when comp.cstruct -> (* Struct *)
+ (* Go and get the last offset *)
+ let startAcc =
+ { oaFirstFree = 0;
+ oaLastFieldStart = 0;
+ oaLastFieldWidth = 0;
+ oaPrevBitPack = None;
+ } in
+ let lastoff =
+ List.fold_left (fun acc fi -> offsetOfFieldAcc ~fi ~sofar:acc)
+ startAcc comp.cfields
+ in
+ if !msvcMode && lastoff.oaFirstFree = 0 && comp.cfields <> [] then
+ (* On MSVC if we have just a zero-width bitfields then the length
+ * is 32 and is not padded *)
+ 32
+ else
+ addTrailing lastoff.oaFirstFree (8 * alignOf_int t)
+
+ | TComp (comp, _) -> (* when not comp.cstruct *)
+ (* Get the maximum of all fields *)
+ let startAcc =
+ { oaFirstFree = 0;
+ oaLastFieldStart = 0;
+ oaLastFieldWidth = 0;
+ oaPrevBitPack = None;
+ } in
+ let max =
+ List.fold_left (fun acc fi ->
+ let lastoff = offsetOfFieldAcc ~fi ~sofar:startAcc in
+ if lastoff.oaFirstFree > acc then
+ lastoff.oaFirstFree else acc) 0 comp.cfields in
+ (* Add trailing by simulating adding an extra field *)
+ addTrailing max (8 * alignOf_int t)
+
+ | TArray(t, Some len, _) -> begin
+ match constFold true len with
+ Const(CInt64(l,_,_)) ->
+ addTrailing ((bitsSizeOf t) * (Int64.to_int l)) (8 * alignOf_int t)
+ | _ -> raise (SizeOfError ("array non-constant length", t))
+ end
+
+
+ | TVoid _ -> 8 * !theMachine.M.sizeof_void
+ | TFun _ when not !msvcMode -> (* On GCC the size of a function is defined *)
+ 8 * !theMachine.M.sizeof_fun
+
+ | TArray (_, None, _) -> (* it seems that on GCC the size of such an
+ * array is 0 *)
+ 0
+
+ | TFun _ -> raise (SizeOfError ("function", t))
+
+
+and addTrailing nrbits roundto =
+ (nrbits + roundto - 1) land (lnot (roundto - 1))
+
+and sizeOf t =
+ try
+ integer ((bitsSizeOf t) lsr 3)
+ with SizeOfError _ -> SizeOf(t)
+
+
+and bitsOffset (baset: typ) (off: offset) : int * int =
+ let rec loopOff (baset: typ) (width: int) (start: int) = function
+ NoOffset -> start, width
+ | Index(e, off) -> begin
+ let ei =
+ match isInteger e with
+ Some i64 -> Int64.to_int i64
+ | None -> raise (SizeOfError ("index not constant", baset))
+ in
+ let bt =
+ match unrollType baset with
+ TArray(bt, _, _) -> bt
+ | _ -> E.s (E.bug "bitsOffset: Index on a non-array")
+ in
+ let bitsbt = bitsSizeOf bt in
+ loopOff bt bitsbt (start + ei * bitsbt) off
+ end
+ | Field(f, off) when not f.fcomp.cstruct ->
+ (* All union fields start at offset 0 *)
+ loopOff f.ftype (bitsSizeOf f.ftype) start off
+
+ | Field(f, off) ->
+ (* Construct a list of fields preceeding and including this one *)
+ let prevflds =
+ let rec loop = function
+ [] -> E.s (E.bug "bitsOffset: Cannot find field %s in %s\n"
+ f.fname f.fcomp.cname)
+ | fi' :: _ when fi' == f -> [fi']
+ | fi' :: rest -> fi' :: loop rest
+ in
+ loop f.fcomp.cfields
+ in
+ let lastoff =
+ List.fold_left (fun acc fi' -> offsetOfFieldAcc ~fi:fi' ~sofar:acc)
+ { oaFirstFree = 0; (* Start at 0 because each struct is done
+ * separately *)
+ oaLastFieldStart = 0;
+ oaLastFieldWidth = 0;
+ oaPrevBitPack = None } prevflds
+ in
+ (* ignore (E.log "Field %s of %s: start=%d, lastFieldStart=%d\n"
+ f.fname f.fcomp.cname start lastoff.oaLastFieldStart); *)
+ loopOff f.ftype lastoff.oaLastFieldWidth
+ (start + lastoff.oaLastFieldStart) off
+ in
+ loopOff baset (bitsSizeOf baset) 0 off
+
+
+
+
+(*** Constant folding. If machdep is true then fold even sizeof operations ***)
+and constFold (machdep: bool) (e: exp) : exp =
+ match e with
+ BinOp(bop, e1, e2, tres) -> constFoldBinOp machdep bop e1 e2 tres
+ | UnOp(unop, e1, tres) -> begin
+ try
+ let tk =
+ match unrollType tres with
+ TInt(ik, _) -> ik
+ | TEnum _ -> IInt
+ | _ -> raise Not_found (* probably a float *)
+ in
+ match constFold machdep e1 with
+ Const(CInt64(i,ik,_)) -> begin
+ match unop with
+ Neg -> kinteger64 tk (Int64.neg i)
+ | BNot -> kinteger64 tk (Int64.lognot i)
+ | LNot -> if i = Int64.zero then one else zero
+ end
+ | e1c -> UnOp(unop, e1c, tres)
+ with Not_found -> e
+ end
+ (* Characters are integers *)
+ | Const(CChr c) -> Const(charConstToInt c)
+ | Const(CEnum (v, _, _)) -> constFold machdep v
+ | SizeOf t when machdep -> begin
+ try
+ let bs = bitsSizeOf t in
+ kinteger !kindOfSizeOf (bs / 8)
+ with SizeOfError _ -> e
+ end
+ | SizeOfE e when machdep -> constFold machdep (SizeOf (typeOf e))
+ | SizeOfStr s when machdep -> kinteger !kindOfSizeOf (1 + String.length s)
+ | AlignOf t when machdep -> kinteger !kindOfSizeOf (alignOf_int t)
+ | AlignOfE e when machdep -> begin
+ (* The alignmetn of an expression is not always the alignment of its
+ * type. I know that for strings this is not true *)
+ match e with
+ Const (CStr _) when not !msvcMode ->
+ kinteger !kindOfSizeOf !theMachine.M.alignof_str
+ (* For an array, it is the alignment of the array ! *)
+ | _ -> constFold machdep (AlignOf (typeOf e))
+ end
+
+ | CastE(it,
+ AddrOf (Mem (CastE(TPtr(bt, _), z)), off))
+ when machdep && isZero z -> begin
+ try
+ let start, width = bitsOffset bt off in
+ if start mod 8 <> 0 then
+ E.s (error "Using offset of bitfield\n");
+ constFold machdep (CastE(it, (integer (start / 8))))
+ with SizeOfError _ -> e
+ end
+
+
+ | CastE (t, e) -> begin
+ match constFold machdep e, unrollType t with
+ (* Might truncate silently *)
+ Const(CInt64(i,k,_)), TInt(nk,_) ->
+ let i', _ = truncateInteger64 nk i in
+ Const(CInt64(i', nk, None))
+ | e', _ -> CastE (t, e')
+ end
+
+ | _ -> e
+
+and constFoldBinOp (machdep: bool) bop e1 e2 tres =
+ let e1' = constFold machdep e1 in
+ let e2' = constFold machdep e2 in
+ if isIntegralType tres then begin
+ let newe =
+ let rec mkInt = function
+ Const(CChr c) -> Const(charConstToInt c)
+ | Const(CEnum (v, s, ei)) -> mkInt v
+ | CastE(TInt (ik, ta), e) -> begin
+ match mkInt e with
+ Const(CInt64(i, _, _)) ->
+ let i', _ = truncateInteger64 ik i in
+ Const(CInt64(i', ik, None))
+
+ | e' -> CastE(TInt(ik, ta), e')
+ end
+ | e -> e
+ in
+ let tk =
+ match unrollType tres with
+ TInt(ik, _) -> ik
+ | TEnum _ -> IInt
+ | _ -> E.s (bug "constFoldBinOp")
+ in
+ (* See if the result is unsigned *)
+ let isunsigned typ = not (isSigned typ) in
+ let ge (unsigned: bool) (i1: int64) (i2: int64) : bool =
+ if unsigned then
+ let l1 = Int64.shift_right_logical i1 1 in
+ let l2 = Int64.shift_right_logical i2 1 in (* Both positive now *)
+ (l1 > l2) || (l1 = l2 &&
+ Int64.logand i1 Int64.one >= Int64.logand i2 Int64.one)
+ else i1 >= i2
+ in
+ let shiftInBounds i2 =
+ (* We only try to fold shifts if the second arg is positive and
+ less than 64. Otherwise, the semantics are processor-dependent,
+ so let the compiler sort it out. *)
+ i2 >= Int64.zero && i2 < (Int64.of_int 64)
+ in
+ (* Assume that the necessary promotions have been done *)
+ match bop, mkInt e1', mkInt e2' with
+ | PlusA, Const(CInt64(z,_,_)), e2'' when z = Int64.zero -> e2''
+ | PlusA, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
+ | PlusPI, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
+ | IndexPI, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
+ | MinusPI, e1'', Const(CInt64(z,_,_)) when z = Int64.zero -> e1''
+ | PlusA, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ kinteger64 tk (Int64.add i1 i2)
+ | MinusA, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ kinteger64 tk (Int64.sub i1 i2)
+ | Mult, Const(CInt64(i1,ik1,_)), Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ kinteger64 tk (Int64.mul i1 i2)
+ | Mult, Const(CInt64(0L,_,_)), _ -> zero
+ | Mult, Const(CInt64(1L,_,_)), e2'' -> e2''
+ | Mult, _, Const(CInt64(0L,_,_)) -> zero
+ | Mult, e1'', Const(CInt64(1L,_,_)) -> e1''
+ | Div, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 -> begin
+ try kinteger64 tk (Int64.div i1 i2)
+ with Division_by_zero -> BinOp(bop, e1', e2', tres)
+ end
+ | Div, e1'', Const(CInt64(1L,_,_)) -> e1''
+
+ | Mod, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 -> begin
+ try kinteger64 tk (Int64.rem i1 i2)
+ with Division_by_zero -> BinOp(bop, e1', e2', tres)
+ end
+ | BAnd, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ kinteger64 tk (Int64.logand i1 i2)
+ | BAnd, Const(CInt64(0L,_,_)), _ -> zero
+ | BAnd, _, Const(CInt64(0L,_,_)) -> zero
+ | BOr, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ kinteger64 tk (Int64.logor i1 i2)
+ | BOr, _, _ when isZero e1' -> e2'
+ | BOr, _, _ when isZero e2' -> e1'
+ | BXor, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ kinteger64 tk (Int64.logxor i1 i2)
+
+ | Shiftlt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,_,_)) when shiftInBounds i2 ->
+ kinteger64 tk (Int64.shift_left i1 (Int64.to_int i2))
+ | Shiftlt, Const(CInt64(0L,_,_)), _ -> zero
+ | Shiftlt, e1'', Const(CInt64(0L,_,_)) -> e1''
+
+ | Shiftrt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,_,_)) when shiftInBounds i2 ->
+ if isunsigned ik1 then
+ kinteger64 tk (Int64.shift_right_logical i1 (Int64.to_int i2))
+ else
+ kinteger64 tk (Int64.shift_right i1 (Int64.to_int i2))
+ | Shiftrt, Const(CInt64(0L,_,_)), _ -> zero
+ | Shiftrt, e1'', Const(CInt64(0L,_,_)) -> e1''
+
+ | Eq, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ integer (if i1 = i2 then 1 else 0)
+ | Ne, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ integer (if i1 <> i2 then 1 else 0)
+ | Le, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ integer (if ge (isunsigned ik1) i2 i1 then 1 else 0)
+
+ | Ge, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ integer (if ge (isunsigned ik1) i1 i2 then 1 else 0)
+
+ | Lt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ integer (if i1 <> i2 && ge (isunsigned ik1) i2 i1 then 1 else 0)
+
+ | Gt, Const(CInt64(i1,ik1,_)),Const(CInt64(i2,ik2,_)) when ik1 = ik2 ->
+ integer (if i1 <> i2 && ge (isunsigned ik1) i1 i2 then 1 else 0)
+ | LAnd, _, _ when isZero e1' || isZero e2' -> zero
+ | LOr, _, _ when isZero e1' -> e2'
+ | LOr, _, _ when isZero e2' -> e1'
+ | _ -> BinOp(bop, e1', e2', tres)
+ in
+ if debugConstFold then
+ ignore (E.log "Folded %a to %a\n"
+ (!pd_exp) (BinOp(bop, e1', e2', tres)) (!pd_exp) newe);
+ newe
+ end else
+ BinOp(bop, e1', e2', tres)
+
+
+
+let parseInt (str: string) : exp =
+ let hasSuffix str =
+ let l = String.length str in
+ fun s ->
+ let ls = String.length s in
+ l >= ls && s = String.uppercase (String.sub str (l - ls) ls)
+ in
+ let l = String.length str in
+ (* See if it is octal or hex *)
+ let octalhex = (l >= 1 && String.get str 0 = '0') in
+ (* The length of the suffix and a list of possible kinds. See ISO
+ * 6.4.4.1 *)
+ let hasSuffix = hasSuffix str in
+ let suffixlen, kinds =
+ if hasSuffix "ULL" || hasSuffix "LLU" then
+ 3, [IULongLong]
+ else if hasSuffix "LL" then
+ 2, if octalhex then [ILongLong; IULongLong] else [ILongLong]
+ else if hasSuffix "UL" || hasSuffix "LU" then
+ 2, [IULong; IULongLong]
+ else if hasSuffix "L" then
+ 1, if octalhex then [ILong; IULong; ILongLong; IULongLong]
+ else [ILong; ILongLong]
+ else if hasSuffix "U" then
+ 1, [IUInt; IULong; IULongLong]
+ else if (!msvcMode && hasSuffix "UI64") then
+ 4, [IULongLong]
+ else if (!msvcMode && hasSuffix "I64") then
+ 3, [ILongLong]
+ else
+ 0, if octalhex || true (* !!! This is against the ISO but it
+ * is what GCC and MSVC do !!! *)
+ then [IInt; IUInt; ILong; IULong; ILongLong; IULongLong]
+ else [IInt; ILong; IUInt; ILongLong]
+ in
+ (* Convert to integer. To prevent overflow we do the arithmetic
+ * on Int64 and we take care of overflow. We work only with
+ * positive integers since the lexer takes care of the sign *)
+ let rec toInt (base: int64) (acc: int64) (idx: int) : int64 =
+ let doAcc (what: int) =
+ let acc' =
+ Int64.add (Int64.mul base acc) (Int64.of_int what) in
+ if acc < Int64.zero || (* We clearly overflow since base >= 2
+ * *)
+ (acc' > Int64.zero && acc' < acc) then
+ E.s (unimp "Cannot represent on 64 bits the integer %s\n"
+ str)
+ else
+ toInt base acc' (idx + 1)
+ in
+ if idx >= l - suffixlen then begin
+ acc
+ end else
+ let ch = String.get str idx in
+ if ch >= '0' && ch <= '9' then
+ doAcc (Char.code ch - Char.code '0')
+ else if ch >= 'a' && ch <= 'f' then
+ doAcc (10 + Char.code ch - Char.code 'a')
+ else if ch >= 'A' && ch <= 'F' then
+ doAcc (10 + Char.code ch - Char.code 'A')
+ else
+ E.s (bug "Invalid integer constant: %s (char %c at idx=%d)"
+ str ch idx)
+ in
+ try
+ let i =
+ if octalhex then
+ if l >= 2 &&
+ (let c = String.get str 1 in c = 'x' || c = 'X') then
+ toInt (Int64.of_int 16) Int64.zero 2
+ else
+ toInt (Int64.of_int 8) Int64.zero 1
+ else
+ toInt (Int64.of_int 10) Int64.zero 0
+ in
+ (* Construct an integer of the first kinds that fits. i must be
+ * POSITIVE *)
+ let res =
+ let rec loop = function
+ | ((IInt | ILong) as k) :: _
+ when i < Int64.shift_left (Int64.of_int 1) 31 ->
+ kinteger64 k i
+ | ((IUInt | IULong) as k) :: _
+ when i < Int64.shift_left (Int64.of_int 1) 32
+ -> kinteger64 k i
+ | (ILongLong as k) :: _
+ when i <= Int64.sub (Int64.shift_left
+ (Int64.of_int 1) 63)
+ (Int64.of_int 1)
+ ->
+ kinteger64 k i
+ | (IULongLong as k) :: _ -> kinteger64 k i
+ | _ :: rest -> loop rest
+ | [] -> E.s (E.unimp "Cannot represent the integer %s\n"
+ (Int64.to_string i))
+ in
+ loop kinds
+ in
+ res
+ with e -> begin
+ ignore (E.log "int_of_string %s (%s)\n" str
+ (Printexc.to_string e));
+ zero
+ end
+
+
+
+let d_unop () u =
+ match u with
+ Neg -> text "-"
+ | BNot -> text "~"
+ | LNot -> text "!"
+
+let d_binop () b =
+ match b with
+ PlusA | PlusPI | IndexPI -> text "+"
+ | MinusA | MinusPP | MinusPI -> text "-"
+ | Mult -> text "*"
+ | Div -> text "/"
+ | Mod -> text "%"
+ | Shiftlt -> text "<<"
+ | Shiftrt -> text ">>"
+ | Lt -> text "<"
+ | Gt -> text ">"
+ | Le -> text "<="
+ | Ge -> text ">="
+ | Eq -> text "=="
+ | Ne -> text "!="
+ | BAnd -> text "&"
+ | BXor -> text "^"
+ | BOr -> text "|"
+ | LAnd -> text "&&"
+ | LOr -> text "||"
+
+let invalidStmt = mkStmt (Instr [])
+
+(** Construct a hash with the builtins *)
+let gccBuiltins : (string, typ * typ list * bool) H.t =
+ let h = H.create 17 in
+ (* See if we have builtin_va_list *)
+ let hasbva = M.gccHas__builtin_va_list in
+ let ulongLongType = TInt(IULongLong, []) in
+ let floatType = TFloat(FFloat, []) in
+ let longDoubleType = TFloat (FLongDouble, []) in
+ let voidConstPtrType = TPtr(TVoid [Attr ("const", [])], []) in
+ let sizeType = uintType in
+
+ H.add h "__builtin___fprintf_chk" (intType, [ voidPtrType; intType; charConstPtrType ], true) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *);
+ H.add h "__builtin___memcpy_chk" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false);
+ H.add h "__builtin___memmove_chk" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false);
+ H.add h "__builtin___mempcpy_chk" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType; sizeType ], false);
+ H.add h "__builtin___memset_chk" (voidPtrType, [ voidPtrType; intType; sizeType; sizeType ], false);
+ H.add h "__builtin___printf_chk" (intType, [ intType; charConstPtrType ], true);
+ H.add h "__builtin___snprintf_chk" (intType, [ charPtrType; sizeType; intType; sizeType; charConstPtrType ], true);
+ H.add h "__builtin___sprintf_chk" (intType, [ charPtrType; intType; sizeType; charConstPtrType ], true);
+ H.add h "__builtin___stpcpy_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
+ H.add h "__builtin___strcat_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
+ H.add h "__builtin___strcpy_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
+ H.add h "__builtin___strncat_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType; sizeType ], false);
+ H.add h "__builtin___strncpy_chk" (charPtrType, [ charPtrType; charConstPtrType; sizeType; sizeType ], false);
+ H.add h "__builtin___vfprintf_chk" (intType, [ voidPtrType; intType; charConstPtrType; TBuiltin_va_list [] ], false) (* first argument is really FILE*, not void*, but we don't want to build in the definition for FILE *);
+ H.add h "__builtin___vprintf_chk" (intType, [ intType; charConstPtrType; TBuiltin_va_list [] ], false);
+ H.add h "__builtin___vsnprintf_chk" (intType, [ charPtrType; sizeType; intType; sizeType; charConstPtrType; TBuiltin_va_list [] ], false);
+ H.add h "__builtin___vsprintf_chk" (intType, [ charPtrType; intType; sizeType; charConstPtrType; TBuiltin_va_list [] ], false);
+
+ H.add h "__builtin_acos" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_acosf" (floatType, [ floatType ], false);
+ H.add h "__builtin_acosl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_alloca" (voidPtrType, [ uintType ], false);
+
+ H.add h "__builtin_asin" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_asinf" (floatType, [ floatType ], false);
+ H.add h "__builtin_asinl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_atan" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_atanf" (floatType, [ floatType ], false);
+ H.add h "__builtin_atanl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_atan2" (doubleType, [ doubleType; doubleType ], false);
+ H.add h "__builtin_atan2f" (floatType, [ floatType; floatType ], false);
+ H.add h "__builtin_atan2l" (longDoubleType, [ longDoubleType;
+ longDoubleType ], false);
+
+ H.add h "__builtin_ceil" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_ceilf" (floatType, [ floatType ], false);
+ H.add h "__builtin_ceill" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_cos" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_cosf" (floatType, [ floatType ], false);
+ H.add h "__builtin_cosl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_cosh" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_coshf" (floatType, [ floatType ], false);
+ H.add h "__builtin_coshl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_clz" (intType, [ uintType ], false);
+ H.add h "__builtin_clzl" (intType, [ ulongType ], false);
+ H.add h "__builtin_clzll" (intType, [ ulongLongType ], false);
+ H.add h "__builtin_constant_p" (intType, [ intType ], false);
+ H.add h "__builtin_ctz" (intType, [ uintType ], false);
+ H.add h "__builtin_ctzl" (intType, [ ulongType ], false);
+ H.add h "__builtin_ctzll" (intType, [ ulongLongType ], false);
+
+ H.add h "__builtin_exp" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_expf" (floatType, [ floatType ], false);
+ H.add h "__builtin_expl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_expect" (longType, [ longType; longType ], false);
+
+ H.add h "__builtin_fabs" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_fabsf" (floatType, [ floatType ], false);
+ H.add h "__builtin_fabsl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_ffs" (intType, [ uintType ], false);
+ H.add h "__builtin_ffsl" (intType, [ ulongType ], false);
+ H.add h "__builtin_ffsll" (intType, [ ulongLongType ], false);
+ H.add h "__builtin_frame_address" (voidPtrType, [ uintType ], false);
+
+ H.add h "__builtin_floor" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_floorf" (floatType, [ floatType ], false);
+ H.add h "__builtin_floorl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_huge_val" (doubleType, [], false);
+ H.add h "__builtin_huge_valf" (floatType, [], false);
+ H.add h "__builtin_huge_vall" (longDoubleType, [], false);
+ H.add h "__builtin_inf" (doubleType, [], false);
+ H.add h "__builtin_inff" (floatType, [], false);
+ H.add h "__builtin_infl" (longDoubleType, [], false);
+ H.add h "__builtin_memcpy" (voidPtrType, [ voidPtrType; voidConstPtrType; uintType ], false);
+ H.add h "__builtin_mempcpy" (voidPtrType, [ voidPtrType; voidConstPtrType; sizeType ], false);
+
+ H.add h "__builtin_fmod" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_fmodf" (floatType, [ floatType ], false);
+ H.add h "__builtin_fmodl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_frexp" (doubleType, [ doubleType; intPtrType ], false);
+ H.add h "__builtin_frexpf" (floatType, [ floatType; intPtrType ], false);
+ H.add h "__builtin_frexpl" (longDoubleType, [ longDoubleType;
+ intPtrType ], false);
+
+ H.add h "__builtin_ldexp" (doubleType, [ doubleType; intType ], false);
+ H.add h "__builtin_ldexpf" (floatType, [ floatType; intType ], false);
+ H.add h "__builtin_ldexpl" (longDoubleType, [ longDoubleType;
+ intType ], false);
+
+ H.add h "__builtin_log" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_logf" (floatType, [ floatType ], false);
+ H.add h "__builtin_logl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_log10" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_log10f" (floatType, [ floatType ], false);
+ H.add h "__builtin_log10l" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_modff" (floatType, [ floatType;
+ TPtr(floatType,[]) ], false);
+ H.add h "__builtin_modfl" (longDoubleType, [ longDoubleType;
+ TPtr(longDoubleType, []) ],
+ false);
+
+ H.add h "__builtin_nan" (doubleType, [ charConstPtrType ], false);
+ H.add h "__builtin_nanf" (floatType, [ charConstPtrType ], false);
+ H.add h "__builtin_nanl" (longDoubleType, [ charConstPtrType ], false);
+ H.add h "__builtin_nans" (doubleType, [ charConstPtrType ], false);
+ H.add h "__builtin_nansf" (floatType, [ charConstPtrType ], false);
+ H.add h "__builtin_nansl" (longDoubleType, [ charConstPtrType ], false);
+ H.add h "__builtin_next_arg" ((if hasbva then TBuiltin_va_list [] else voidPtrType), [], false) (* When we parse builtin_next_arg we drop the second argument *);
+ H.add h "__builtin_object_size" (sizeType, [ voidPtrType; intType ], false);
+
+ H.add h "__builtin_parity" (intType, [ uintType ], false);
+ H.add h "__builtin_parityl" (intType, [ ulongType ], false);
+ H.add h "__builtin_parityll" (intType, [ ulongLongType ], false);
+
+ H.add h "__builtin_popcount" (intType, [ uintType ], false);
+ H.add h "__builtin_popcountl" (intType, [ ulongType ], false);
+ H.add h "__builtin_popcountll" (intType, [ ulongLongType ], false);
+
+ H.add h "__builtin_powi" (doubleType, [ doubleType; intType ], false);
+ H.add h "__builtin_powif" (floatType, [ floatType; intType ], false);
+ H.add h "__builtin_powil" (longDoubleType, [ longDoubleType; intType ], false);
+ H.add h "__builtin_prefetch" (voidType, [ voidConstPtrType ], true);
+ H.add h "__builtin_return" (voidType, [ voidConstPtrType ], false);
+ H.add h "__builtin_return_address" (voidPtrType, [ uintType ], false);
+
+ H.add h "__builtin_sin" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_sinf" (floatType, [ floatType ], false);
+ H.add h "__builtin_sinl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_sinh" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_sinhf" (floatType, [ floatType ], false);
+ H.add h "__builtin_sinhl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_sqrt" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_sqrtf" (floatType, [ floatType ], false);
+ H.add h "__builtin_sqrtl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_stpcpy" (charPtrType, [ charPtrType; charConstPtrType ], false);
+ H.add h "__builtin_strchr" (charPtrType, [ charPtrType; charType ], false);
+ H.add h "__builtin_strcmp" (intType, [ charConstPtrType; charConstPtrType ], false);
+ H.add h "__builtin_strcpy" (charPtrType, [ charPtrType; charConstPtrType ], false);
+ H.add h "__builtin_strcspn" (uintType, [ charConstPtrType; charConstPtrType ], false);
+ H.add h "__builtin_strncat" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
+ H.add h "__builtin_strncmp" (intType, [ charConstPtrType; charConstPtrType; sizeType ], false);
+ H.add h "__builtin_strncpy" (charPtrType, [ charPtrType; charConstPtrType; sizeType ], false);
+ H.add h "__builtin_strspn" (intType, [ charConstPtrType; charConstPtrType ], false);
+ H.add h "__builtin_strpbrk" (charPtrType, [ charConstPtrType; charConstPtrType ], false);
+ (* When we parse builtin_types_compatible_p, we change its interface *)
+ H.add h "__builtin_types_compatible_p"
+ (intType, [ uintType; (* Sizeof the type *)
+ uintType (* Sizeof the type *) ],
+ false);
+ H.add h "__builtin_tan" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_tanf" (floatType, [ floatType ], false);
+ H.add h "__builtin_tanl" (longDoubleType, [ longDoubleType ], false);
+
+ H.add h "__builtin_tanh" (doubleType, [ doubleType ], false);
+ H.add h "__builtin_tanhf" (floatType, [ floatType ], false);
+ H.add h "__builtin_tanhl" (longDoubleType, [ longDoubleType ], false);
+
+
+ if hasbva then begin
+ H.add h "__builtin_va_end" (voidType, [ TBuiltin_va_list [] ], false);
+ H.add h "__builtin_varargs_start"
+ (voidType, [ TBuiltin_va_list [] ], false);
+ H.add h "__builtin_va_start" (voidType, [ TBuiltin_va_list [] ], false);
+ (* When we parse builtin_stdarg_start, we drop the second argument *)
+ H.add h "__builtin_stdarg_start" (voidType, [ TBuiltin_va_list []; ],
+ false);
+ (* When we parse builtin_va_arg we change its interface *)
+ H.add h "__builtin_va_arg" (voidType, [ TBuiltin_va_list [];
+ uintType; (* Sizeof the type *)
+ voidPtrType; (* Ptr to res *) ],
+ false);
+ H.add h "__builtin_va_copy" (voidType, [ TBuiltin_va_list [];
+ TBuiltin_va_list [] ],
+ false);
+ end;
+ h
+
+(** Construct a hash with the builtins *)
+let msvcBuiltins : (string, typ * typ list * bool) H.t =
+ (* These are empty for now but can be added to depending on the application*)
+ let h = H.create 17 in
+ (** Take a number of wide string literals *)
+ H.add h "__annotation" (voidType, [ ], true);
+ h
+
+
+
+let pTypeSig : (typ -> typsig) ref =
+ ref (fun _ -> E.s (E.bug "pTypeSig not initialized"))
+
+
+(** A printer interface for CIL trees. Create instantiations of
+ * this type by specializing the class {!Cil.defaultCilPrinter}. *)
+class type cilPrinter = object
+ method pVDecl: unit -> varinfo -> doc
+ (** Invoked for each variable declaration. Note that variable
+ * declarations are all the [GVar], [GVarDecl], [GFun], all the [varinfo]
+ * in formals of function types, and the formals and locals for function
+ * definitions. *)
+
+ method pVar: varinfo -> doc
+ (** Invoked on each variable use. *)
+
+ method pLval: unit -> lval -> doc
+ (** Invoked on each lvalue occurence *)
+
+ method pOffset: doc -> offset -> doc
+ (** Invoked on each offset occurence. The second argument is the base. *)
+
+ method pInstr: unit -> instr -> doc
+ (** Invoked on each instruction occurrence. *)
+
+ method pStmt: unit -> stmt -> doc
+ (** Control-flow statement. This is used by
+ * {!Cil.printGlobal} and by {!Cil.dumpGlobal}. *)
+
+ method dStmt: out_channel -> int -> stmt -> unit
+ (** Dump a control-flow statement to a file with a given indentation. This is used by
+ * {!Cil.dumpGlobal}. *)
+
+ method dBlock: out_channel -> int -> block -> unit
+ (** Dump a control-flow block to a file with a given indentation. This is
+ * used by {!Cil.dumpGlobal}. *)
+
+ method pBlock: unit -> block -> Pretty.doc
+ (** Print a block. *)
+
+ method pGlobal: unit -> global -> doc
+ (** Global (vars, types, etc.). This can be slow and is used only by
+ * {!Cil.printGlobal} but by {!Cil.dumpGlobal} for everything else except
+ * [GVar] and [GFun]. *)
+
+ method dGlobal: out_channel -> global -> unit
+ (** Dump a global to a file. This is used by {!Cil.dumpGlobal}. *)
+
+ method pFieldDecl: unit -> fieldinfo -> doc
+ (** A field declaration *)
+
+ method pType: doc option -> unit -> typ -> doc
+ (* Use of some type in some declaration. The first argument is used to print
+ * the declared element, or is None if we are just printing a type with no
+ * name being decalred. Note that for structure/union and enumeration types
+ * the definition of the composite type is not visited. Use [vglob] to
+ * visit it. *)
+
+ method pAttr: attribute -> doc * bool
+ (** Attribute. Also return an indication whether this attribute must be
+ * printed inside the __attribute__ list or not. *)
+
+ method pAttrParam: unit -> attrparam -> doc
+ (** Attribute paramter *)
+
+ method pAttrs: unit -> attributes -> doc
+ (** Attribute lists *)
+
+ method pLabel: unit -> label -> doc
+ (** Label *)
+
+ method pLineDirective: ?forcefile:bool -> location -> Pretty.doc
+ (** Print a line-number. This is assumed to come always on an empty line.
+ * If the forcefile argument is present and is true then the file name
+ * will be printed always. Otherwise the file name is printed only if it
+ * is different from the last time time this function is called. The last
+ * file name is stored in a private field inside the cilPrinter object. *)
+
+ method pStmtKind : stmt -> unit -> stmtkind -> Pretty.doc
+ (** Print a statement kind. The code to be printed is given in the
+ * {!Cil.stmtkind} argument. The initial {!Cil.stmt} argument
+ * records the statement which follows the one being printed;
+ * {!Cil.defaultCilPrinterClass} uses this information to prettify
+ * statement printing in certain special cases. *)
+
+ method pExp: unit -> exp -> doc
+ (** Print expressions *)
+
+ method pInit: unit -> init -> doc
+ (** Print initializers. This can be slow and is used by
+ * {!Cil.printGlobal} but not by {!Cil.dumpGlobal}. *)
+
+ method dInit: out_channel -> int -> init -> unit
+ (** Dump a global to a file with a given indentation. This is used by
+ * {!Cil.dumpGlobal}. *)
+end
+
+
+class defaultCilPrinterClass : cilPrinter = object (self)
+ val mutable currentFormals : varinfo list = []
+ method private getLastNamedArgument (s: string) : exp =
+ match List.rev currentFormals with
+ f :: _ -> Lval (var f)
+ | [] ->
+ E.s (warn "Cannot find the last named argument when priting call to %s\n" s)
+
+ (*** VARIABLES ***)
+ (* variable use *)
+ method pVar (v:varinfo) = text v.vname
+
+ (* variable declaration *)
+ method pVDecl () (v:varinfo) =
+ let stom, rest = separateStorageModifiers v.vattr in
+ (* First the storage modifiers *)
+ text (if v.vinline then "__inline " else "")
+ ++ d_storage () v.vstorage
+ ++ (self#pAttrs () stom)
+ ++ (self#pType (Some (text v.vname)) () v.vtype)
+ ++ text " "
+ ++ self#pAttrs () rest
+
+ (*** L-VALUES ***)
+ method pLval () (lv:lval) = (* lval (base is 1st field) *)
+ match lv with
+ Var vi, o -> self#pOffset (self#pVar vi) o
+ | Mem e, Field(fi, o) ->
+ self#pOffset
+ ((self#pExpPrec arrowLevel () e) ++ text ("->" ^ fi.fname)) o
+ | Mem e, o ->
+ self#pOffset
+ (text "(*" ++ self#pExpPrec derefStarLevel () e ++ text ")") o
+
+ (** Offsets **)
+ method pOffset (base: doc) = function
+ | NoOffset -> base
+ | Field (fi, o) ->
+ self#pOffset (base ++ text "." ++ text fi.fname) o
+ | Index (e, o) ->
+ self#pOffset (base ++ text "[" ++ self#pExp () e ++ text "]") o
+
+ method private pLvalPrec (contextprec: int) () lv =
+ if getParenthLevel (Lval(lv)) >= contextprec then
+ text "(" ++ self#pLval () lv ++ text ")"
+ else
+ self#pLval () lv
+
+ (*** EXPRESSIONS ***)
+ method pExp () (e: exp) : doc =
+ let level = getParenthLevel e in
+ match e with
+ Const(c) -> d_const () c
+ | Lval(l) -> self#pLval () l
+ | UnOp(u,e1,_) ->
+ (d_unop () u) ++ chr ' ' ++ (self#pExpPrec level () e1)
+
+ | BinOp(b,e1,e2,_) ->
+ align
+ ++ (self#pExpPrec level () e1)
+ ++ chr ' '
+ ++ (d_binop () b)
+ ++ chr ' '
+ ++ (self#pExpPrec level () e2)
+ ++ unalign
+
+ | CastE(t,e) ->
+ text "("
+ ++ self#pType None () t
+ ++ text ")"
+ ++ self#pExpPrec level () e
+
+ | SizeOf (t) ->
+ text "sizeof(" ++ self#pType None () t ++ chr ')'
+ | SizeOfE (e) ->
+ text "sizeof(" ++ self#pExp () e ++ chr ')'
+
+ | SizeOfStr s ->
+ text "sizeof(" ++ d_const () (CStr s) ++ chr ')'
+
+ | AlignOf (t) ->
+ text "__alignof__(" ++ self#pType None () t ++ chr ')'
+ | AlignOfE (e) ->
+ text "__alignof__(" ++ self#pExp () e ++ chr ')'
+ | AddrOf(lv) ->
+ text "& " ++ (self#pLvalPrec addrOfLevel () lv)
+
+ | StartOf(lv) -> self#pLval () lv
+
+ method private pExpPrec (contextprec: int) () (e: exp) =
+ let thisLevel = getParenthLevel e in
+ let needParens =
+ if thisLevel >= contextprec then
+ true
+ else if contextprec == bitwiseLevel then
+ (* quiet down some GCC warnings *)
+ thisLevel == additiveLevel || thisLevel == comparativeLevel
+ else
+ false
+ in
+ if needParens then
+ chr '(' ++ self#pExp () e ++ chr ')'
+ else
+ self#pExp () e
+
+ method pInit () = function
+ SingleInit e -> self#pExp () e
+ | CompoundInit (t, initl) ->
+ (* We do not print the type of the Compound *)
+(*
+ let dinit e = d_init () e in
+ dprintf "{@[%a@]}"
+ (docList ~sep:(chr ',' ++ break) dinit) initl
+*)
+ let printDesignator =
+ if not !msvcMode then begin
+ (* Print only for union when we do not initialize the first field *)
+ match unrollType t, initl with
+ TComp(ci, _), [(Field(f, NoOffset), _)] ->
+ if not (ci.cstruct) && ci.cfields != [] &&
+ (List.hd ci.cfields) != f then
+ true
+ else
+ false
+ | _ -> false
+ end else
+ false
+ in
+ let d_oneInit = function
+ Field(f, NoOffset), i ->
+ (if printDesignator then
+ text ("." ^ f.fname ^ " = ")
+ else nil) ++ self#pInit () i
+ | Index(e, NoOffset), i ->
+ (if printDesignator then
+ text "[" ++ self#pExp () e ++ text "] = " else nil) ++
+ self#pInit () i
+ | _ -> E.s (unimp "Trying to print malformed initializer")
+ in
+ chr '{' ++ (align
+ ++ ((docList ~sep:(chr ',' ++ break) d_oneInit) () initl)
+ ++ unalign)
+ ++ chr '}'
+(*
+ | ArrayInit (_, _, il) ->
+ chr '{' ++ (align
+ ++ ((docList (chr ',' ++ break) (self#pInit ())) () il)
+ ++ unalign)
+ ++ chr '}'
+*)
+ (* dump initializers to a file. *)
+ method dInit (out: out_channel) (ind: int) (i: init) =
+ (* Dump an array *)
+ let dumpArray (bt: typ) (il: 'a list) (getelem: 'a -> init) =
+ let onALine = (* How many elements on a line *)
+ match unrollType bt with TComp _ | TArray _ -> 1 | _ -> 4
+ in
+ let rec outputElements (isfirst: bool) (room_on_line: int) = function
+ [] -> output_string out "}"
+ | (i: 'a) :: rest ->
+ if not isfirst then output_string out ", ";
+ let new_room_on_line =
+ if room_on_line == 0 then begin
+ output_string out "\n"; output_string out (String.make ind ' ');
+ onALine - 1
+ end else
+ room_on_line - 1
+ in
+ self#dInit out (ind + 2) (getelem i);
+ outputElements false new_room_on_line rest
+ in
+ output_string out "{ ";
+ outputElements true onALine il
+ in
+ match i with
+ SingleInit e ->
+ fprint out !lineLength (indent ind (self#pExp () e))
+ | CompoundInit (t, initl) -> begin
+ match unrollType t with
+ TArray(bt, _, _) ->
+ dumpArray bt initl (fun (_, i) -> i)
+ | _ ->
+ (* Now a structure or a union *)
+ fprint out !lineLength (indent ind (self#pInit () i))
+ end
+(*
+ | ArrayInit (bt, len, initl) -> begin
+ (* If the base type does not contain structs then use the pInit
+ match unrollType bt with
+ TComp _ | TArray _ ->
+ dumpArray bt initl (fun x -> x)
+ | _ -> *)
+ fprint out !lineLength (indent ind (self#pInit () i))
+ end
+*)
+
+ (** What terminator to print after an instruction. sometimes we want to
+ * print sequences of instructions separated by comma *)
+ val mutable printInstrTerminator = ";"
+
+ (*** INSTRUCTIONS ****)
+ method pInstr () (i:instr) = (* imperative instruction *)
+ match i with
+ | Set(lv,e,l) -> begin
+ (* Be nice to some special cases *)
+ match e with
+ BinOp((PlusA|PlusPI|IndexPI),Lval(lv'), Const(CInt64(one,_,_)),_)
+ when Util.equals lv lv' && one = Int64.one && not !printCilAsIs ->
+ self#pLineDirective l
+ ++ self#pLval () lv
+ ++ text (" ++" ^ printInstrTerminator)
+
+ | BinOp((MinusA|MinusPI),Lval(lv'),
+ Const(CInt64(one,_,_)), _)
+ when Util.equals lv lv' && one = Int64.one && not !printCilAsIs ->
+ self#pLineDirective l
+ ++ self#pLval () lv
+ ++ text (" --" ^ printInstrTerminator)
+
+ | BinOp((PlusA|PlusPI|IndexPI),Lval(lv'),Const(CInt64(mone,_,_)),_)
+ when Util.equals lv lv' && mone = Int64.minus_one
+ && not !printCilAsIs ->
+ self#pLineDirective l
+ ++ self#pLval () lv
+ ++ text (" --" ^ printInstrTerminator)
+
+ | BinOp((PlusA|PlusPI|IndexPI|MinusA|MinusPP|MinusPI|BAnd|BOr|BXor|
+ Mult|Div|Mod|Shiftlt|Shiftrt) as bop,
+ Lval(lv'),e,_) when Util.equals lv lv' ->
+ self#pLineDirective l
+ ++ self#pLval () lv
+ ++ text " " ++ d_binop () bop
+ ++ text "= "
+ ++ self#pExp () e
+ ++ text printInstrTerminator
+
+ | _ ->
+ self#pLineDirective l
+ ++ self#pLval () lv
+ ++ text " = "
+ ++ self#pExp () e
+ ++ text printInstrTerminator
+
+ end
+ (* In cabs2cil we have turned the call to builtin_va_arg into a
+ * three-argument call: the last argument is the address of the
+ * destination *)
+ | Call(None, Lval(Var vi, NoOffset), [dest; SizeOf t; adest], l)
+ when vi.vname = "__builtin_va_arg" && not !printCilAsIs ->
+ let destlv = match stripCasts adest with
+ AddrOf destlv -> destlv
+ | _ -> E.s (E.error "Encountered unexpected call to %s\n" vi.vname)
+ in
+ self#pLineDirective l
+ ++ self#pLval () destlv ++ text " = "
+
+ (* Now the function name *)
+ ++ text "__builtin_va_arg"
+ ++ text "(" ++ (align
+ (* Now the arguments *)
+ ++ self#pExp () dest
+ ++ chr ',' ++ break
+ ++ self#pType None () t
+ ++ unalign)
+ ++ text (")" ^ printInstrTerminator)
+
+ (* In cabs2cil we have dropped the last argument in the call to
+ * __builtin_stdarg_start. *)
+ | Call(None, Lval(Var vi, NoOffset), [marker], l)
+ when vi.vname = "__builtin_stdarg_start" && not !printCilAsIs -> begin
+ let last = self#getLastNamedArgument vi.vname in
+ self#pInstr () (Call(None,Lval(Var vi,NoOffset),[marker; last],l))
+ end
+
+ (* In cabs2cil we have dropped the last argument in the call to
+ * __builtin_next_arg. *)
+ | Call(res, Lval(Var vi, NoOffset), [ ], l)
+ when vi.vname = "__builtin_next_arg" && not !printCilAsIs -> begin
+ let last = self#getLastNamedArgument vi.vname in
+ self#pInstr () (Call(res,Lval(Var vi,NoOffset),[last],l))
+ end
+
+ (* In cparser we have turned the call to
+ * __builtin_types_compatible_p(t1, t2) into
+ * __builtin_types_compatible_p(sizeof t1, sizeof t2), so that we can
+ * represent the types as expressions.
+ * Remove the sizeofs when printing. *)
+ | Call(dest, Lval(Var vi, NoOffset), [SizeOf t1; SizeOf t2], l)
+ when vi.vname = "__builtin_types_compatible_p" && not !printCilAsIs ->
+ self#pLineDirective l
+ (* Print the destination *)
+ ++ (match dest with
+ None -> nil
+ | Some lv -> self#pLval () lv ++ text " = ")
+ (* Now the call itself *)
+ ++ dprintf "%s(%a, %a)" vi.vname
+ (self#pType None) t1 (self#pType None) t2
+ ++ text printInstrTerminator
+ | Call(_, Lval(Var vi, NoOffset), _, l)
+ when vi.vname = "__builtin_types_compatible_p" && not !printCilAsIs ->
+ E.s (bug "__builtin_types_compatible_p: cabs2cil should have added sizeof to the arguments.")
+
+ | Call(dest,e,args,l) ->
+ self#pLineDirective l
+ ++ (match dest with
+ None -> nil
+ | Some lv ->
+ self#pLval () lv ++ text " = " ++
+ (* Maybe we need to print a cast *)
+ (let destt = typeOfLval lv in
+ match unrollType (typeOf e) with
+ TFun (rt, _, _, _)
+ when not (Util.equals (!pTypeSig rt)
+ (!pTypeSig destt)) ->
+ text "(" ++ self#pType None () destt ++ text ")"
+ | _ -> nil))
+ (* Now the function name *)
+ ++ (let ed = self#pExp () e in
+ match e with
+ Lval(Var _, _) -> ed
+ | _ -> text "(" ++ ed ++ text ")")
+ ++ text "(" ++
+ (align
+ (* Now the arguments *)
+ ++ (docList ~sep:(chr ',' ++ break)
+ (self#pExp ()) () args)
+ ++ unalign)
+ ++ text (")" ^ printInstrTerminator)
+
+ | Asm(attrs, tmpls, outs, ins, clobs, l) ->
+ if !msvcMode then
+ self#pLineDirective l
+ ++ text "__asm {"
+ ++ (align
+ ++ (docList ~sep:line text () tmpls)
+ ++ unalign)
+ ++ text ("}" ^ printInstrTerminator)
+ else
+ self#pLineDirective l
+ ++ text ("__asm__ ")
+ ++ self#pAttrs () attrs
+ ++ text " ("
+ ++ (align
+ ++ (docList ~sep:line
+ (fun x -> text ("\"" ^ escape_string x ^ "\""))
+ () tmpls)
+ ++
+ (if outs = [] && ins = [] && clobs = [] then
+ chr ':'
+ else
+ (text ": "
+ ++ (docList ~sep:(chr ',' ++ break)
+ (fun (c, lv) ->
+ text ("\"" ^ escape_string c ^ "\" (")
+ ++ self#pLval () lv
+ ++ text ")") () outs)))
+ ++
+ (if ins = [] && clobs = [] then
+ nil
+ else
+ (text ": "
+ ++ (docList ~sep:(chr ',' ++ break)
+ (fun (c, e) ->
+ text ("\"" ^ escape_string c ^ "\" (")
+ ++ self#pExp () e
+ ++ text ")") () ins)))
+ ++
+ (if clobs = [] then nil
+ else
+ (text ": "
+ ++ (docList ~sep:(chr ',' ++ break)
+ (fun c -> text ("\"" ^ escape_string c ^ "\""))
+ ()
+ clobs)))
+ ++ unalign)
+ ++ text (")" ^ printInstrTerminator)
+
+
+ (**** STATEMENTS ****)
+ method pStmt () (s:stmt) = (* control-flow statement *)
+ self#pStmtNext invalidStmt () s
+
+ method dStmt (out: out_channel) (ind: int) (s:stmt) : unit =
+ fprint out !lineLength (indent ind (self#pStmt () s))
+
+ method dBlock (out: out_channel) (ind: int) (b:block) : unit =
+ fprint out !lineLength (indent ind (align ++ self#pBlock () b))
+
+ method private pStmtNext (next: stmt) () (s: stmt) =
+ (* print the labels *)
+ ((docList ~sep:line (fun l -> self#pLabel () l)) () s.labels)
+ (* print the statement itself. If the labels are non-empty and the
+ * statement is empty, print a semicolon *)
+ ++
+ (if s.skind = Instr [] && s.labels <> [] then
+ text ";"
+ else
+ (if s.labels <> [] then line else nil)
+ ++ self#pStmtKind next () s.skind)
+
+ method private pLabel () = function
+ Label (s, _, true) -> text (s ^ ": ")
+ | Label (s, _, false) -> text (s ^ ": /* CIL Label */ ")
+ | Case (e, _) -> text "case " ++ self#pExp () e ++ text ": "
+ | Default _ -> text "default: "
+
+ (* The pBlock will put the unalign itself *)
+ method pBlock () (blk: block) =
+ let rec dofirst () = function
+ [] -> nil
+ | [x] -> self#pStmtNext invalidStmt () x
+ | x :: rest -> dorest nil x rest
+ and dorest acc prev = function
+ [] -> acc ++ (self#pStmtNext invalidStmt () prev)
+ | x :: rest ->
+ dorest (acc ++ (self#pStmtNext x () prev) ++ line)
+ x rest
+ in
+ (* Let the host of the block decide on the alignment. The d_block will
+ * pop the alignment as well *)
+ text "{"
+ ++
+ (if blk.battrs <> [] then
+ self#pAttrsGen true blk.battrs
+ else nil)
+ ++ line
+ ++ (dofirst () blk.bstmts)
+ ++ unalign ++ line ++ text "}"
+
+
+ (* Store here the name of the last file printed in a line number. This is
+ * private to the object *)
+ val mutable lastFileName = ""
+ (* Make sure that you only call self#pLineDirective on an empty line *)
+ method pLineDirective ?(forcefile=false) l =
+ currentLoc := l;
+ match !lineDirectiveStyle with
+ | Some style when l.line > 0 ->
+ let directive =
+ match style with
+ | LineComment -> text "//#line "
+ | LinePreprocessorOutput when not !msvcMode -> chr '#'
+ | _ -> text "#line"
+ in
+ let filename =
+ if forcefile || l.file <> lastFileName then
+ begin
+ lastFileName <- l.file;
+ text " \"" ++ text l.file ++ text "\""
+ end
+ else
+ nil
+ in
+ leftflush ++ directive ++ chr ' ' ++ num l.line ++ filename ++ line
+ | _ ->
+ nil
+
+
+ method private pStmtKind (next: stmt) () = function
+ Return(None, l) ->
+ self#pLineDirective l
+ ++ text "return;"
+
+ | Return(Some e, l) ->
+ self#pLineDirective l
+ ++ text "return ("
+ ++ self#pExp () e
+ ++ text ");"
+
+ | Goto (sref, l) -> begin
+ (* Grab one of the labels *)
+ let rec pickLabel = function
+ [] -> None
+ | Label (l, _, _) :: _ -> Some l
+ | _ :: rest -> pickLabel rest
+ in
+ match pickLabel !sref.labels with
+ Some l -> text ("goto " ^ l ^ ";")
+ | None ->
+ ignore (error "Cannot find label for target of goto\n");
+ text "goto __invalid_label;"
+ end
+
+ | Break l ->
+ self#pLineDirective l
+ ++ text "break;"
+
+ | Continue l ->
+ self#pLineDirective l
+ ++ text "continue;"
+
+ | Instr il ->
+ align
+ ++ (docList ~sep:line (fun i -> self#pInstr () i) () il)
+ ++ unalign
+
+ | If(be,t,{bstmts=[];battrs=[]},l) when not !printCilAsIs ->
+ self#pLineDirective l
+ ++ text "if"
+ ++ (align
+ ++ text " ("
+ ++ self#pExp () be
+ ++ text ") "
+ ++ self#pBlock () t)
+
+ | If(be,t,{bstmts=[{skind=Goto(gref,_);labels=[]}];
+ battrs=[]},l)
+ when !gref == next && not !printCilAsIs ->
+ self#pLineDirective l
+ ++ text "if"
+ ++ (align
+ ++ text " ("
+ ++ self#pExp () be
+ ++ text ") "
+ ++ self#pBlock () t)
+
+ | If(be,{bstmts=[];battrs=[]},e,l) when not !printCilAsIs ->
+ self#pLineDirective l
+ ++ text "if"
+ ++ (align
+ ++ text " ("
+ ++ self#pExp () (UnOp(LNot,be,intType))
+ ++ text ") "
+ ++ self#pBlock () e)
+
+ | If(be,{bstmts=[{skind=Goto(gref,_);labels=[]}];
+ battrs=[]},e,l)
+ when !gref == next && not !printCilAsIs ->
+ self#pLineDirective l
+ ++ text "if"
+ ++ (align
+ ++ text " ("
+ ++ self#pExp () (UnOp(LNot,be,intType))
+ ++ text ") "
+ ++ self#pBlock () e)
+
+ | If(be,t,e,l) ->
+ self#pLineDirective l
+ ++ (align
+ ++ text "if"
+ ++ (align
+ ++ text " ("
+ ++ self#pExp () be
+ ++ text ") "
+ ++ self#pBlock () t)
+ ++ text " " (* sm: indent next code 2 spaces (was 4) *)
+ ++ (align
+ ++ text "else "
+ ++ self#pBlock () e)
+ ++ unalign)
+
+ | Switch(e,b,_,l) ->
+ self#pLineDirective l
+ ++ (align
+ ++ text "switch ("
+ ++ self#pExp () e
+ ++ text ") "
+ ++ self#pBlock () b)
+
+(*
+ | Loop(b, l, _, _) -> begin
+ (* Maybe the first thing is a conditional. Turn it into a WHILE *)
+ try
+ let term, bodystmts =
+ let rec skipEmpty = function
+ [] -> []
+ | {skind=Instr [];labels=[]} :: rest -> skipEmpty rest
+ | x -> x
+ in
+ (* Bill McCloskey: Do not remove the If if it has labels *)
+ match skipEmpty b.bstmts with
+ {skind=If(e,tb,fb,_); labels=[]} :: rest
+ when not !printCilAsIs -> begin
+ match skipEmpty tb.bstmts, skipEmpty fb.bstmts with
+ [], {skind=Break _; labels=[]} :: _ -> e, rest
+ | {skind=Break _; labels=[]} :: _, []
+ -> UnOp(LNot, e, intType), rest
+ | _ -> raise Not_found
+ end
+ | _ -> raise Not_found
+ in
+ self#pLineDirective l
+ ++ text "wh"
+ ++ (align
+ ++ text "ile ("
+ ++ self#pExp () term
+ ++ text ") "
+ ++ self#pBlock () {bstmts=bodystmts; battrs=b.battrs})
+
+ with Not_found ->
+ self#pLineDirective l
+ ++ text "wh"
+ ++ (align
+ ++ text "ile (1) "
+ ++ self#pBlock () b)
+ end
+*)
+
+ | While (e, b, l) ->
+ self#pLineDirective l
+ ++ (align
+ ++ text "while ("
+ ++ self#pExp () e
+ ++ text ") "
+ ++ self#pBlock () b)
+
+ | DoWhile (e, b, l) ->
+ self#pLineDirective l
+ ++ (align
+ ++ text "do "
+ ++ self#pBlock () b
+ ++ text " while ("
+ ++ self#pExp () e
+ ++ text ");")
+
+ | For (bInit, e, bIter, b, l) ->
+ ignore (E.warn
+ "in for loops, the 1st and 3rd expressions are not printed");
+ self#pLineDirective l
+ ++ (align
+ ++ text "for ("
+ ++ text "/* ??? */" (* self#pBlock () bInit *)
+ ++ text "; "
+ ++ self#pExp () e
+ ++ text "; "
+ ++ text "/* ??? */" (* self#pBlock() bIter *)
+ ++ text ") "
+ ++ self#pBlock () b)
+
+ | Block b -> align ++ self#pBlock () b
+
+ | TryFinally (b, h, l) ->
+ self#pLineDirective l
+ ++ text "__try "
+ ++ align
+ ++ self#pBlock () b
+ ++ text " __fin" ++ align ++ text "ally "
+ ++ self#pBlock () h
+
+ | TryExcept (b, (il, e), h, l) ->
+ self#pLineDirective l
+ ++ text "__try "
+ ++ align
+ ++ self#pBlock () b
+ ++ text " __e" ++ align ++ text "xcept(" ++ line
+ ++ align
+ (* Print the instructions but with a comma at the end, instead of
+ * semicolon *)
+ ++ (printInstrTerminator <- ",";
+ let res =
+ (docList ~sep:line (self#pInstr ())
+ () il)
+ in
+ printInstrTerminator <- ";";
+ res)
+ ++ self#pExp () e
+ ++ text ") " ++ unalign
+ ++ self#pBlock () h
+
+
+ (*** GLOBALS ***)
+ method pGlobal () (g:global) : doc = (* global (vars, types, etc.) *)
+ match g with
+ | GFun (fundec, l) ->
+ (* If the function has attributes then print a prototype because
+ * GCC cannot accept function attributes in a definition *)
+ let oldattr = fundec.svar.vattr in
+ (* Always pring the file name before function declarations *)
+ let proto =
+ if oldattr <> [] then
+ (self#pLineDirective l) ++ (self#pVDecl () fundec.svar)
+ ++ chr ';' ++ line
+ else nil in
+ (* Temporarily remove the function attributes *)
+ fundec.svar.vattr <- [];
+ let body = (self#pLineDirective ~forcefile:true l)
+ ++ (self#pFunDecl () fundec) in
+ fundec.svar.vattr <- oldattr;
+ proto ++ body ++ line
+
+ | GType (typ, l) ->
+ self#pLineDirective ~forcefile:true l ++
+ text "typedef "
+ ++ (self#pType (Some (text typ.tname)) () typ.ttype)
+ ++ text ";\n"
+
+ | GEnumTag (enum, l) ->
+ self#pLineDirective l ++
+ text "enum" ++ align ++ text (" " ^ enum.ename) ++
+ text " {" ++ line
+ ++ (docList ~sep:(chr ',' ++ line)
+ (fun (n,i, loc) ->
+ text (n ^ " = ")
+ ++ self#pExp () i)
+ () enum.eitems)
+ ++ unalign ++ line ++ text "} "
+ ++ self#pAttrs () enum.eattr ++ text";\n"
+
+ | GEnumTagDecl (enum, l) -> (* This is a declaration of a tag *)
+ self#pLineDirective l ++
+ text ("enum " ^ enum.ename ^ ";\n")
+
+ | GCompTag (comp, l) -> (* This is a definition of a tag *)
+ let n = comp.cname in
+ let su, su1, su2 =
+ if comp.cstruct then "struct", "str", "uct"
+ else "union", "uni", "on"
+ in
+ let sto_mod, rest_attr = separateStorageModifiers comp.cattr in
+ self#pLineDirective ~forcefile:true l ++
+ text su1 ++ (align ++ text su2 ++ chr ' ' ++ (self#pAttrs () sto_mod)
+ ++ text n
+ ++ text " {" ++ line
+ ++ ((docList ~sep:line (self#pFieldDecl ())) ()
+ comp.cfields)
+ ++ unalign)
+ ++ line ++ text "}" ++
+ (self#pAttrs () rest_attr) ++ text ";\n"
+
+ | GCompTagDecl (comp, l) -> (* This is a declaration of a tag *)
+ self#pLineDirective l ++
+ text (compFullName comp) ++ text ";\n"
+
+ | GVar (vi, io, l) ->
+ self#pLineDirective ~forcefile:true l ++
+ self#pVDecl () vi
+ ++ chr ' '
+ ++ (match io.init with
+ None -> nil
+ | Some i -> text " = " ++
+ (let islong =
+ match i with
+ CompoundInit (_, il) when List.length il >= 8 -> true
+ | _ -> false
+ in
+ if islong then
+ line ++ self#pLineDirective l ++ text " "
+ else nil) ++
+ (self#pInit () i))
+ ++ text ";\n"
+
+ (* print global variable 'extern' declarations, and function prototypes *)
+ | GVarDecl (vi, l) ->
+ self#pLineDirective l ++
+ (self#pVDecl () vi)
+ ++ text ";\n"
+
+ | GAsm (s, l) ->
+ self#pLineDirective l ++
+ text ("__asm__(\"" ^ escape_string s ^ "\");\n")
+
+ | GPragma (Attr(an, args), l) ->
+ (* sm: suppress printing pragmas that gcc does not understand *)
+ (* assume anything starting with "ccured" is ours *)
+ (* also don't print the 'combiner' pragma *)
+ (* nor 'cilnoremove' *)
+ let suppress =
+ not !print_CIL_Input &&
+ not !msvcMode &&
+ ((startsWith "box" an) ||
+ (startsWith "ccured" an) ||
+ (an = "merger") ||
+ (an = "cilnoremove")) in
+ let d =
+ match an, args with
+ | _, [] ->
+ text an
+ | "weak", [ACons (symbol, [])] ->
+ text "weak " ++ text symbol
+ | _ ->
+ text (an ^ "(")
+ ++ docList ~sep:(chr ',') (self#pAttrParam ()) () args
+ ++ text ")"
+ in
+ self#pLineDirective l
+ ++ (if suppress then text "/* " else text "")
+ ++ (text "#pragma ")
+ ++ d
+ ++ (if suppress then text " */\n" else text "\n")
+
+ | GText s ->
+ if s <> "//" then
+ text s ++ text "\n"
+ else
+ nil
+
+
+ method dGlobal (out: out_channel) (g: global) : unit =
+ (* For all except functions and variable with initializers, use the
+ * pGlobal *)
+ match g with
+ GFun (fdec, l) ->
+ (* If the function has attributes then print a prototype because
+ * GCC cannot accept function attributes in a definition *)
+ let oldattr = fdec.svar.vattr in
+ let proto =
+ if oldattr <> [] then
+ (self#pLineDirective l) ++ (self#pVDecl () fdec.svar)
+ ++ chr ';' ++ line
+ else nil in
+ fprint out !lineLength
+ (proto ++ (self#pLineDirective ~forcefile:true l));
+ (* Temporarily remove the function attributes *)
+ fdec.svar.vattr <- [];
+ fprint out !lineLength (self#pFunDecl () fdec);
+ fdec.svar.vattr <- oldattr;
+ output_string out "\n"
+
+ | GVar (vi, {init = Some i}, l) -> begin
+ fprint out !lineLength
+ (self#pLineDirective ~forcefile:true l ++
+ self#pVDecl () vi
+ ++ text " = "
+ ++ (let islong =
+ match i with
+ CompoundInit (_, il) when List.length il >= 8 -> true
+ | _ -> false
+ in
+ if islong then
+ line ++ self#pLineDirective l ++ text " "
+ else nil));
+ self#dInit out 3 i;
+ output_string out ";\n"
+ end
+
+ | g -> fprint out !lineLength (self#pGlobal () g)
+
+ method pFieldDecl () fi =
+ (self#pType
+ (Some (text (if fi.fname = missingFieldName then "" else fi.fname)))
+ ()
+ fi.ftype)
+ ++ text " "
+ ++ (match fi.fbitfield with None -> nil
+ | Some i -> text ": " ++ num i ++ text " ")
+ ++ self#pAttrs () fi.fattr
+ ++ text ";"
+
+ method private pFunDecl () f =
+ self#pVDecl () f.svar
+ ++ line
+ ++ text "{ "
+ ++ (align
+ (* locals. *)
+ ++ (docList ~sep:line (fun vi -> self#pVDecl () vi ++ text ";")
+ () f.slocals)
+ ++ line ++ line
+ (* the body *)
+ ++ ((* remember the declaration *) currentFormals <- f.sformals;
+ let body = self#pBlock () f.sbody in
+ currentFormals <- [];
+ body))
+ ++ line
+ ++ text "}"
+
+ (***** PRINTING DECLARATIONS and TYPES ****)
+
+ method pType (nameOpt: doc option) (* Whether we are declaring a name or
+ * we are just printing a type *)
+ () (t:typ) = (* use of some type *)
+ let name = match nameOpt with None -> nil | Some d -> d in
+ let printAttributes (a: attributes) =
+ let pa = self#pAttrs () a in
+ match nameOpt with
+ | None when not !print_CIL_Input && not !msvcMode ->
+ (* Cannot print the attributes in this case because gcc does not
+ * like them here, except if we are printing for CIL, or for MSVC.
+ * In fact, for MSVC we MUST print attributes such as __stdcall *)
+ if pa = nil then nil else
+ text "/*" ++ pa ++ text "*/"
+ | _ -> pa
+ in
+ match t with
+ TVoid a ->
+ text "void"
+ ++ self#pAttrs () a
+ ++ text " "
+ ++ name
+
+ | TInt (ikind,a) ->
+ d_ikind () ikind
+ ++ self#pAttrs () a
+ ++ text " "
+ ++ name
+
+ | TFloat(fkind, a) ->
+ d_fkind () fkind
+ ++ self#pAttrs () a
+ ++ text " "
+ ++ name
+
+ | TComp (comp, a) -> (* A reference to a struct *)
+ let su = if comp.cstruct then "struct" else "union" in
+ text (su ^ " " ^ comp.cname ^ " ")
+ ++ self#pAttrs () a
+ ++ name
+
+ | TEnum (enum, a) ->
+ text ("enum " ^ enum.ename ^ " ")
+ ++ self#pAttrs () a
+ ++ name
+ | TPtr (bt, a) ->
+ (* Parenthesize the ( * attr name) if a pointer to a function or an
+ * array. However, on MSVC the __stdcall modifier must appear right
+ * before the pointer constructor "(__stdcall *f)". We push them into
+ * the parenthesis. *)
+ let (paren: doc option), (bt': typ) =
+ match bt with
+ TFun(rt, args, isva, fa) when !msvcMode ->
+ let an, af', at = partitionAttributes ~default:AttrType fa in
+ (* We take the af' and we put them into the parentheses *)
+ Some (text "(" ++ printAttributes af'),
+ TFun(rt, args, isva, addAttributes an at)
+
+ | TFun _ | TArray _ -> Some (text "("), bt
+
+ | _ -> None, bt
+ in
+ let name' = text "*" ++ printAttributes a ++ name in
+ let name'' = (* Put the parenthesis *)
+ match paren with
+ Some p -> p ++ name' ++ text ")"
+ | _ -> name'
+ in
+ self#pType
+ (Some name'')
+ ()
+ bt'
+
+ | TArray (elemt, lo, a) ->
+ (* ignore the const attribute for arrays *)
+ let a' = dropAttributes [ "const" ] a in
+ let name' =
+ if a' == [] then name else
+ if nameOpt == None then printAttributes a' else
+ text "(" ++ printAttributes a' ++ name ++ text ")"
+ in
+ self#pType
+ (Some (name'
+ ++ text "["
+ ++ (match lo with None -> nil | Some e -> self#pExp () e)
+ ++ text "]"))
+ ()
+ elemt
+
+ | TFun (restyp, args, isvararg, a) ->
+ let name' =
+ if a == [] then name else
+ if nameOpt == None then printAttributes a else
+ text "(" ++ printAttributes a ++ name ++ text ")"
+ in
+ self#pType
+ (Some
+ (name'
+ ++ text "("
+ ++ (align
+ ++
+ (if args = Some [] && isvararg then
+ text "..."
+ else
+ (if args = None then nil
+ else if args = Some [] then text "void"
+ else
+ let pArg (aname, atype, aattr) =
+ let stom, rest = separateStorageModifiers aattr in
+ (* First the storage modifiers *)
+ (self#pAttrs () stom)
+ ++ (self#pType (Some (text aname)) () atype)
+ ++ text " "
+ ++ self#pAttrs () rest
+ in
+ (docList ~sep:(chr ',' ++ break) pArg) ()
+ (argsToList args))
+ ++ (if isvararg then break ++ text ", ..." else nil))
+ ++ unalign)
+ ++ text ")"))
+ ()
+ restyp
+
+ | TNamed (t, a) ->
+ text t.tname ++ self#pAttrs () a ++ text " " ++ name
+
+ | TBuiltin_va_list a ->
+ text "__builtin_va_list"
+ ++ self#pAttrs () a
+ ++ text " "
+ ++ name
+
+
+ (**** PRINTING ATTRIBUTES *********)
+ method pAttrs () (a: attributes) =
+ self#pAttrsGen false a
+
+
+ (* Print one attribute. Return also an indication whether this attribute
+ * should be printed inside the __attribute__ list *)
+ method pAttr (Attr(an, args): attribute) : doc * bool =
+ (* Recognize and take care of some known cases *)
+ match an, args with
+ "const", [] -> text "const", false
+ (* Put the aconst inside the attribute list *)
+ | "aconst", [] when not !msvcMode -> text "__const__", true
+ | "thread", [] when not !msvcMode -> text "__thread", false
+(*
+ | "used", [] when not !msvcMode -> text "__attribute_used__", false
+*)
+ | "volatile", [] -> text "volatile", false
+ | "restrict", [] -> text "__restrict", false
+ | "missingproto", [] -> text "/* missing proto */", false
+ | "cdecl", [] when !msvcMode -> text "__cdecl", false
+ | "stdcall", [] when !msvcMode -> text "__stdcall", false
+ | "fastcall", [] when !msvcMode -> text "__fastcall", false
+ | "declspec", args when !msvcMode ->
+ text "__declspec("
+ ++ docList (self#pAttrParam ()) () args
+ ++ text ")", false
+ | "w64", [] when !msvcMode -> text "__w64", false
+ | "asm", args ->
+ text "__asm__("
+ ++ docList (self#pAttrParam ()) () args
+ ++ text ")", false
+ (* we suppress printing mode(__si__) because it triggers an *)
+ (* internal compiler error in all current gcc versions *)
+ (* sm: I've now encountered a problem with mode(__hi__)... *)
+ (* I don't know what's going on, but let's try disabling all "mode"..*)
+ | "mode", [ACons(tag,[])] ->
+ text "/* mode(" ++ text tag ++ text ") */", false
+
+ (* sm: also suppress "format" because we seem to print it in *)
+ (* a way gcc does not like *)
+ | "format", _ -> text "/* format attribute */", false
+
+ (* sm: here's another one I don't want to see gcc warnings about.. *)
+ | "mayPointToStack", _ when not !print_CIL_Input
+ (* [matth: may be inside another comment.]
+ -> text "/*mayPointToStack*/", false
+ *)
+ -> text "", false
+
+ | _ -> (* This is the dafault case *)
+ (* Add underscores to the name *)
+ let an' = if !msvcMode then "__" ^ an else "__" ^ an ^ "__" in
+ if args = [] then
+ text an', true
+ else
+ text (an' ^ "(")
+ ++ (docList (self#pAttrParam ()) () args)
+ ++ text ")",
+ true
+
+ method pAttrParam () = function
+ | AInt n -> num n
+ | AStr s -> text ("\"" ^ escape_string s ^ "\"")
+ | ACons(s, []) -> text s
+ | ACons(s,al) ->
+ text (s ^ "(")
+ ++ (docList (self#pAttrParam ()) () al)
+ ++ text ")"
+ | ASizeOfE a -> text "sizeof(" ++ self#pAttrParam () a ++ text ")"
+ | ASizeOf t -> text "sizeof(" ++ self#pType None () t ++ text ")"
+ | ASizeOfS ts -> text "sizeof(<typsig>)"
+ | AAlignOfE a -> text "__alignof__(" ++ self#pAttrParam () a ++ text ")"
+ | AAlignOf t -> text "__alignof__(" ++ self#pType None () t ++ text ")"
+ | AAlignOfS ts -> text "__alignof__(<typsig>)"
+ | AUnOp(u,a1) ->
+ (d_unop () u) ++ text " (" ++ (self#pAttrParam () a1) ++ text ")"
+
+ | ABinOp(b,a1,a2) ->
+ align
+ ++ text "("
+ ++ (self#pAttrParam () a1)
+ ++ text ") "
+ ++ (d_binop () b)
+ ++ break
+ ++ text " (" ++ (self#pAttrParam () a2) ++ text ") "
+ ++ unalign
+ | ADot (ap, s) -> (self#pAttrParam () ap) ++ text ("." ^ s)
+
+ (* A general way of printing lists of attributes *)
+ method private pAttrsGen (block: bool) (a: attributes) =
+ (* Scan all the attributes and separate those that must be printed inside
+ * the __attribute__ list *)
+ let rec loop (in__attr__: doc list) = function
+ [] -> begin
+ match in__attr__ with
+ [] -> nil
+ | _ :: _->
+ (* sm: added 'forgcc' calls to not comment things out
+ * if CIL is the consumer; this is to address a case
+ * Daniel ran into where blockattribute(nobox) was being
+ * dropped by the merger
+ *)
+ (if block then
+ text (" " ^ (forgcc "/*") ^ " __blockattribute__(")
+ else
+ text "__attribute__((")
+
+ ++ (docList ~sep:(chr ',' ++ break)
+ (fun a -> a)) () in__attr__
+ ++ text ")"
+ ++ (if block then text (forgcc "*/") else text ")")
+ end
+ | x :: rest ->
+ let dx, ina = self#pAttr x in
+ if ina then
+ loop (dx :: in__attr__) rest
+ else
+ dx ++ text " " ++ loop in__attr__ rest
+ in
+ let res = loop [] a in
+ if res = nil then
+ res
+ else
+ text " " ++ res ++ text " "
+
+end (* class defaultCilPrinterClass *)
+
+let defaultCilPrinter = new defaultCilPrinterClass
+
+(* Top-level printing functions *)
+let printType (pp: cilPrinter) () (t: typ) : doc =
+ pp#pType None () t
+
+let printExp (pp: cilPrinter) () (e: exp) : doc =
+ pp#pExp () e
+
+let printLval (pp: cilPrinter) () (lv: lval) : doc =
+ pp#pLval () lv
+
+let printGlobal (pp: cilPrinter) () (g: global) : doc =
+ pp#pGlobal () g
+
+let dumpGlobal (pp: cilPrinter) (out: out_channel) (g: global) : unit =
+ pp#dGlobal out g
+
+let printAttr (pp: cilPrinter) () (a: attribute) : doc =
+ let ad, _ = pp#pAttr a in ad
+
+let printAttrs (pp: cilPrinter) () (a: attributes) : doc =
+ pp#pAttrs () a
+
+let printInstr (pp: cilPrinter) () (i: instr) : doc =
+ pp#pInstr () i
+
+let printStmt (pp: cilPrinter) () (s: stmt) : doc =
+ pp#pStmt () s
+
+let printBlock (pp: cilPrinter) () (b: block) : doc =
+ (* We must add the alignment ourselves, beucase pBlock will pop it *)
+ align ++ pp#pBlock () b
+
+let dumpStmt (pp: cilPrinter) (out: out_channel) (ind: int) (s: stmt) : unit =
+ pp#dStmt out ind s
+
+let dumpBlock (pp: cilPrinter) (out: out_channel) (ind: int) (b: block) : unit =
+ pp#dBlock out ind b
+
+let printInit (pp: cilPrinter) () (i: init) : doc =
+ pp#pInit () i
+
+let dumpInit (pp: cilPrinter) (out: out_channel) (ind: int) (i: init) : unit =
+ pp#dInit out ind i
+
+(* Now define some short cuts *)
+let d_exp () e = printExp defaultCilPrinter () e
+let _ = pd_exp := d_exp
+let d_lval () lv = printLval defaultCilPrinter () lv
+let d_offset base () off = defaultCilPrinter#pOffset base off
+let d_init () i = printInit defaultCilPrinter () i
+let d_type () t = printType defaultCilPrinter () t
+let d_global () g = printGlobal defaultCilPrinter () g
+let d_attrlist () a = printAttrs defaultCilPrinter () a
+let d_attr () a = printAttr defaultCilPrinter () a
+let d_attrparam () e = defaultCilPrinter#pAttrParam () e
+let d_label () l = defaultCilPrinter#pLabel () l
+let d_stmt () s = printStmt defaultCilPrinter () s
+let d_block () b = printBlock defaultCilPrinter () b
+let d_instr () i = printInstr defaultCilPrinter () i
+
+let d_shortglobal () = function
+ GPragma (Attr(an, _), _) -> dprintf "#pragma %s" an
+ | GType (ti, _) -> dprintf "typedef %s" ti.tname
+ | GVarDecl (vi, _) -> dprintf "declaration of %s" vi.vname
+ | GVar (vi, _, _) -> dprintf "definition of %s" vi.vname
+ | GCompTag(ci,_) -> dprintf "definition of %s" (compFullName ci)
+ | GCompTagDecl(ci,_) -> dprintf "declaration of %s" (compFullName ci)
+ | GEnumTag(ei,_) -> dprintf "definition of enum %s" ei.ename
+ | GEnumTagDecl(ei,_) -> dprintf "declaration of enum %s" ei.ename
+ | GFun(fd, _) -> dprintf "definition of %s" fd.svar.vname
+ | GText _ -> text "GText"
+ | GAsm _ -> text "GAsm"
+
+
+(* sm: given an ordinary CIL object printer, yield one which
+ * behaves the same, except it never prints #line directives
+ * (this is useful for debugging printfs) *)
+let dn_obj (func: unit -> 'a -> doc) : (unit -> 'a -> doc) =
+begin
+ (* construct the closure to return *)
+ let theFunc () (obj:'a) : doc =
+ begin
+ let prevStyle = !lineDirectiveStyle in
+ lineDirectiveStyle := None;
+ let ret = (func () obj) in (* call underlying printer *)
+ lineDirectiveStyle := prevStyle;
+ ret
+ end in
+ theFunc
+end
+
+(* now define shortcuts for the non-location-printing versions,
+ * with the naming prefix "dn_" *)
+let dn_exp = (dn_obj d_exp)
+let dn_lval = (dn_obj d_lval)
+(* dn_offset is missing because it has a different interface *)
+let dn_init = (dn_obj d_init)
+let dn_type = (dn_obj d_type)
+let dn_global = (dn_obj d_global)
+let dn_attrlist = (dn_obj d_attrlist)
+let dn_attr = (dn_obj d_attr)
+let dn_attrparam = (dn_obj d_attrparam)
+let dn_stmt = (dn_obj d_stmt)
+let dn_instr = (dn_obj d_instr)
+
+
+(* Now define a cilPlainPrinter *)
+class plainCilPrinterClass =
+ (* We keep track of the composite types that we have done to avoid
+ * recursion *)
+ let donecomps : (int, unit) H.t = H.create 13 in
+ object (self)
+
+ inherit defaultCilPrinterClass as super
+
+ (*** PLAIN TYPES ***)
+ method pType (dn: doc option) () (t: typ) =
+ match dn with
+ None -> self#pOnlyType () t
+ | Some d -> d ++ text " : " ++ self#pOnlyType () t
+
+ method private pOnlyType () = function
+ TVoid a -> dprintf "TVoid(@[%a@])" self#pAttrs a
+ | TInt(ikind, a) -> dprintf "TInt(@[%a,@?%a@])"
+ d_ikind ikind self#pAttrs a
+ | TFloat(fkind, a) ->
+ dprintf "TFloat(@[%a,@?%a@])" d_fkind fkind self#pAttrs a
+ | TNamed (t, a) ->
+ dprintf "TNamed(@[%s,@?%a,@?%a@])"
+ t.tname self#pOnlyType t.ttype self#pAttrs a
+ | TPtr(t, a) -> dprintf "TPtr(@[%a,@?%a@])" self#pOnlyType t self#pAttrs a
+ | TArray(t,l,a) ->
+ let dl = match l with
+ None -> text "None" | Some l -> dprintf "Some(@[%a@])" self#pExp l in
+ dprintf "TArray(@[%a,@?%a,@?%a@])"
+ self#pOnlyType t insert dl self#pAttrs a
+ | TEnum(enum,a) -> dprintf "Enum(%s,@[%a@])" enum.ename self#pAttrs a
+ | TFun(tr,args,isva,a) ->
+ dprintf "TFun(@[%a,@?%a%s,@?%a@])"
+ self#pOnlyType tr
+ insert
+ (if args = None then text "None"
+ else (docList ~sep:(chr ',' ++ break)
+ (fun (an,at,aa) ->
+ dprintf "%s: %a" an self#pOnlyType at))
+ ()
+ (argsToList args))
+ (if isva then "..." else "") self#pAttrs a
+ | TComp (comp, a) ->
+ if H.mem donecomps comp.ckey then
+ dprintf "TCompLoop(%s %s, _, %a)"
+ (if comp.cstruct then "struct" else "union") comp.cname
+ self#pAttrs comp.cattr
+ else begin
+ H.add donecomps comp.ckey (); (* Add it before we do the fields *)
+ dprintf "TComp(@[%s %s,@?%a,@?%a,@?%a@])"
+ (if comp.cstruct then "struct" else "union") comp.cname
+ (docList ~sep:(chr ',' ++ break)
+ (fun f -> dprintf "%s : %a" f.fname self#pOnlyType f.ftype))
+ comp.cfields
+ self#pAttrs comp.cattr
+ self#pAttrs a
+ end
+ | TBuiltin_va_list a ->
+ dprintf "TBuiltin_va_list(%a)" self#pAttrs a
+
+
+ (* Some plain pretty-printers. Unlike the above these expose all the
+ * details of the internal representation *)
+ method pExp () = function
+ Const(c) ->
+ let d_plainconst () c =
+ match c with
+ CInt64(i, ik, so) ->
+ dprintf "Int64(%s,%a,%s)"
+ (Int64.format "%d" i)
+ d_ikind ik
+ (match so with Some s -> s | _ -> "None")
+ | CStr(s) ->
+ text ("CStr(\"" ^ escape_string s ^ "\")")
+ | CWStr(s) ->
+ dprintf "CWStr(%a)" d_const c
+
+ | CChr(c) -> text ("CChr('" ^ escape_char c ^ "')")
+ | CReal(f, fk, so) ->
+ dprintf "CReal(%f, %a, %s)"
+ f
+ d_fkind fk
+ (match so with Some s -> s | _ -> "None")
+ | CEnum(_, s, _) -> text s
+ in
+ text "Const(" ++ d_plainconst () c ++ text ")"
+
+
+ | Lval(lv) ->
+ text "Lval("
+ ++ (align
+ ++ self#pLval () lv
+ ++ unalign)
+ ++ text ")"
+
+ | CastE(t,e) -> dprintf "CastE(@[%a,@?%a@])" self#pOnlyType t self#pExp e
+
+ | UnOp(u,e1,_) ->
+ dprintf "UnOp(@[%a,@?%a@])"
+ d_unop u self#pExp e1
+
+ | BinOp(b,e1,e2,_) ->
+ let d_plainbinop () b =
+ match b with
+ PlusA -> text "PlusA"
+ | PlusPI -> text "PlusPI"
+ | IndexPI -> text "IndexPI"
+ | MinusA -> text "MinusA"
+ | MinusPP -> text "MinusPP"
+ | MinusPI -> text "MinusPI"
+ | _ -> d_binop () b
+ in
+ dprintf "%a(@[%a,@?%a@])" d_plainbinop b
+ self#pExp e1 self#pExp e2
+
+ | SizeOf (t) ->
+ text "sizeof(" ++ self#pType None () t ++ chr ')'
+ | SizeOfE (e) ->
+ text "sizeofE(" ++ self#pExp () e ++ chr ')'
+ | SizeOfStr (s) ->
+ text "sizeofStr(" ++ d_const () (CStr s) ++ chr ')'
+ | AlignOf (t) ->
+ text "__alignof__(" ++ self#pType None () t ++ chr ')'
+ | AlignOfE (e) ->
+ text "__alignof__(" ++ self#pExp () e ++ chr ')'
+
+ | StartOf lv -> dprintf "StartOf(%a)" self#pLval lv
+ | AddrOf (lv) -> dprintf "AddrOf(%a)" self#pLval lv
+
+
+
+ method private d_plainoffset () = function
+ NoOffset -> text "NoOffset"
+ | Field(fi,o) ->
+ dprintf "Field(@[%s:%a,@?%a@])"
+ fi.fname self#pOnlyType fi.ftype self#d_plainoffset o
+ | Index(e, o) ->
+ dprintf "Index(@[%a,@?%a@])" self#pExp e self#d_plainoffset o
+
+ method pInit () = function
+ SingleInit e -> dprintf "SI(%a)" d_exp e
+ | CompoundInit (t, initl) ->
+ let d_plainoneinit (o, i) =
+ self#d_plainoffset () o ++ text " = " ++ self#pInit () i
+ in
+ dprintf "CI(@[%a,@?%a@])" self#pOnlyType t
+ (docList ~sep:(chr ',' ++ break) d_plainoneinit) initl
+(*
+ | ArrayInit (t, len, initl) ->
+ let idx = ref (- 1) in
+ let d_plainoneinit i =
+ incr idx;
+ text "[" ++ num !idx ++ text "] = " ++ self#pInit () i
+ in
+ dprintf "AI(@[%a,%d,@?%a@])" self#pOnlyType t len
+ (docList ~sep:(chr ',' ++ break) d_plainoneinit) initl
+*)
+ method pLval () (lv: lval) =
+ match lv with
+ | Var vi, o -> dprintf "Var(@[%s,@?%a@])" vi.vname self#d_plainoffset o
+ | Mem e, o -> dprintf "Mem(@[%a,@?%a@])" self#pExp e self#d_plainoffset o
+
+
+end
+let plainCilPrinter = new plainCilPrinterClass
+
+(* And now some shortcuts *)
+let d_plainexp () e = plainCilPrinter#pExp () e
+let d_plaintype () t = plainCilPrinter#pType None () t
+let d_plaininit () i = plainCilPrinter#pInit () i
+let d_plainlval () l = plainCilPrinter#pLval () l
+
+(* zra: this allows pretty printers not in cil.ml to
+ be exposed to cilmain.ml *)
+let printerForMaincil = ref defaultCilPrinter
+
+let rec d_typsig () = function
+ TSArray (ts, eo, al) ->
+ dprintf "TSArray(@[%a,@?%a,@?%a@])"
+ d_typsig ts
+ insert (text (match eo with None -> "None"
+ | Some e -> "Some " ^ Int64.to_string e))
+ d_attrlist al
+ | TSPtr (ts, al) ->
+ dprintf "TSPtr(@[%a,@?%a@])"
+ d_typsig ts d_attrlist al
+ | TSComp (iss, name, al) ->
+ dprintf "TSComp(@[%s %s,@?%a@])"
+ (if iss then "struct" else "union") name
+ d_attrlist al
+ | TSFun (rt, args, isva, al) ->
+ dprintf "TSFun(@[%a,@?%a,%b,@?%a@])"
+ d_typsig rt
+ (docList ~sep:(chr ',' ++ break) (d_typsig ())) args isva
+ d_attrlist al
+ | TSEnum (n, al) ->
+ dprintf "TSEnum(@[%s,@?%a@])"
+ n d_attrlist al
+ | TSBase t -> dprintf "TSBase(%a)" d_type t
+
+
+let newVID () =
+ let t = !nextGlobalVID in
+ incr nextGlobalVID;
+ t
+
+ (* Make a varinfo. Used mostly as a helper function below *)
+let makeVarinfo global name typ =
+ (* Strip const from type for locals *)
+ let vi =
+ { vname = name;
+ vid = newVID ();
+ vglob = global;
+ vtype = if global then typ else typeRemoveAttributes ["const"] typ;
+ vdecl = lu;
+ vinline = false;
+ vattr = [];
+ vstorage = NoStorage;
+ vaddrof = false;
+ vreferenced = false; (* sm *)
+ } in
+ vi
+
+let copyVarinfo (vi: varinfo) (newname: string) : varinfo =
+ let vi' = {vi with vname = newname; vid = newVID () } in
+ vi'
+
+let makeLocal fdec name typ = (* a helper function *)
+ fdec.smaxid <- 1 + fdec.smaxid;
+ let vi = makeVarinfo false name typ in
+ vi
+
+ (* Make a local variable and add it to a function *)
+let makeLocalVar fdec ?(insert = true) name typ =
+ let vi = makeLocal fdec name typ in
+ if insert then fdec.slocals <- fdec.slocals @ [vi];
+ vi
+
+
+let makeTempVar fdec ?(name = "__cil_tmp") typ : varinfo =
+ let name = name ^ (string_of_int (1 + fdec.smaxid)) in
+ makeLocalVar fdec name typ
+
+
+ (* Set the formals and re-create the function name based on the information*)
+let setFormals (f: fundec) (forms: varinfo list) =
+ f.sformals <- forms; (* Set the formals *)
+ match unrollType f.svar.vtype with
+ TFun(rt, _, isva, fa) ->
+ f.svar.vtype <-
+ TFun(rt,
+ Some (List.map (fun a -> (a.vname, a.vtype, a.vattr)) forms),
+ isva, fa)
+ | _ -> E.s (E.bug "Set formals. %s does not have function type\n"
+ f.svar.vname)
+
+ (* Set the types of arguments and results as given by the function type
+ * passed as the second argument *)
+let setFunctionType (f: fundec) (t: typ) =
+ match unrollType t with
+ TFun (rt, Some args, va, a) ->
+ if List.length f.sformals <> List.length args then
+ E.s (E.bug "setFunctionType: number of arguments differs from the number of formals");
+ (* Change the function type. *)
+ f.svar.vtype <- t;
+ (* Change the sformals and we know that indirectly we'll change the
+ * function type *)
+ List.iter2
+ (fun (an,at,aa) f ->
+ f.vtype <- at; f.vattr <- aa)
+ args f.sformals
+
+ | _ -> E.s (E.bug "setFunctionType: not a function type")
+
+
+ (* Set the types of arguments and results as given by the function type
+ * passed as the second argument *)
+let setFunctionTypeMakeFormals (f: fundec) (t: typ) =
+ match unrollType t with
+ TFun (rt, Some args, va, a) ->
+ if f.sformals <> [] then
+ E.s (E.warn "setFunctionTypMakeFormals called on function %s with some formals already"
+ f.svar.vname);
+ (* Change the function type. *)
+ f.svar.vtype <- t;
+ f.sformals <- [];
+
+ f.sformals <- List.map (fun (n,t,a) -> makeLocal f n t) args;
+
+ setFunctionType f t
+
+ | _ -> E.s (E.bug "setFunctionTypeMakeFormals: not a function type: %a"
+ d_type t)
+
+
+let setMaxId (f: fundec) =
+ f.smaxid <- List.length f.sformals + List.length f.slocals
+
+
+ (* Make a formal variable for a function. Insert it in both the sformals
+ * and the type of the function. You can optionally specify where to insert
+ * this one. If where = "^" then it is inserted first. If where = "$" then
+ * it is inserted last. Otherwise where must be the name of a formal after
+ * which to insert this. By default it is inserted at the end. *)
+let makeFormalVar fdec ?(where = "$") name typ : varinfo =
+ (* Search for the insertion place *)
+ let thenewone = ref fdec.svar in (* Just a placeholder *)
+ let makeit () : varinfo =
+ let vi = makeLocal fdec name typ in
+ thenewone := vi;
+ vi
+ in
+ let rec loopFormals = function
+ [] ->
+ if where = "$" then [makeit ()]
+ else E.s (E.error "makeFormalVar: cannot find insert-after formal %s"
+ where)
+ | f :: rest when f.vname = where -> f :: makeit () :: rest
+ | f :: rest -> f :: loopFormals rest
+ in
+ let newformals =
+ if where = "^" then makeit () :: fdec.sformals else
+ loopFormals fdec.sformals in
+ setFormals fdec newformals;
+ !thenewone
+
+ (* Make a global variable. Your responsibility to make sure that the name
+ * is unique *)
+let makeGlobalVar name typ =
+ let vi = makeVarinfo true name typ in
+ vi
+
+
+ (* Make an empty function *)
+let emptyFunction name =
+ { svar = makeGlobalVar name (TFun(voidType, Some [], false,[]));
+ smaxid = 0;
+ slocals = [];
+ sformals = [];
+ sbody = mkBlock [];
+ smaxstmtid = None;
+ sallstmts = [];
+ }
+
+
+
+ (* A dummy function declaration handy for initialization *)
+let dummyFunDec = emptyFunction "@dummy"
+let dummyFile =
+ { globals = [];
+ fileName = "<dummy>";
+ globinit = None;
+ globinitcalled = false;}
+
+let saveBinaryFile (cil_file : file) (filename : string) =
+ let outchan = open_out_bin filename in
+ Marshal.to_channel outchan cil_file [] ;
+ close_out outchan
+
+let saveBinaryFileChannel (cil_file : file) (outchan : out_channel) =
+ Marshal.to_channel outchan cil_file []
+
+let loadBinaryFile (filename : string) : file =
+ let inchan = open_in_bin filename in
+ let cil_file = (Marshal.from_channel inchan : file) in
+ close_in inchan ;
+ cil_file
+
+
+(* Take the name of a file and make a valid symbol name out of it. There are
+ * a few chanracters that are not valid in symbols *)
+let makeValidSymbolName (s: string) =
+ let s = String.copy s in (* So that we can update in place *)
+ let l = String.length s in
+ for i = 0 to l - 1 do
+ let c = String.get s i in
+ let isinvalid =
+ match c with
+ '-' | '.' -> true
+ | _ -> false
+ in
+ if isinvalid then
+ String.set s i '_';
+ done;
+ s
+
+
+(*** Define the visiting engine ****)
+(* visit all the nodes in a Cil expression *)
+let doVisit (vis: cilVisitor)
+ (startvisit: 'a -> 'a visitAction)
+ (children: cilVisitor -> 'a -> 'a)
+ (node: 'a) : 'a =
+ let action = startvisit node in
+ match action with
+ SkipChildren -> node
+ | ChangeTo node' -> node'
+ | _ -> (* DoChildren and ChangeDoChildrenPost *)
+ let nodepre = match action with
+ ChangeDoChildrenPost (node', _) -> node'
+ | _ -> node
+ in
+ let nodepost = children vis nodepre in
+ match action with
+ ChangeDoChildrenPost (_, f) -> f nodepost
+ | _ -> nodepost
+
+(* mapNoCopy is like map but avoid copying the list if the function does not
+ * change the elements. *)
+let rec mapNoCopy (f: 'a -> 'a) = function
+ [] -> []
+ | (i :: resti) as li ->
+ let i' = f i in
+ let resti' = mapNoCopy f resti in
+ if i' != i || resti' != resti then i' :: resti' else li
+
+let rec mapNoCopyList (f: 'a -> 'a list) = function
+ [] -> []
+ | (i :: resti) as li ->
+ let il' = f i in
+ let resti' = mapNoCopyList f resti in
+ match il' with
+ [i'] when i' == i && resti' == resti -> li
+ | _ -> il' @ resti'
+
+(* A visitor for lists *)
+let doVisitList (vis: cilVisitor)
+ (startvisit: 'a -> 'a list visitAction)
+ (children: cilVisitor -> 'a -> 'a)
+ (node: 'a) : 'a list =
+ let action = startvisit node in
+ match action with
+ SkipChildren -> [node]
+ | ChangeTo nodes' -> nodes'
+ | _ ->
+ let nodespre = match action with
+ ChangeDoChildrenPost (nodespre, _) -> nodespre
+ | _ -> [node]
+ in
+ let nodespost = mapNoCopy (children vis) nodespre in
+ match action with
+ ChangeDoChildrenPost (_, f) -> f nodespost
+ | _ -> nodespost
+
+let debugVisit = false
+
+let rec visitCilExpr (vis: cilVisitor) (e: exp) : exp =
+ doVisit vis vis#vexpr childrenExp e
+and childrenExp (vis: cilVisitor) (e: exp) : exp =
+ let vExp e = visitCilExpr vis e in
+ let vTyp t = visitCilType vis t in
+ let vLval lv = visitCilLval vis lv in
+ match e with
+ | Const (CEnum(v, s, ei)) ->
+ let v' = vExp v in
+ if v' != v then Const (CEnum(v', s, ei)) else e
+
+ | Const _ -> e
+ | SizeOf t ->
+ let t'= vTyp t in
+ if t' != t then SizeOf t' else e
+ | SizeOfE e1 ->
+ let e1' = vExp e1 in
+ if e1' != e1 then SizeOfE e1' else e
+ | SizeOfStr s -> e
+
+ | AlignOf t ->
+ let t' = vTyp t in
+ if t' != t then AlignOf t' else e
+ | AlignOfE e1 ->
+ let e1' = vExp e1 in
+ if e1' != e1 then AlignOfE e1' else e
+ | Lval lv ->
+ let lv' = vLval lv in
+ if lv' != lv then Lval lv' else e
+ | UnOp (uo, e1, t) ->
+ let e1' = vExp e1 in let t' = vTyp t in
+ if e1' != e1 || t' != t then UnOp(uo, e1', t') else e
+ | BinOp (bo, e1, e2, t) ->
+ let e1' = vExp e1 in let e2' = vExp e2 in let t' = vTyp t in
+ if e1' != e1 || e2' != e2 || t' != t then BinOp(bo, e1',e2',t') else e
+ | CastE (t, e1) ->
+ let t' = vTyp t in let e1' = vExp e1 in
+ if t' != t || e1' != e1 then CastE(t', e1') else e
+ | AddrOf lv ->
+ let lv' = vLval lv in
+ if lv' != lv then AddrOf lv' else e
+ | StartOf lv ->
+ let lv' = vLval lv in
+ if lv' != lv then StartOf lv' else e
+
+and visitCilInit (vis: cilVisitor) (i: init) : init =
+ doVisit vis vis#vinit childrenInit i
+and childrenInit (vis: cilVisitor) (i: init) : init =
+ let fExp e = visitCilExpr vis e in
+ let fInit i = visitCilInit vis i in
+ let fTyp t = visitCilType vis t in
+ match i with
+ | SingleInit e ->
+ let e' = fExp e in
+ if e' != e then SingleInit e' else i
+ | CompoundInit (t, initl) ->
+ let t' = fTyp t in
+ (* Collect the new initializer list, in reverse. We prefer two
+ * traversals to ensure tail-recursion. *)
+ let newinitl : (offset * init) list ref = ref [] in
+ (* Keep track whether the list has changed *)
+ let hasChanged = ref false in
+ let doOneInit ((o, i) as oi) =
+ let o' = visitCilInitOffset vis o in (* use initializer version *)
+ let i' = fInit i in
+ let newio =
+ if o' != o || i' != i then
+ begin hasChanged := true; (o', i') end else oi
+ in
+ newinitl := newio :: !newinitl
+ in
+ List.iter doOneInit initl;
+ let initl' = if !hasChanged then List.rev !newinitl else initl in
+ if t' != t || initl' != initl then CompoundInit (t', initl') else i
+
+and visitCilLval (vis: cilVisitor) (lv: lval) : lval =
+ doVisit vis vis#vlval childrenLval lv
+and childrenLval (vis: cilVisitor) (lv: lval) : lval =
+ (* and visit its subexpressions *)
+ let vExp e = visitCilExpr vis e in
+ let vOff off = visitCilOffset vis off in
+ match lv with
+ Var v, off ->
+ let v' = doVisit vis vis#vvrbl (fun _ x -> x) v in
+ let off' = vOff off in
+ if v' != v || off' != off then Var v', off' else lv
+ | Mem e, off ->
+ let e' = vExp e in
+ let off' = vOff off in
+ if e' != e || off' != off then Mem e', off' else lv
+
+and visitCilOffset (vis: cilVisitor) (off: offset) : offset =
+ doVisit vis vis#voffs childrenOffset off
+and childrenOffset (vis: cilVisitor) (off: offset) : offset =
+ let vOff off = visitCilOffset vis off in
+ match off with
+ Field (f, o) ->
+ let o' = vOff o in
+ if o' != o then Field (f, o') else off
+ | Index (e, o) ->
+ let e' = visitCilExpr vis e in
+ let o' = vOff o in
+ if e' != e || o' != o then Index (e', o') else off
+ | NoOffset -> off
+
+(* sm: for offsets in initializers, the 'startvisit' will be the
+ * vinitoffs method, but we can re-use the childrenOffset from
+ * above since recursive offsets are visited by voffs. (this point
+ * is moot according to cil.mli which claims the offsets in
+ * initializers will never recursively contain offsets)
+ *)
+and visitCilInitOffset (vis: cilVisitor) (off: offset) : offset =
+ doVisit vis vis#vinitoffs childrenOffset off
+
+and visitCilInstr (vis: cilVisitor) (i: instr) : instr list =
+ let oldloc = !currentLoc in
+ currentLoc := (get_instrLoc i);
+ assertEmptyQueue vis;
+ let res = doVisitList vis vis#vinst childrenInstr i in
+ currentLoc := oldloc;
+ (* See if we have accumulated some instructions *)
+ vis#unqueueInstr () @ res
+
+and childrenInstr (vis: cilVisitor) (i: instr) : instr =
+ let fExp = visitCilExpr vis in
+ let fLval = visitCilLval vis in
+ match i with
+ | Set(lv,e,l) ->
+ let lv' = fLval lv in let e' = fExp e in
+ if lv' != lv || e' != e then Set(lv',e',l) else i
+ | Call(None,f,args,l) ->
+ let f' = fExp f in let args' = mapNoCopy fExp args in
+ if f' != f || args' != args then Call(None,f',args',l) else i
+ | Call(Some lv,fn,args,l) ->
+ let lv' = fLval lv in let fn' = fExp fn in
+ let args' = mapNoCopy fExp args in
+ if lv' != lv || fn' != fn || args' != args
+ then Call(Some lv', fn', args', l) else i
+
+ | Asm(sl,isvol,outs,ins,clobs,l) ->
+ let outs' = mapNoCopy (fun ((s,lv) as pair) ->
+ let lv' = fLval lv in
+ if lv' != lv then (s,lv') else pair) outs in
+ let ins' = mapNoCopy (fun ((s,e) as pair) ->
+ let e' = fExp e in
+ if e' != e then (s,e') else pair) ins in
+ if outs' != outs || ins' != ins then
+ Asm(sl,isvol,outs',ins',clobs,l) else i
+
+
+(* visit all nodes in a Cil statement tree in preorder *)
+and visitCilStmt (vis: cilVisitor) (s: stmt) : stmt =
+ let oldloc = !currentLoc in
+ currentLoc := (get_stmtLoc s.skind) ;
+ assertEmptyQueue vis;
+ let toPrepend : instr list ref = ref [] in (* childrenStmt may add to this *)
+ let res = doVisit vis vis#vstmt (childrenStmt toPrepend) s in
+ (* Now see if we have saved some instructions *)
+ toPrepend := !toPrepend @ vis#unqueueInstr ();
+ (match !toPrepend with
+ [] -> () (* Return the same statement *)
+ | _ ->
+ (* Make our statement contain the instructions to prepend *)
+ res.skind <- Block { battrs = []; bstmts = [ mkStmt (Instr !toPrepend);
+ mkStmt res.skind ] });
+ currentLoc := oldloc;
+ res
+
+and childrenStmt (toPrepend: instr list ref) (vis:cilVisitor) (s:stmt): stmt =
+ let fExp e = (visitCilExpr vis e) in
+ let fBlock b = visitCilBlock vis b in
+ let fInst i = visitCilInstr vis i in
+ (* Just change the statement kind *)
+ let skind' =
+ match s.skind with
+ Break _ | Continue _ | Goto _ | Return (None, _) -> s.skind
+ | Return (Some e, l) ->
+ let e' = fExp e in
+ if e' != e then Return (Some e', l) else s.skind
+(*
+ | Loop (b, l, s1, s2) ->
+ let b' = fBlock b in
+ if b' != b then Loop (b', l, s1, s2) else s.skind
+*)
+ | While (e, b, l) ->
+ let e' = fExp e in
+ let b' = fBlock b in
+ if e' != e || b' != b then While (e', b', l) else s.skind
+ | DoWhile (e, b, l) ->
+ let b' = fBlock b in
+ let e' = fExp e in
+ if e' != e || b' != b then DoWhile (e', b', l) else s.skind
+ | For (bInit, e, bIter, b, l) ->
+ let bInit' = fBlock bInit in
+ let e' = fExp e in
+ let bIter' = fBlock bIter in
+ let b' = fBlock b in
+ if bInit' != bInit || e' != e || bIter' != bIter || b' != b then
+ For (bInit', e', bIter', b', l) else s.skind
+ | If(e, s1, s2, l) ->
+ let e' = fExp e in
+ (*if e queued any instructions, pop them here and remember them so that
+ they are inserted before the If stmt, not in the then block. *)
+ toPrepend := vis#unqueueInstr ();
+ let s1'= fBlock s1 in let s2'= fBlock s2 in
+ (* the stmts in the blocks should have cleaned up after themselves.*)
+ assertEmptyQueue vis;
+ if e' != e || s1' != s1 || s2' != s2 then
+ If(e', s1', s2', l) else s.skind
+ | Switch (e, b, stmts, l) ->
+ let e' = fExp e in
+ toPrepend := vis#unqueueInstr (); (* insert these before the switch *)
+ let b' = fBlock b in
+ (* the stmts in b should have cleaned up after themselves.*)
+ assertEmptyQueue vis;
+ (* Don't do stmts, but we better not change those *)
+ if e' != e || b' != b then Switch (e', b', stmts, l) else s.skind
+ | Instr il ->
+ let il' = mapNoCopyList fInst il in
+ if il' != il then Instr il' else s.skind
+ | Block b ->
+ let b' = fBlock b in
+ if b' != b then Block b' else s.skind
+ | TryFinally (b, h, l) ->
+ let b' = fBlock b in
+ let h' = fBlock h in
+ if b' != b || h' != h then TryFinally(b', h', l) else s.skind
+ | TryExcept (b, (il, e), h, l) ->
+ let b' = fBlock b in
+ assertEmptyQueue vis;
+ (* visit the instructions *)
+ let il' = mapNoCopyList fInst il in
+ (* Visit the expression *)
+ let e' = fExp e in
+ let il'' =
+ let more = vis#unqueueInstr () in
+ if more != [] then
+ il' @ more
+ else
+ il'
+ in
+ let h' = fBlock h in
+ (* Now collect the instructions *)
+ if b' != b || il'' != il || e' != e || h' != h then
+ TryExcept(b', (il'', e'), h', l)
+ else s.skind
+ in
+ if skind' != s.skind then s.skind <- skind';
+ (* Visit the labels *)
+ let labels' =
+ let fLabel = function
+ Case (e, l) as lb ->
+ let e' = fExp e in
+ if e' != e then Case (e', l) else lb
+ | lb -> lb
+ in
+ mapNoCopy fLabel s.labels
+ in
+ if labels' != s.labels then s.labels <- labels';
+ s
+
+
+
+and visitCilBlock (vis: cilVisitor) (b: block) : block =
+ doVisit vis vis#vblock childrenBlock b
+and childrenBlock (vis: cilVisitor) (b: block) : block =
+ let fStmt s = visitCilStmt vis s in
+ let stmts' = mapNoCopy fStmt b.bstmts in
+ if stmts' != b.bstmts then { battrs = b.battrs; bstmts = stmts'} else b
+
+
+and visitCilType (vis : cilVisitor) (t : typ) : typ =
+ doVisit vis vis#vtype childrenType t
+and childrenType (vis : cilVisitor) (t : typ) : typ =
+ (* look for types referred to inside t's definition *)
+ let fTyp t = visitCilType vis t in
+ let fAttr a = visitCilAttributes vis a in
+ match t with
+ TPtr(t1, a) ->
+ let t1' = fTyp t1 in
+ let a' = fAttr a in
+ if t1' != t || a' != a then TPtr(t1', a') else t
+ | TArray(t1, None, a) ->
+ let t1' = fTyp t1 in
+ let a' = fAttr a in
+ if t1' != t || a' != a then TArray(t1', None, a') else t
+ | TArray(t1, Some e, a) ->
+ let t1' = fTyp t1 in
+ let e' = visitCilExpr vis e in
+ let a' = fAttr a in
+ if t1' != t || e' != e || a' != a then TArray(t1', Some e', a') else t
+
+ (* DON'T recurse into the compinfo, this is done in visitCilGlobal.
+ User can iterate over cinfo.cfields manually, if desired.*)
+ | TComp(cinfo, a) ->
+ let a' = fAttr a in
+ if a != a' then TComp(cinfo, a') else t
+
+ | TFun(rettype, args, isva, a) ->
+ let rettype' = fTyp rettype in
+ (* iterate over formals, as variable declarations *)
+ let argslist = argsToList args in
+ let visitArg ((an,at,aa) as arg) =
+ let at' = fTyp at in
+ let aa' = fAttr aa in
+ if at' != at || aa' != aa then (an,at',aa') else arg
+ in
+ let argslist' = mapNoCopy visitArg argslist in
+ let a' = fAttr a in
+ if rettype' != rettype || argslist' != argslist || a' != a then
+ let args' = if argslist' == argslist then args else Some argslist' in
+ TFun(rettype', args', isva, a') else t
+
+ | TNamed(t1, a) -> (* Do not go into the type. Will do it at the time of
+ * GType *)
+ let a' = fAttr a in
+ if a' != a then TNamed (t1, a') else t
+
+ | _ -> (* other types (TVoid, TInt, TFloat, TEnum, and TBuiltin_va_list)
+ don't contain nested types, but they do have attributes. *)
+ let a = typeAttrs t in
+ let a' = fAttr a in
+ if a' != a then setTypeAttrs t a' else t
+
+
+(* for declarations, we visit the types inside; but for uses, *)
+(* we just visit the varinfo node *)
+and visitCilVarDecl (vis : cilVisitor) (v : varinfo) : varinfo =
+ doVisit vis vis#vvdec childrenVarDecl v
+and childrenVarDecl (vis : cilVisitor) (v : varinfo) : varinfo =
+ v.vtype <- visitCilType vis v.vtype;
+ v.vattr <- visitCilAttributes vis v.vattr;
+ v
+
+and visitCilAttributes (vis: cilVisitor) (al: attribute list) : attribute list=
+ let al' =
+ mapNoCopyList (doVisitList vis vis#vattr childrenAttribute) al in
+ if al' != al then
+ (* Must re-sort *)
+ addAttributes al' []
+ else
+ al
+and childrenAttribute (vis: cilVisitor) (a: attribute) : attribute =
+ let fAttrP a = visitCilAttrParams vis a in
+ match a with
+ Attr (n, args) ->
+ let args' = mapNoCopy fAttrP args in
+ if args' != args then Attr(n, args') else a
+
+
+and visitCilAttrParams (vis: cilVisitor) (a: attrparam) : attrparam =
+ doVisit vis vis#vattrparam childrenAttrparam a
+and childrenAttrparam (vis: cilVisitor) (aa: attrparam) : attrparam =
+ let fTyp t = visitCilType vis t in
+ let fAttrP a = visitCilAttrParams vis a in
+ match aa with
+ AInt _ | AStr _ -> aa
+ | ACons(n, args) ->
+ let args' = mapNoCopy fAttrP args in
+ if args' != args then ACons(n, args') else aa
+ | ASizeOf t ->
+ let t' = fTyp t in
+ if t' != t then ASizeOf t' else aa
+ | ASizeOfE e ->
+ let e' = fAttrP e in
+ if e' != e then ASizeOfE e' else aa
+ | AAlignOf t ->
+ let t' = fTyp t in
+ if t' != t then AAlignOf t' else aa
+ | AAlignOfE e ->
+ let e' = fAttrP e in
+ if e' != e then AAlignOfE e' else aa
+ | ASizeOfS _ | AAlignOfS _ ->
+ ignore (warn "Visitor inside of a type signature.");
+ aa
+ | AUnOp (uo, e1) ->
+ let e1' = fAttrP e1 in
+ if e1' != e1 then AUnOp (uo, e1') else aa
+ | ABinOp (bo, e1, e2) ->
+ let e1' = fAttrP e1 in
+ let e2' = fAttrP e2 in
+ if e1' != e1 || e2' != e2 then ABinOp (bo, e1', e2') else aa
+ | ADot (ap, s) ->
+ let ap' = fAttrP ap in
+ if ap' != ap then ADot (ap', s) else aa
+
+
+let rec visitCilFunction (vis : cilVisitor) (f : fundec) : fundec =
+ if debugVisit then ignore (E.log "Visiting function %s\n" f.svar.vname);
+ assertEmptyQueue vis;
+ let f = doVisit vis vis#vfunc childrenFunction f in
+
+ let toPrepend = vis#unqueueInstr () in
+ if toPrepend <> [] then
+ f.sbody.bstmts <- mkStmt (Instr toPrepend) :: f.sbody.bstmts;
+ f
+
+and childrenFunction (vis : cilVisitor) (f : fundec) : fundec =
+ f.svar <- visitCilVarDecl vis f.svar; (* hit the function name *)
+ (* visit local declarations *)
+ f.slocals <- mapNoCopy (visitCilVarDecl vis) f.slocals;
+ (* visit the formals *)
+ let newformals = mapNoCopy (visitCilVarDecl vis) f.sformals in
+ (* Make sure the type reflects the formals *)
+ setFormals f newformals;
+ (* Remember any new instructions that were generated while visiting
+ variable declarations. *)
+ let toPrepend = vis#unqueueInstr () in
+
+ f.sbody <- visitCilBlock vis f.sbody; (* visit the body *)
+ if toPrepend <> [] then
+ f.sbody.bstmts <- mkStmt (Instr toPrepend) :: f.sbody.bstmts;
+ f
+
+let rec visitCilGlobal (vis: cilVisitor) (g: global) : global list =
+ (*(trace "visit" (dprintf "visitCilGlobal\n"));*)
+ let oldloc = !currentLoc in
+ currentLoc := (get_globalLoc g) ;
+ currentGlobal := g;
+ let res = doVisitList vis vis#vglob childrenGlobal g in
+ currentLoc := oldloc;
+ res
+and childrenGlobal (vis: cilVisitor) (g: global) : global =
+ match g with
+ | GFun (f, l) ->
+ let f' = visitCilFunction vis f in
+ if f' != f then GFun (f', l) else g
+ | GType(t, l) ->
+ t.ttype <- visitCilType vis t.ttype;
+ g
+
+ | GEnumTagDecl _ | GCompTagDecl _ -> g (* Nothing to visit *)
+ | GEnumTag (enum, _) ->
+ (trace "visit" (dprintf "visiting global enum %s\n" enum.ename));
+ (* Do the values and attributes of the enumerated items *)
+ let itemVisit (name, exp, loc) = (name, visitCilExpr vis exp, loc) in
+ enum.eitems <- mapNoCopy itemVisit enum.eitems;
+ enum.eattr <- visitCilAttributes vis enum.eattr;
+ g
+
+ | GCompTag (comp, _) ->
+ (trace "visit" (dprintf "visiting global comp %s\n" comp.cname));
+ (* Do the types and attirbutes of the fields *)
+ let fieldVisit = fun fi ->
+ fi.ftype <- visitCilType vis fi.ftype;
+ fi.fattr <- visitCilAttributes vis fi.fattr
+ in
+ List.iter fieldVisit comp.cfields;
+ comp.cattr <- visitCilAttributes vis comp.cattr;
+ g
+
+ | GVarDecl(v, l) ->
+ let v' = visitCilVarDecl vis v in
+ if v' != v then GVarDecl (v', l) else g
+ | GVar (v, inito, l) ->
+ let v' = visitCilVarDecl vis v in
+ (match inito.init with
+ None -> ()
+ | Some i -> let i' = visitCilInit vis i in
+ if i' != i then inito.init <- Some i');
+
+ if v' != v then GVar (v', inito, l) else g
+
+ | GPragma (a, l) -> begin
+ match visitCilAttributes vis [a] with
+ [a'] -> if a' != a then GPragma (a', l) else g
+ | _ -> E.s (E.unimp "visitCilAttributes returns more than one attribute")
+ end
+ | _ -> g
+
+
+(** A visitor that does constant folding. If "machdep" is true then we do
+ * machine dependent simplification (e.g., sizeof) *)
+class constFoldVisitorClass (machdep: bool) : cilVisitor = object
+ inherit nopCilVisitor
+
+ method vinst i =
+ match i with
+ (* Skip two functions to which we add Sizeof to the type arguments.
+ See the comments for these above. *)
+ Call(_,(Lval (Var vi,NoOffset)),_,_)
+ when ((vi.vname = "__builtin_va_arg")
+ || (vi.vname = "__builtin_types_compatible_p")) ->
+ SkipChildren
+ | _ -> DoChildren
+ method vexpr (e: exp) =
+ (* Do it bottom up *)
+ ChangeDoChildrenPost (e, constFold machdep)
+
+end
+let constFoldVisitor (machdep: bool) = new constFoldVisitorClass machdep
+
+(* Iterate over all globals, including the global initializer *)
+let iterGlobals (fl: file)
+ (doone: global -> unit) : unit =
+ let doone' g =
+ currentLoc := get_globalLoc g;
+ doone g
+ in
+ List.iter doone' fl.globals;
+ (match fl.globinit with
+ None -> ()
+ | Some g -> doone' (GFun(g, locUnknown)))
+
+(* Fold over all globals, including the global initializer *)
+let foldGlobals (fl: file)
+ (doone: 'a -> global -> 'a)
+ (acc: 'a) : 'a =
+ let doone' acc g =
+ currentLoc := get_globalLoc g;
+ doone acc g
+ in
+ let acc' = List.fold_left doone' acc fl.globals in
+ (match fl.globinit with
+ None -> acc'
+ | Some g -> doone' acc' (GFun(g, locUnknown)))
+
+
+(* A visitor for the whole file that does not change the globals *)
+let visitCilFileSameGlobals (vis : cilVisitor) (f : file) : unit =
+ let fGlob g = visitCilGlobal vis g in
+ iterGlobals f (fun g ->
+ match fGlob g with
+ [g'] when g' == g || Util.equals g' g -> () (* Try to do the pointer check first *)
+ | gl ->
+ ignore (E.log "You used visitCilFilSameGlobals but the global got changed:\n %a\nchanged to %a\n" d_global g (docList ~sep:line (d_global ())) gl);
+ ())
+
+(* Be careful with visiting the whole file because it might be huge. *)
+let visitCilFile (vis : cilVisitor) (f : file) : unit =
+ let fGlob g = visitCilGlobal vis g in
+ (* Scan the globals. Make sure this is tail recursive. *)
+ let rec loop (acc: global list) = function
+ [] -> f.globals <- List.rev acc
+ | g :: restg ->
+ loop ((List.rev (fGlob g)) @ acc) restg
+ in
+ loop [] f.globals;
+ (* the global initializer *)
+ (match f.globinit with
+ None -> ()
+ | Some g -> f.globinit <- Some (visitCilFunction vis g))
+
+
+
+(** Create or fetch the global initializer. Tries to put a call to in the the
+ * function with the main_name *)
+let getGlobInit ?(main_name="main") (fl: file) =
+ match fl.globinit with
+ Some f -> f
+ | None -> begin
+ (* Sadly, we cannot use the Filename library because it does not like
+ * function names with multiple . in them *)
+ let f =
+ let len = String.length fl.fileName in
+ (* Find the last path separator and record the first . that we see,
+ * going backwards *)
+ let lastDot = ref len in
+ let rec findLastPathSep i =
+ if i < 0 then -1 else
+ let c = String.get fl.fileName i in
+ if c = '/' || c = '\\' then i
+ else begin
+ if c = '.' && !lastDot = len then
+ lastDot := i;
+ findLastPathSep (i - 1)
+ end
+ in
+ let lastPathSep = findLastPathSep (len - 1) in
+ let basenoext =
+ String.sub fl.fileName (lastPathSep + 1) (!lastDot - lastPathSep - 1)
+ in
+ emptyFunction
+ (makeValidSymbolName ("__globinit_" ^ basenoext))
+ in
+ fl.globinit <- Some f;
+ (* Now try to add a call to the global initialized at the beginning of
+ * main *)
+ let inserted = ref false in
+ List.iter
+ (fun g ->
+ match g with
+ GFun(m, lm) when m.svar.vname = main_name ->
+ (* Prepend a prototype to the global initializer *)
+ fl.globals <- GVarDecl (f.svar, lm) :: fl.globals;
+ m.sbody.bstmts <-
+ compactStmts (mkStmt (Instr [Call(None,
+ Lval(var f.svar),
+ [], locUnknown)])
+ :: m.sbody.bstmts);
+ inserted := true;
+ if !E.verboseFlag then
+ ignore (E.log "Inserted the globinit\n");
+ fl.globinitcalled <- true;
+ | _ -> ())
+ fl.globals;
+
+ if not !inserted then
+ ignore (E.warn "Cannot find %s to add global initializer %s"
+ main_name f.svar.vname);
+
+ f
+ end
+
+
+
+(* Fold over all globals, including the global initializer *)
+let mapGlobals (fl: file)
+ (doone: global -> global) : unit =
+ fl.globals <- List.map doone fl.globals;
+ (match fl.globinit with
+ None -> ()
+ | Some g -> begin
+ match doone (GFun(g, locUnknown)) with
+ GFun(g', _) -> fl.globinit <- Some g'
+ | _ -> E.s (E.bug "mapGlobals: globinit is not a function")
+ end)
+
+
+
+let dumpFile (pp: cilPrinter) (out : out_channel) (outfile: string) file =
+ printDepth := 99999; (* We don't want ... in the output *)
+ (* If we are in RELEASE mode then we do not print indentation *)
+
+ Pretty.fastMode := true;
+
+ if !E.verboseFlag then
+ ignore (E.log "printing file %s\n" outfile);
+ let print x = fprint out 78 x in
+ print (text ("/* Generated by CIL v. " ^ cilVersion ^ " */\n" ^
+ (* sm: I want to easily tell whether the generated output
+ * is with print_CIL_Input or not *)
+ "/* print_CIL_Input is " ^ (if !print_CIL_Input then "true" else "false") ^ " */\n\n"));
+ iterGlobals file (fun g -> dumpGlobal pp out g);
+
+ (* sm: we have to flush the output channel; if we don't then under *)
+ (* some circumstances (I haven't figure out exactly when, but it happens *)
+ (* more often with big inputs), we get a truncated output file *)
+ flush out
+
+
+
+(******************
+ ******************
+ ******************)
+
+
+
+(******************** OPTIMIZATIONS *****)
+let rec peepHole1 (* Process one statement and possibly replace it *)
+ (doone: instr -> instr list option)
+ (* Scan a block and recurse inside nested blocks *)
+ (ss: stmt list) : unit =
+ let rec doInstrList (il: instr list) : instr list =
+ match il with
+ [] -> []
+ | i :: rest -> begin
+ match doone i with
+ None -> i :: doInstrList rest
+ | Some sl -> doInstrList (sl @ rest)
+ end
+ in
+
+ List.iter
+ (fun s ->
+ match s.skind with
+ Instr il -> s.skind <- Instr (doInstrList il)
+ | If (e, tb, eb, _) ->
+ peepHole1 doone tb.bstmts;
+ peepHole1 doone eb.bstmts
+ | Switch (e, b, _, _) -> peepHole1 doone b.bstmts
+(*
+ | Loop (b, l, _, _) -> peepHole1 doone b.bstmts
+*)
+ | While (_, b, _) -> peepHole1 doone b.bstmts
+ | DoWhile (_, b, _) -> peepHole1 doone b.bstmts
+ | For (bInit, _, bIter, b, _) ->
+ peepHole1 doone bInit.bstmts;
+ peepHole1 doone bIter.bstmts;
+ peepHole1 doone b.bstmts
+ | Block b -> peepHole1 doone b.bstmts
+ | TryFinally (b, h, l) ->
+ peepHole1 doone b.bstmts;
+ peepHole1 doone h.bstmts
+ | TryExcept (b, (il, e), h, l) ->
+ peepHole1 doone b.bstmts;
+ peepHole1 doone h.bstmts;
+ s.skind <- TryExcept(b, (doInstrList il, e), h, l);
+ | Return _ | Goto _ | Break _ | Continue _ -> ())
+ ss
+
+let rec peepHole2 (* Process two statements and possibly replace them both *)
+ (dotwo: instr * instr -> instr list option)
+ (ss: stmt list) : unit =
+ let rec doInstrList (il: instr list) : instr list =
+ match il with
+ [] -> []
+ | [i] -> [i]
+ | (i1 :: ((i2 :: rest) as rest2)) ->
+ begin
+ match dotwo (i1,i2) with
+ None -> i1 :: doInstrList rest2
+ | Some sl -> doInstrList (sl @ rest)
+ end
+ in
+ List.iter
+ (fun s ->
+ match s.skind with
+ Instr il -> s.skind <- Instr (doInstrList il)
+ | If (e, tb, eb, _) ->
+ peepHole2 dotwo tb.bstmts;
+ peepHole2 dotwo eb.bstmts
+ | Switch (e, b, _, _) -> peepHole2 dotwo b.bstmts
+(*
+ | Loop (b, l, _, _) -> peepHole2 dotwo b.bstmts
+*)
+ | While (_, b, _) -> peepHole2 dotwo b.bstmts
+ | DoWhile (_, b, _) -> peepHole2 dotwo b.bstmts
+ | For (bInit, _, bIter, b, _) ->
+ peepHole2 dotwo bInit.bstmts;
+ peepHole2 dotwo bIter.bstmts;
+ peepHole2 dotwo b.bstmts
+ | Block b -> peepHole2 dotwo b.bstmts
+ | TryFinally (b, h, l) -> peepHole2 dotwo b.bstmts;
+ peepHole2 dotwo h.bstmts
+ | TryExcept (b, (il, e), h, l) ->
+ peepHole2 dotwo b.bstmts;
+ peepHole2 dotwo h.bstmts;
+ s.skind <- TryExcept (b, (doInstrList il, e), h, l)
+
+ | Return _ | Goto _ | Break _ | Continue _ -> ())
+ ss
+
+
+
+
+(*** Type signatures ***)
+
+(* Helper class for typeSig: replace any types in attributes with typsigs *)
+class typeSigVisitor(typeSigConverter: typ->typsig) = object
+ inherit nopCilVisitor
+ method vattrparam ap =
+ match ap with
+ | ASizeOf t -> ChangeTo (ASizeOfS (typeSigConverter t))
+ | AAlignOf t -> ChangeTo (AAlignOfS (typeSigConverter t))
+ | _ -> DoChildren
+end
+
+let typeSigAddAttrs a0 t =
+ if a0 == [] then t else
+ match t with
+ TSBase t -> TSBase (typeAddAttributes a0 t)
+ | TSPtr (ts, a) -> TSPtr (ts, addAttributes a0 a)
+ | TSArray (ts, l, a) -> TSArray(ts, l, addAttributes a0 a)
+ | TSComp (iss, n, a) -> TSComp (iss, n, addAttributes a0 a)
+ | TSEnum (n, a) -> TSEnum (n, addAttributes a0 a)
+ | TSFun(ts, tsargs, isva, a) -> TSFun(ts, tsargs, isva, addAttributes a0 a)
+
+(* Compute a type signature.
+ Use ~ignoreSign:true to convert all signed integer types to unsigned,
+ so that signed and unsigned will compare the same. *)
+let rec typeSigWithAttrs ?(ignoreSign=false) doattr t =
+ let typeSig = typeSigWithAttrs ~ignoreSign doattr in
+ let attrVisitor = new typeSigVisitor typeSig in
+ let doattr al = visitCilAttributes attrVisitor (doattr al) in
+ match t with
+ | TInt (ik, al) ->
+ let ik' = if ignoreSign then begin
+ match ik with
+ | ISChar | IChar -> IUChar
+ | IShort -> IUShort
+ | IInt -> IUInt
+ | ILong -> IULong
+ | ILongLong -> IULongLong
+ | _ -> ik
+ end else
+ ik
+ in
+ TSBase (TInt (ik', doattr al))
+ | TFloat (fk, al) -> TSBase (TFloat (fk, doattr al))
+ | TVoid al -> TSBase (TVoid (doattr al))
+ | TEnum (enum, a) -> TSEnum (enum.ename, doattr a)
+ | TPtr (t, a) -> TSPtr (typeSig t, doattr a)
+ | TArray (t,l,a) -> (* We do not want fancy expressions in array lengths.
+ * So constant fold the lengths *)
+ let l' =
+ match l with
+ Some l -> begin
+ match constFold true l with
+ Const(CInt64(i, _, _)) -> Some i
+ | e -> E.s (E.bug "Invalid length in array type: %a\n"
+ (!pd_exp) e)
+ end
+ | None -> None
+ in
+ TSArray(typeSig t, l', doattr a)
+
+ | TComp (comp, a) ->
+ TSComp (comp.cstruct, comp.cname, doattr (addAttributes comp.cattr a))
+ | TFun(rt,args,isva,a) ->
+ TSFun(typeSig rt,
+ List.map (fun (_, atype, _) -> (typeSig atype)) (argsToList args),
+ isva, doattr a)
+ | TNamed(t, a) -> typeSigAddAttrs (doattr a) (typeSig t.ttype)
+ | TBuiltin_va_list al -> TSBase (TBuiltin_va_list (doattr al))
+
+let typeSig t =
+ typeSigWithAttrs (fun al -> al) t
+
+let _ = pTypeSig := typeSig
+
+(* Remove the attribute from the top-level of the type signature *)
+let setTypeSigAttrs (a: attribute list) = function
+ TSBase t -> TSBase (setTypeAttrs t a)
+ | TSPtr (ts, _) -> TSPtr (ts, a)
+ | TSArray (ts, l, _) -> TSArray(ts, l, a)
+ | TSComp (iss, n, _) -> TSComp (iss, n, a)
+ | TSEnum (n, _) -> TSEnum (n, a)
+ | TSFun (ts, tsargs, isva, _) -> TSFun (ts, tsargs, isva, a)
+
+
+let typeSigAttrs = function
+ TSBase t -> typeAttrs t
+ | TSPtr (ts, a) -> a
+ | TSArray (ts, l, a) -> a
+ | TSComp (iss, n, a) -> a
+ | TSEnum (n, a) -> a
+ | TSFun (ts, tsargs, isva, a) -> a
+
+
+
+let dExp: doc -> exp =
+ fun d -> Const(CStr(sprint !lineLength d))
+
+let dInstr: doc -> location -> instr =
+ fun d l -> Asm([], [sprint !lineLength d], [], [], [], l)
+
+let dGlobal: doc -> location -> global =
+ fun d l -> GAsm(sprint !lineLength d, l)
+
+let rec addOffset (toadd: offset) (off: offset) : offset =
+ match off with
+ NoOffset -> toadd
+ | Field(fid', offset) -> Field(fid', addOffset toadd offset)
+ | Index(e, offset) -> Index(e, addOffset toadd offset)
+
+ (* Add an offset at the end of an lv *)
+let addOffsetLval toadd (b, off) : lval =
+ b, addOffset toadd off
+
+let rec removeOffset (off: offset) : offset * offset =
+ match off with
+ NoOffset -> NoOffset, NoOffset
+ | Field(f, NoOffset) -> NoOffset, off
+ | Index(i, NoOffset) -> NoOffset, off
+ | Field(f, restoff) ->
+ let off', last = removeOffset restoff in
+ Field(f, off'), last
+ | Index(i, restoff) ->
+ let off', last = removeOffset restoff in
+ Index(i, off'), last
+
+let removeOffsetLval ((b, off): lval) : lval * offset =
+ let off', last = removeOffset off in
+ (b, off'), last
+
+ (* Make an AddrOf. Given an lval of type T will give back an expression of
+ * type ptr(T) *)
+let mkAddrOf ((b, off) as lval) : exp =
+ (* Never take the address of a register variable *)
+ (match lval with
+ Var vi, off when vi.vstorage = Register -> vi.vstorage <- NoStorage
+ | _ -> ());
+ match lval with
+ Mem e, NoOffset -> e
+ | b, Index(z, NoOffset) when isZero z -> StartOf (b, NoOffset)(* array *)
+ | _ -> AddrOf lval
+
+
+let mkAddrOrStartOf (lv: lval) : exp =
+ match unrollType (typeOfLval lv) with
+ TArray _ -> StartOf lv
+ | _ -> mkAddrOf lv
+
+
+ (* Make a Mem, while optimizing AddrOf. The type of the addr must be
+ * TPtr(t) and the type of the resulting lval is t. Note that in CIL the
+ * implicit conversion between a function and a pointer to a function does
+ * not apply. You must do the conversion yourself using AddrOf *)
+let mkMem ~(addr: exp) ~(off: offset) : lval =
+ let res =
+ match addr, off with
+ AddrOf lv, _ -> addOffsetLval off lv
+ | StartOf lv, _ -> (* Must be an array *)
+ addOffsetLval (Index(zero, off)) lv
+ | _, _ -> Mem addr, off
+ in
+(* ignore (E.log "memof : %a:%a\nresult = %a\n"
+ d_plainexp addr d_plainoffset off d_plainexp res); *)
+ res
+
+
+
+let splitFunctionType (ftype: typ)
+ : typ * (string * typ * attributes) list option * bool * attributes =
+ match unrollType ftype with
+ TFun (rt, args, isva, a) -> rt, args, isva, a
+ | _ -> E.s (bug "splitFunctionType invoked on a non function type %a"
+ d_type ftype)
+
+let splitFunctionTypeVI (fvi: varinfo)
+ : typ * (string * typ * attributes) list option * bool * attributes =
+ match unrollType fvi.vtype with
+ TFun (rt, args, isva, a) -> rt, args, isva, a
+ | _ -> E.s (bug "Function %s invoked on a non function type" fvi.vname)
+
+let isArrayType t =
+ match unrollType t with
+ TArray _ -> true
+ | _ -> false
+
+
+let rec isConstant = function
+ | Const _ -> true
+ | UnOp (_, e, _) -> isConstant e
+ | BinOp (_, e1, e2, _) -> isConstant e1 && isConstant e2
+ | Lval (Var vi, NoOffset) ->
+ (vi.vglob && isArrayType vi.vtype || isFunctionType vi.vtype)
+ | Lval _ -> false
+ | SizeOf _ | SizeOfE _ | SizeOfStr _ | AlignOf _ | AlignOfE _ -> true
+ | CastE (_, e) -> isConstant e
+ | AddrOf (Var vi, off) | StartOf (Var vi, off)
+ -> vi.vglob && isConstantOff off
+ | AddrOf (Mem e, off) | StartOf(Mem e, off)
+ -> isConstant e && isConstantOff off
+
+and isConstantOff = function
+ NoOffset -> true
+ | Field(fi, off) -> isConstantOff off
+ | Index(e, off) -> isConstant e && isConstantOff off
+
+
+let getCompField (cinfo:compinfo) (fieldName:string) : fieldinfo =
+ (List.find (fun fi -> fi.fname = fieldName) cinfo.cfields)
+
+
+let rec mkCastT ~(e: exp) ~(oldt: typ) ~(newt: typ) =
+ (* Do not remove old casts because they are conversions !!! *)
+ if Util.equals (typeSig oldt) (typeSig newt) then begin
+ e
+ end else begin
+ (* Watch out for constants *)
+ match newt, e with
+ TInt(newik, []), Const(CInt64(i, _, _)) -> kinteger64 newik i
+ | _ -> CastE(newt,e)
+ end
+
+let mkCast ~(e: exp) ~(newt: typ) =
+ mkCastT e (typeOf e) newt
+
+type existsAction =
+ ExistsTrue (* We have found it *)
+ | ExistsFalse (* Stop processing this branch *)
+ | ExistsMaybe (* This node is not what we are
+ * looking for but maybe its
+ * successors are *)
+let existsType (f: typ -> existsAction) (t: typ) : bool =
+ let memo : (int, unit) H.t = H.create 17 in (* Memo table *)
+ let rec loop t =
+ match f t with
+ ExistsTrue -> true
+ | ExistsFalse -> false
+ | ExistsMaybe ->
+ (match t with
+ TNamed (t', _) -> loop t'.ttype
+ | TComp (c, _) -> loopComp c
+ | TArray (t', _, _) -> loop t'
+ | TPtr (t', _) -> loop t'
+ | TFun (rt, args, _, _) ->
+ (loop rt || List.exists (fun (_, at, _) -> loop at)
+ (argsToList args))
+ | _ -> false)
+ and loopComp c =
+ if H.mem memo c.ckey then
+ (* We are looping, the answer must be false *)
+ false
+ else begin
+ H.add memo c.ckey ();
+ List.exists (fun f -> loop f.ftype) c.cfields
+ end
+ in
+ loop t
+
+
+(* Try to do an increment, with constant folding *)
+let increm (e: exp) (i: int) =
+ let et = typeOf e in
+ let bop = if isPointerType et then PlusPI else PlusA in
+ constFold false (BinOp(bop, e, integer i, et))
+
+exception LenOfArray
+let lenOfArray (eo: exp option) : int =
+ match eo with
+ None -> raise LenOfArray
+ | Some e -> begin
+ match constFold true e with
+ | Const(CInt64(ni, _, _)) when ni >= Int64.zero ->
+ Int64.to_int ni
+ | e -> raise LenOfArray
+ end
+
+
+(*** Make a initializer for zeroe-ing a data type ***)
+let rec makeZeroInit (t: typ) : init =
+ match unrollType t with
+ TInt (ik, _) -> SingleInit (Const(CInt64(Int64.zero, ik, None)))
+ | TFloat(fk, _) -> SingleInit(Const(CReal(0.0, fk, None)))
+ | TEnum _ -> SingleInit zero
+ | TComp (comp, _) as t' when comp.cstruct ->
+ let inits =
+ List.fold_right
+ (fun f acc ->
+ if f.fname <> missingFieldName then
+ (Field(f, NoOffset), makeZeroInit f.ftype) :: acc
+ else
+ acc)
+ comp.cfields []
+ in
+ CompoundInit (t', inits)
+
+ | TComp (comp, _) when not comp.cstruct ->
+ let fstfield, rest =
+ match comp.cfields with
+ f :: rest -> f, rest
+ | [] -> E.s (unimp "Cannot create init for empty union")
+ in
+ let fieldToInit =
+ if !msvcMode then
+ (* ISO C99 [6.7.8.10] says that the first field of the union
+ is the one we should initialize. *)
+ fstfield
+ else begin
+ (* gcc initializes the whole union to zero. So choose the largest
+ field, and set that to zero. Choose the first field if possible.
+ MSVC also initializes the whole union, but use the ISO behavior
+ for MSVC because it only allows compound initializers to refer
+ to the first union field. *)
+ let fieldSize f = try bitsSizeOf f.ftype with SizeOfError _ -> 0 in
+ let widestField, widestFieldWidth =
+ List.fold_left (fun acc thisField ->
+ let widestField, widestFieldWidth = acc in
+ let thisSize = fieldSize thisField in
+ if thisSize > widestFieldWidth then
+ thisField, thisSize
+ else
+ acc)
+ (fstfield, fieldSize fstfield)
+ rest
+ in
+ widestField
+ end
+ in
+ CompoundInit(t, [(Field(fieldToInit, NoOffset),
+ makeZeroInit fieldToInit.ftype)])
+
+ | TArray(bt, Some len, _) as t' ->
+ let n =
+ match constFold true len with
+ Const(CInt64(n, _, _)) -> Int64.to_int n
+ | _ -> E.s (E.unimp "Cannot understand length of array")
+ in
+ let initbt = makeZeroInit bt in
+ let rec loopElems acc i =
+ if i < 0 then acc
+ else loopElems ((Index(integer i, NoOffset), initbt) :: acc) (i - 1)
+ in
+ CompoundInit(t', loopElems [] (n - 1))
+
+ | TArray (bt, None, at) as t' ->
+ (* Unsized array, allow it and fill it in later
+ * (see cabs2cil.ml, collectInitializer) *)
+ CompoundInit (t', [])
+
+ | TPtr _ as t -> SingleInit(CastE(t, zero))
+ | x -> E.s (unimp "Cannot initialize type: %a" d_type x)
+
+
+(**** Fold over the list of initializers in a Compound. In the case of an
+ * array initializer only the initializers present are scanned (a prefix of
+ * all initializers) *)
+let foldLeftCompound
+ ~(doinit: offset -> init -> typ -> 'a -> 'a)
+ ~(ct: typ)
+ ~(initl: (offset * init) list)
+ ~(acc: 'a) : 'a =
+ match unrollType ct with
+ TArray(bt, _, _) ->
+ List.fold_left (fun acc (o, i) -> doinit o i bt acc) acc initl
+
+ | TComp (comp, _) ->
+ let getTypeOffset = function
+ Field(f, NoOffset) -> f.ftype
+ | _ -> E.s (bug "foldLeftCompound: malformed initializer")
+ in
+ List.fold_left
+ (fun acc (o, i) -> doinit o i (getTypeOffset o) acc) acc initl
+
+ | _ -> E.s (unimp "Type of Compound is not array or struct or union")
+
+(**** Fold over the list of initializers in a Compound. Like foldLeftCompound
+ * but scans even the zero-initializers that are missing at the end of the
+ * array *)
+let foldLeftCompoundAll
+ ~(doinit: offset -> init -> typ -> 'a -> 'a)
+ ~(ct: typ)
+ ~(initl: (offset * init) list)
+ ~(acc: 'a) : 'a =
+ match unrollType ct with
+ TArray(bt, leno, _) -> begin
+ let part =
+ List.fold_left (fun acc (o, i) -> doinit o i bt acc) acc initl in
+ (* See how many more we have to do *)
+ match leno with
+ Some lene -> begin
+ match constFold true lene with
+ Const(CInt64(i, _, _)) ->
+ let len_array = Int64.to_int i in
+ let len_init = List.length initl in
+ if len_array > len_init then
+ let zi = makeZeroInit bt in
+ let rec loop acc i =
+ if i >= len_array then acc
+ else
+ loop (doinit (Index(integer i, NoOffset)) zi bt acc)
+ (i + 1)
+ in
+ loop part (len_init + 1)
+ else
+ part
+ | _ -> E.s (unimp "foldLeftCompoundAll: array with initializer and non-constant length\n")
+ end
+
+ | _ -> E.s (unimp "foldLeftCompoundAll: TArray with initializer and no length")
+ end
+ | TComp (comp, _) ->
+ let getTypeOffset = function
+ Field(f, NoOffset) -> f.ftype
+ | _ -> E.s (bug "foldLeftCompound: malformed initializer")
+ in
+ List.fold_left
+ (fun acc (o, i) -> doinit o i (getTypeOffset o) acc) acc initl
+
+ | _ -> E.s (E.unimp "Type of Compound is not array or struct or union")
+
+
+
+let rec isCompleteType t =
+ match unrollType t with
+ | TArray(t, None, _) -> false
+ | TArray(t, Some z, _) when isZero z -> false
+ | TComp (comp, _) -> (* Struct or union *)
+ List.for_all (fun fi -> isCompleteType fi.ftype) comp.cfields
+ | _ -> true
+
+
+module A = Alpha
+
+
+(** Uniquefy the variable names *)
+let uniqueVarNames (f: file) : unit =
+ (* Setup the alpha conversion table for globals *)
+ let gAlphaTable: (string,
+ location A.alphaTableData ref) H.t = H.create 113 in
+ (* Keep also track of the global names that we have used. Map them to the
+ * variable ID. We do this only to check that we do not have two globals
+ * with the same name. *)
+ let globalNames: (string, int) H.t = H.create 113 in
+ (* Scan the file and add the global names to the table *)
+ iterGlobals f
+ (function
+ GVarDecl(vi, l)
+ | GVar(vi, _, l)
+ | GFun({svar = vi}, l) ->
+ (* See if we have used this name already for something else *)
+ (try
+ let oldid = H.find globalNames vi.vname in
+ if oldid <> vi.vid then
+ ignore (warn "The name %s is used for two distinct globals"
+ vi.vname);
+ (* Here if we have used this name already. Go ahead *)
+ ()
+ with Not_found -> begin
+ (* Here if this is the first time we define a name *)
+ H.add globalNames vi.vname vi.vid;
+ (* And register it *)
+ A.registerAlphaName gAlphaTable None vi.vname !currentLoc;
+ ()
+ end)
+ | _ -> ());
+
+ (* Now we must scan the function bodies and rename the locals *)
+ iterGlobals f
+ (function
+ GFun(fdec, l) -> begin
+ currentLoc := l;
+ (* Setup an undo list to be able to revert the changes to the
+ * global alpha table *)
+ let undolist = ref [] in
+ (* Process one local variable *)
+ let processLocal (v: varinfo) =
+ let newname, oldloc =
+ A.newAlphaName gAlphaTable (Some undolist) v.vname
+ !currentLoc
+ in
+ if false && newname <> v.vname then (* Disable this warning *)
+ ignore (warn "uniqueVarNames: Changing the name of local %s in %s to %s (due to duplicate at %a)\n"
+ v.vname fdec.svar.vname newname d_loc oldloc);
+ v.vname <- newname
+ in
+ (* Do the formals first *)
+ List.iter processLocal fdec.sformals;
+ (* Fix the type again *)
+ setFormals fdec fdec.sformals;
+ (* And now the locals *)
+ List.iter processLocal fdec.slocals;
+ (* Undo the changes to the global table *)
+ A.undoAlphaChanges gAlphaTable !undolist;
+ ()
+ end
+ | _ -> ());
+ ()
+
+
+(* A visitor that makes a deep copy of a function body *)
+class copyFunctionVisitor (newname: string) = object (self)
+ inherit nopCilVisitor
+
+ (* Keep here a maping from locals to their copies *)
+ val map : (string, varinfo) H.t = H.create 113
+ (* Keep here a maping from statements to their copies *)
+ val stmtmap : (int, stmt) H.t = H.create 113
+ val sid = ref 0 (* Will have to assign ids to statements *)
+ (* Keep here a list of statements to be patched *)
+ val patches : stmt list ref = ref []
+
+ val argid = ref 0
+
+ (* This is the main function *)
+ method vfunc (f: fundec) : fundec visitAction =
+ (* We need a map from the old locals/formals to the new ones *)
+ H.clear map;
+ argid := 0;
+ (* Make a copy of the fundec. *)
+ let f' = {f with svar = f.svar} in
+ let patchfunction (f' : fundec) =
+ (* Change the name. Only this late to allow the visitor to copy the
+ * svar *)
+ f'.svar.vname <- newname;
+ let findStmt (i: int) =
+ try H.find stmtmap i
+ with Not_found -> E.s (bug "Cannot find the copy of stmt#%d" i)
+ in
+ let patchstmt (s: stmt) =
+ match s.skind with
+ Goto (sr, l) ->
+ (* Make a copy of the reference *)
+ let sr' = ref (findStmt !sr.sid) in
+ s.skind <- Goto (sr',l)
+ | Switch (e, body, cases, l) ->
+ s.skind <- Switch (e, body,
+ List.map (fun cs -> findStmt cs.sid) cases, l)
+ | _ -> ()
+ in
+ List.iter patchstmt !patches;
+ f'
+ in
+ patches := [];
+ sid := 0;
+ H.clear stmtmap;
+ ChangeDoChildrenPost (f', patchfunction)
+
+ (* We must create a new varinfo for each declaration. Memoize to
+ * maintain sharing *)
+ method vvdec (v: varinfo) =
+ (* Some varinfo have empty names. Give them some name *)
+ if v.vname = "" then begin
+ v.vname <- "arg" ^ string_of_int !argid; incr argid
+ end;
+ try
+ ChangeTo (H.find map v.vname)
+ with Not_found -> begin
+ let v' = {v with vid = newVID () } in
+ H.add map v.vname v';
+ ChangeDoChildrenPost (v', fun x -> x)
+ end
+
+ (* We must replace references to local variables *)
+ method vvrbl (v: varinfo) =
+ if v.vglob then SkipChildren else
+ try
+ ChangeTo (H.find map v.vname)
+ with Not_found ->
+ E.s (bug "Cannot find the new copy of local variable %s" v.vname)
+
+
+ (* Replace statements. *)
+ method vstmt (s: stmt) : stmt visitAction =
+ s.sid <- !sid; incr sid;
+ let s' = {s with sid = s.sid} in
+ H.add stmtmap s.sid s'; (* Remember where we copied this *)
+ (* if we have a Goto or a Switch remember them to fixup at end *)
+ (match s'.skind with
+ (Goto _ | Switch _) -> patches := s' :: !patches
+ | _ -> ());
+ (* Do the children *)
+ ChangeDoChildrenPost (s', fun x -> x)
+
+ (* Copy blocks since they are mutable *)
+ method vblock (b: block) =
+ ChangeDoChildrenPost ({b with bstmts = b.bstmts}, fun x -> x)
+
+
+ method vglob _ = E.s (bug "copyFunction should not be used on globals")
+end
+
+(* We need a function that copies a CIL function. *)
+let copyFunction (f: fundec) (newname: string) : fundec =
+ visitCilFunction (new copyFunctionVisitor(newname)) f
+
+(********* Compute the CFG ********)
+let sid_counter = ref 0
+
+let new_sid () =
+ let id = !sid_counter in
+ incr sid_counter;
+ id
+
+let statements : stmt list ref = ref []
+(* Clear all info about the CFG in statements *)
+class clear : cilVisitor = object
+ inherit nopCilVisitor
+ method vstmt s = begin
+ s.sid <- !sid_counter ;
+ incr sid_counter ;
+ statements := s :: !statements;
+ s.succs <- [] ;
+ s.preds <- [] ;
+ DoChildren
+ end
+ method vexpr _ = SkipChildren
+ method vtype _ = SkipChildren
+ method vinst _ = SkipChildren
+end
+
+let link source dest = begin
+ if not (List.mem dest source.succs) then
+ source.succs <- dest :: source.succs ;
+ if not (List.mem source dest.preds) then
+ dest.preds <- source :: dest.preds
+end
+let trylink source dest_option = match dest_option with
+ None -> ()
+| Some(dest) -> link source dest
+
+
+(** Cmopute the successors and predecessors of a block, given a fallthrough *)
+let rec succpred_block b fallthrough =
+ let rec handle sl = match sl with
+ [] -> ()
+ | [a] -> succpred_stmt a fallthrough
+ | hd :: ((next :: _) as tl) ->
+ succpred_stmt hd (Some next) ;
+ handle tl
+ in handle b.bstmts
+
+
+and succpred_stmt s fallthrough =
+ match s.skind with
+ Instr _ -> trylink s fallthrough
+ | Return _ -> ()
+ | Goto(dest,l) -> link s !dest
+ | Break _
+ | Continue _
+ | Switch _ ->
+ failwith "computeCFGInfo: cannot be called on functions with break, continue or switch statements. Use prepareCFG first to remove them."
+
+ | If(e1,b1,b2,l) ->
+ (match b1.bstmts with
+ [] -> trylink s fallthrough
+ | hd :: tl -> (link s hd ; succpred_block b1 fallthrough )) ;
+ (match b2.bstmts with
+ [] -> trylink s fallthrough
+ | hd :: tl -> (link s hd ; succpred_block b2 fallthrough ))
+
+(*
+ | Loop(b,l,_,_) ->
+ begin match b.bstmts with
+ [] -> failwith "computeCFGInfo: empty loop"
+ | hd :: tl ->
+ link s hd ;
+ succpred_block b (Some(hd))
+ end
+*)
+
+ | While (e, b, l) -> begin match b.bstmts with
+ | [] -> failwith "computeCFGInfo: empty loop"
+ | hd :: tl -> link s hd ;
+ succpred_block b (Some(hd))
+ end
+
+ | DoWhile (e, b, l) ->begin match b.bstmts with
+ | [] -> failwith "computeCFGInfo: empty loop"
+ | hd :: tl -> link s hd ;
+ succpred_block b (Some(hd))
+ end
+
+ | For (bInit, e, bIter, b, l) ->
+ (match bInit.bstmts with
+ | [] -> failwith "computeCFGInfo: empty loop"
+ | hd :: tl -> link s hd ;
+ succpred_block bInit (Some(hd))) ;
+ (match bIter.bstmts with
+ | [] -> failwith "computeCFGInfo: empty loop"
+ | hd :: tl -> link s hd ;
+ succpred_block bIter (Some(hd))) ;
+ (match b.bstmts with
+ | [] -> failwith "computeCFGInfo: empty loop"
+ | hd :: tl -> link s hd ;
+ succpred_block b (Some(hd))) ;
+
+ | Block(b) -> begin match b.bstmts with
+ [] -> trylink s fallthrough
+ | hd :: tl -> link s hd ;
+ succpred_block b fallthrough
+ end
+ | TryExcept _ | TryFinally _ ->
+ failwith "computeCFGInfo: structured exception handling not implemented"
+
+(* [weimer] Sun May 5 12:25:24 PDT 2002
+ * This code was pulled from ext/switch.ml because it looks like we really
+ * want it to be part of CIL.
+ *
+ * Here is the magic handling to
+ * (1) replace switch statements with if/goto
+ * (2) remove "break"
+ * (3) remove "default"
+ * (4) remove "continue"
+ *)
+let is_case_label l = match l with
+ | Case _ | Default _ -> true
+ | _ -> false
+
+let switch_count = ref (-1)
+let get_switch_count () =
+ switch_count := 1 + !switch_count ;
+ !switch_count
+
+let switch_label = ref (-1)
+
+let rec xform_switch_stmt s break_dest cont_dest label_index = begin
+ s.labels <- List.map (fun lab -> match lab with
+ Label _ -> lab
+ | Case(e,l) ->
+ let suffix =
+ match isInteger e with
+ | Some value ->
+ if value < Int64.zero then
+ "neg_" ^ Int64.to_string (Int64.neg value)
+ else
+ Int64.to_string value
+ | None ->
+ incr switch_label;
+ "exp_" ^ string_of_int !switch_label
+ in
+ let str = Pretty.sprint !lineLength
+ (Pretty.dprintf "switch_%d_%s" label_index suffix) in
+ (Label(str,l,false))
+ | Default(l) -> (Label(Printf.sprintf
+ "switch_%d_default" label_index,l,false))
+ ) s.labels ;
+ match s.skind with
+ | Instr _ | Return _ | Goto _ -> ()
+ | Break(l) -> begin try
+ s.skind <- Goto(break_dest (),l)
+ with e ->
+ ignore (error "prepareCFG: break: %a@!" d_stmt s) ;
+ raise e
+ end
+ | Continue(l) -> begin try
+ s.skind <- Goto(cont_dest (),l)
+ with e ->
+ ignore (error "prepareCFG: continue: %a@!" d_stmt s) ;
+ raise e
+ end
+ | If(e,b1,b2,l) -> xform_switch_block b1 break_dest cont_dest label_index ;
+ xform_switch_block b2 break_dest cont_dest label_index
+ | Switch(e,b,sl,l) -> begin
+ (* change
+ * switch (se) {
+ * case 0: s0 ;
+ * case 1: s1 ; break;
+ * ...
+ * }
+ *
+ * into:
+ *
+ * if (se == 0) goto label_0;
+ * else if (se == 1) goto label_1;
+ * ...
+ * else if (0) { // body_block
+ * label_0: s0;
+ * label_1: s1; goto label_break;
+ * ...
+ * } else if (0) { // break_block
+ * label_break: ; // break_stmt
+ * }
+ *)
+ let i = get_switch_count () in
+ let break_stmt = mkStmt (Instr []) in
+ break_stmt.labels <-
+ [Label((Printf.sprintf "switch_%d_break" i),l,false)] ;
+ let break_block = mkBlock [ break_stmt ] in
+ let body_block = b in
+ let body_if_stmtkind = (If(zero,body_block,break_block,l)) in
+
+ (* The default case, if present, must be used only if *all*
+ non-default cases fail [ISO/IEC 9899:1999, §6.8.4.2, ¶5]. As a
+ result, we sort the order in which we handle the labels (but not the
+ order in which we print out the statements, so fall-through still
+ works as expected). *)
+ let compare_choices s1 s2 = match s1.labels, s2.labels with
+ | (Default(_) :: _), _ -> 1
+ | _, (Default(_) :: _) -> -1
+ | _, _ -> 0
+ in
+
+ let rec handle_choices sl = match sl with
+ [] -> body_if_stmtkind
+ | stmt_hd :: stmt_tl -> begin
+ let rec handle_labels lab_list = begin
+ match lab_list with
+ [] -> handle_choices stmt_tl
+ | Case(ce,cl) :: lab_tl ->
+ let pred = BinOp(Eq,e,ce,intType) in
+ let then_block = mkBlock [ mkStmt (Goto(ref stmt_hd,cl)) ] in
+ let else_block = mkBlock [ mkStmt (handle_labels lab_tl) ] in
+ If(pred,then_block,else_block,cl)
+ | Default(dl) :: lab_tl ->
+ (* ww: before this was 'if (1) goto label', but as Ben points
+ out this might confuse someone down the line who doesn't have
+ special handling for if(1) into thinking that there are two
+ paths here. The simpler 'goto label' is what we want. *)
+ Block(mkBlock [ mkStmt (Goto(ref stmt_hd,dl)) ;
+ mkStmt (handle_labels lab_tl) ])
+ | Label(_,_,_) :: lab_tl -> handle_labels lab_tl
+ end in
+ handle_labels stmt_hd.labels
+ end in
+ s.skind <- handle_choices (List.sort compare_choices sl) ;
+ xform_switch_block b (fun () -> ref break_stmt) cont_dest i
+ end
+(*
+ | Loop(b,l,_,_) ->
+ let i = get_switch_count () in
+ let break_stmt = mkStmt (Instr []) in
+ break_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
+ let cont_stmt = mkStmt (Instr []) in
+ cont_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
+ b.bstmts <- cont_stmt :: b.bstmts ;
+ let this_stmt = mkStmt
+ (Loop(b,l,Some(cont_stmt),Some(break_stmt))) in
+ let break_dest () = ref break_stmt in
+ let cont_dest () = ref cont_stmt in
+ xform_switch_block b break_dest cont_dest label_index ;
+ break_stmt.succs <- s.succs ;
+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
+ s.skind <- Block new_block
+*)
+ | While (e, b, l) ->
+ let i = get_switch_count () in
+ let break_stmt = mkStmt (Instr []) in
+ break_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
+ let cont_stmt = mkStmt (Instr []) in
+ cont_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
+ b.bstmts <- cont_stmt :: b.bstmts ;
+ let this_stmt = mkStmt
+ (While(e,b,l)) in
+ let break_dest () = ref break_stmt in
+ let cont_dest () = ref cont_stmt in
+ xform_switch_block b break_dest cont_dest label_index ;
+ break_stmt.succs <- s.succs ;
+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
+ s.skind <- Block new_block
+
+ | DoWhile (e, b, l) ->
+ let i = get_switch_count () in
+ let break_stmt = mkStmt (Instr []) in
+ break_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
+ let cont_stmt = mkStmt (Instr []) in
+ cont_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
+ b.bstmts <- cont_stmt :: b.bstmts ;
+ let this_stmt = mkStmt
+ (DoWhile(e,b,l)) in
+ let break_dest () = ref break_stmt in
+ let cont_dest () = ref cont_stmt in
+ xform_switch_block b break_dest cont_dest label_index ;
+ break_stmt.succs <- s.succs ;
+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
+ s.skind <- Block new_block
+
+ | For (bInit, e, bIter , b, l) ->
+ let i = get_switch_count () in
+ let break_stmt = mkStmt (Instr []) in
+ break_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_break" i),l,false)] ;
+ let cont_stmt = mkStmt (Instr []) in
+ cont_stmt.labels <-
+ [Label((Printf.sprintf "while_%d_continue" i),l,false)] ;
+ b.bstmts <- cont_stmt :: b.bstmts ;
+ let this_stmt = mkStmt
+ (For(bInit,e,bIter,b,l)) in
+ let break_dest () = ref break_stmt in
+ let cont_dest () = ref cont_stmt in
+ xform_switch_block b break_dest cont_dest label_index ;
+ break_stmt.succs <- s.succs ;
+ let new_block = mkBlock [ this_stmt ; break_stmt ] in
+ s.skind <- Block new_block
+
+
+ | Block(b) -> xform_switch_block b break_dest cont_dest label_index
+
+ | TryExcept _ | TryFinally _ ->
+ failwith "xform_switch_statement: structured exception handling not implemented"
+
+end and xform_switch_block b break_dest cont_dest label_index =
+ try
+ let rec link_succs sl = match sl with
+ | [] -> ()
+ | hd :: tl -> (if hd.succs = [] then hd.succs <- tl) ; link_succs tl
+ in
+ link_succs b.bstmts ;
+ List.iter (fun stmt ->
+ xform_switch_stmt stmt break_dest cont_dest label_index) b.bstmts ;
+ with e ->
+ List.iter (fun stmt -> ignore
+ (warn "prepareCFG: %a@!" d_stmt stmt)) b.bstmts ;
+ raise e
+
+(* prepare a function for computeCFGInfo by removing break, continue,
+ * default and switch statements/labels and replacing them with Ifs and
+ * Gotos. *)
+let prepareCFG (fd : fundec) : unit =
+ xform_switch_block fd.sbody
+ (fun () -> failwith "prepareCFG: break with no enclosing loop")
+ (fun () -> failwith "prepareCFG: continue with no enclosing loop") (-1)
+
+(* make the cfg and return a list of statements *)
+let computeCFGInfo (f : fundec) (global_numbering : bool) : unit =
+ if not global_numbering then
+ sid_counter := 0 ;
+ statements := [];
+ let clear_it = new clear in
+ ignore (visitCilBlock clear_it f.sbody) ;
+ f.smaxstmtid <- Some (!sid_counter) ;
+ succpred_block f.sbody (None);
+ let res = List.rev !statements in
+ statements := [];
+ f.sallstmts <- res;
+ ()
+
+let initCIL () =
+ if not !initCIL_called then begin
+ (* Set the machine *)
+ theMachine := if !msvcMode then M.msvc else M.gcc;
+ (* Pick type for string literals *)
+ stringLiteralType := if !theMachine.M.const_string_literals then
+ charConstPtrType
+ else
+ charPtrType;
+ (* Find the right ikind given the size *)
+ let findIkind (unsigned: bool) (sz: int) : ikind =
+ (* Test the most common sizes first *)
+ if sz = !theMachine.M.sizeof_int then
+ if unsigned then IUInt else IInt
+ else if sz = !theMachine.M.sizeof_long then
+ if unsigned then IULong else ILong
+ else if sz = 1 then
+ if unsigned then IUChar else IChar
+ else if sz = !theMachine.M.sizeof_short then
+ if unsigned then IUShort else IShort
+ else if sz = !theMachine.M.sizeof_longlong then
+ if unsigned then IULongLong else ILongLong
+ else
+ E.s(E.unimp "initCIL: cannot find the right ikind for size %d\n" sz)
+ in
+ upointType := TInt(findIkind true !theMachine.M.sizeof_ptr, []);
+ kindOfSizeOf := findIkind true !theMachine.M.sizeof_sizeof;
+ typeOfSizeOf := TInt(!kindOfSizeOf, []);
+ H.add gccBuiltins "__builtin_memset"
+ (voidPtrType, [ voidPtrType; intType; intType ], false);
+ wcharKind := findIkind false !theMachine.M.sizeof_wchar;
+ wcharType := TInt(!wcharKind, []);
+ char_is_unsigned := !theMachine.M.char_is_unsigned;
+ little_endian := !theMachine.M.little_endian;
+ underscore_name := !theMachine.M.underscore_name;
+ nextGlobalVID := 1;
+ nextCompinfoKey := 1;
+ initCIL_called := true
+ end
+
+
+(* We want to bring all type declarations before the data declarations. This
+ * is needed for code of the following form:
+
+ int f(); // Prototype without arguments
+ typedef int FOO;
+ int f(FOO x) { ... }
+
+ In CIL the prototype also lists the type of the argument as being FOO,
+ which is undefined.
+
+ There is one catch with this scheme. If the type contains an array whose
+ length refers to variables then those variables must be declared before
+ the type *)
+
+let pullTypesForward = true
+
+
+ (* Scan a type and collect the variables that are refered *)
+class getVarsInGlobalClass (pacc: varinfo list ref) = object
+ inherit nopCilVisitor
+ method vvrbl (vi: varinfo) =
+ pacc := vi :: !pacc;
+ SkipChildren
+
+ method vglob = function
+ GType _ | GCompTag _ -> DoChildren
+ | _ -> SkipChildren
+
+end
+
+let getVarsInGlobal (g : global) : varinfo list =
+ let pacc : varinfo list ref = ref [] in
+ let v : cilVisitor = new getVarsInGlobalClass pacc in
+ ignore (visitCilGlobal v g);
+ !pacc
+
+let hasPrefix p s =
+ let pl = String.length p in
+ (String.length s >= pl) && String.sub s 0 pl = p
+
+let pushGlobal (g: global)
+ ~(types:global list ref)
+ ~(variables: global list ref) =
+ if not pullTypesForward then
+ variables := g :: !variables
+ else
+ begin
+ (* Collect a list of variables that are refered from the type. Return
+ * Some if the global should go with the types and None if it should go
+ * to the variables. *)
+ let varsintype : (varinfo list * location) option =
+ match g with
+ GType (_, l) | GCompTag (_, l) -> Some (getVarsInGlobal g, l)
+ | GEnumTag (_, l) | GPragma (Attr("pack", _), l)
+ | GCompTagDecl (_, l) | GEnumTagDecl (_, l) -> Some ([], l)
+ (** Move the warning pragmas early
+ | GPragma(Attr(s, _), l) when hasPrefix "warning" s -> Some ([], l)
+ *)
+ | _ -> None (* Does not go with the types *)
+ in
+ match varsintype with
+ None -> variables := g :: !variables
+ | Some (vl, loc) ->
+ types :=
+ (* insert declarations for referred variables ('vl'), before
+ * the type definition 'g' itself *)
+ g :: (List.fold_left (fun acc v -> GVarDecl(v, loc) :: acc)
+ !types vl)
+ end
+
+
+type formatArg =
+ Fe of exp
+ | Feo of exp option (** For array lengths *)
+ | Fu of unop
+ | Fb of binop
+ | Fk of ikind
+ | FE of exp list (** For arguments in a function call *)
+ | Ff of (string * typ * attributes) (** For a formal argument *)
+ | FF of (string * typ * attributes) list (* For formal argument lists *)
+ | Fva of bool (** For the ellipsis in a function type *)
+ | Fv of varinfo
+ | Fl of lval
+ | Flo of lval option (** For the result of a function call *)
+ | Fo of offset
+ | Fc of compinfo
+ | Fi of instr
+ | FI of instr list
+ | Ft of typ
+ | Fd of int
+ | Fg of string
+ | Fs of stmt
+ | FS of stmt list
+ | FA of attributes
+
+ | Fp of attrparam
+ | FP of attrparam list
+
+ | FX of string
+
+let d_formatarg () = function
+ Fe e -> dprintf "Fe(%a)" d_exp e
+ | Feo None -> dprintf "Feo(None)"
+ | Feo (Some e) -> dprintf "Feo(%a)" d_exp e
+ | FE _ -> dprintf "FE()"
+ | Fk ik -> dprintf "Fk()"
+ | Fva b -> dprintf "Fva(%b)" b
+ | Ff (an, _, _) -> dprintf "Ff(%s)" an
+ | FF _ -> dprintf "FF(...)"
+ | FA _ -> dprintf "FA(...)"
+ | Fu uo -> dprintf "Fu()"
+ | Fb bo -> dprintf "Fb()"
+ | Fv v -> dprintf "Fv(%s)" v.vname
+ | Fl l -> dprintf "Fl(%a)" d_lval l
+ | Flo None -> dprintf "Flo(None)"
+ | Flo (Some l) -> dprintf "Flo(%a)" d_lval l
+ | Fo o -> dprintf "Fo"
+ | Fc ci -> dprintf "Fc(%s)" ci.cname
+ | Fi i -> dprintf "Fi(...)"
+ | FI i -> dprintf "FI(...)"
+ | Ft t -> dprintf "Ft(%a)" d_type t
+ | Fd n -> dprintf "Fd(%d)" n
+ | Fg s -> dprintf "Fg(%s)" s
+ | Fp _ -> dprintf "Fp(...)"
+ | FP n -> dprintf "FP(...)"
+ | Fs _ -> dprintf "FS"
+ | FS _ -> dprintf "FS"
+
+ | FX _ -> dprintf "FX()"
+
+
diff --git a/cil/src/cil.mli b/cil/src/cil.mli
new file mode 100644
index 0000000..31c4e65
--- /dev/null
+++ b/cil/src/cil.mli
@@ -0,0 +1,2455 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(*
+ * CIL: An intermediate language for analyzing C programs.
+ *
+ * George Necula
+ *
+ *)
+
+(** CIL API Documentation. An html version of this document can be found at
+ * http://manju.cs.berkeley.edu/cil. *)
+
+(** Call this function to perform some initialization. Call if after you have
+ * set {!Cil.msvcMode}. *)
+val initCIL: unit -> unit
+
+
+(** This are the CIL version numbers. A CIL version is a number of the form
+ * M.m.r (major, minor and release) *)
+val cilVersion: string
+val cilVersionMajor: int
+val cilVersionMinor: int
+val cilVersionRevision: int
+
+(** This module defines the abstract syntax of CIL. It also provides utility
+ * functions for traversing the CIL data structures, and pretty-printing
+ * them. The parser for both the GCC and MSVC front-ends can be invoked as
+ * [Frontc.parse: string -> unit ->] {!Cil.file}. This function must be given
+ * the name of a preprocessed C file and will return the top-level data
+ * structure that describes a whole source file. By default the parsing and
+ * elaboration into CIL is done as for GCC source. If you want to use MSVC
+ * source you must set the {!Cil.msvcMode} to [true] and must also invoke the
+ * function [Frontc.setMSVCMode: unit -> unit]. *)
+
+
+(** {b The Abstract Syntax of CIL} *)
+
+
+(** The top-level representation of a CIL source file (and the result of the
+ * parsing and elaboration). Its main contents is the list of global
+ * declarations and definitions. You can iterate over the globals in a
+ * {!Cil.file} using the following iterators: {!Cil.mapGlobals},
+ * {!Cil.iterGlobals} and {!Cil.foldGlobals}. You can also use the
+ * {!Cil.dummyFile} when you need a {!Cil.file} as a placeholder. For each
+ * global item CIL stores the source location where it appears (using the
+ * type {!Cil.location}) *)
+
+type file =
+ { mutable fileName: string; (** The complete file name *)
+ mutable globals: global list; (** List of globals as they will appear
+ in the printed file *)
+ mutable globinit: fundec option;
+ (** An optional global initializer function. This is a function where
+ * you can put stuff that must be executed before the program is
+ * started. This function, is conceptually at the end of the file,
+ * although it is not part of the globals list. Use {!Cil.getGlobInit}
+ * to create/get one. *)
+ mutable globinitcalled: bool;
+ (** Whether the global initialization function is called in main. This
+ * should always be false if there is no global initializer. When you
+ * create a global initialization CIL will try to insert code in main
+ * to call it. This will not happen if your file does not contain a
+ * function called "main" *)
+ }
+(** Top-level representation of a C source file *)
+
+and comment = location * string
+
+(** {b Globals}. The main type for representing global declarations and
+ * definitions. A list of these form a CIL file. The order of globals in the
+ * file is generally important. *)
+
+(** A global declaration or definition *)
+and global =
+ | GType of typeinfo * location
+ (** A typedef. All uses of type names (through the [TNamed] constructor)
+ must be preceded in the file by a definition of the name. The string
+ is the defined name and always not-empty. *)
+
+ | GCompTag of compinfo * location
+ (** Defines a struct/union tag with some fields. There must be one of
+ these for each struct/union tag that you use (through the [TComp]
+ constructor) since this is the only context in which the fields are
+ printed. Consequently nested structure tag definitions must be
+ broken into individual definitions with the innermost structure
+ defined first. *)
+
+ | GCompTagDecl of compinfo * location
+ (** Declares a struct/union tag. Use as a forward declaration. This is
+ * printed without the fields. *)
+
+ | GEnumTag of enuminfo * location
+ (** Declares an enumeration tag with some fields. There must be one of
+ these for each enumeration tag that you use (through the [TEnum]
+ constructor) since this is the only context in which the items are
+ printed. *)
+
+ | GEnumTagDecl of enuminfo * location
+ (** Declares an enumeration tag. Use as a forward declaration. This is
+ * printed without the items. *)
+
+ | GVarDecl of varinfo * location
+ (** A variable declaration (not a definition). If the variable has a
+ function type then this is a prototype. There can be several
+ declarations and at most one definition for a given variable. If both
+ forms appear then they must share the same varinfo structure. A
+ prototype shares the varinfo with the fundec of the definition. Either
+ has storage Extern or there must be a definition in this file *)
+
+ | GVar of varinfo * initinfo * location
+ (** A variable definition. Can have an initializer. The initializer is
+ * updateable so that you can change it without requiring to recreate
+ * the list of globals. There can be at most one definition for a
+ * variable in an entire program. Cannot have storage Extern or function
+ * type. *)
+
+ | GFun of fundec * location
+ (** A function definition. *)
+
+ | GAsm of string * location (** Global asm statement. These ones
+ can contain only a template *)
+ | GPragma of attribute * location (** Pragmas at top level. Use the same
+ syntax as attributes *)
+ | GText of string (** Some text (printed verbatim) at
+ top level. E.g., this way you can
+ put comments in the output. *)
+
+(** {b Types}. A C type is represented in CIL using the type {!Cil.typ}.
+ * Among types we differentiate the integral types (with different kinds
+ * denoting the sign and precision), floating point types, enumeration types,
+ * array and pointer types, and function types. Every type is associated with
+ * a list of attributes, which are always kept in sorted order. Use
+ * {!Cil.addAttribute} and {!Cil.addAttributes} to construct list of
+ * attributes. If you want to inspect a type, you should use
+ * {!Cil.unrollType} or {!Cil.unrollTypeDeep} to see through the uses of
+ * named types. *)
+(** CIL is configured at build-time with the sizes and alignments of the
+ * underlying compiler (GCC or MSVC). CIL contains functions that can compute
+ * the size of a type (in bits) {!Cil.bitsSizeOf}, the alignment of a type
+ * (in bytes) {!Cil.alignOf_int}, and can convert an offset into a start and
+ * width (both in bits) using the function {!Cil.bitsOffset}. At the moment
+ * these functions do not take into account the [packed] attributes and
+ * pragmas. *)
+
+and typ =
+ TVoid of attributes (** Void type. Also predefined as {!Cil.voidType} *)
+ | TInt of ikind * attributes
+ (** An integer type. The kind specifies the sign and width. Several
+ * useful variants are predefined as {!Cil.intType}, {!Cil.uintType},
+ * {!Cil.longType}, {!Cil.charType}. *)
+
+
+ | TFloat of fkind * attributes
+ (** A floating-point type. The kind specifies the precision. You can
+ * also use the predefined constant {!Cil.doubleType}. *)
+
+ | TPtr of typ * attributes
+ (** Pointer type. Several useful variants are predefined as
+ * {!Cil.charPtrType}, {!Cil.charConstPtrType} (pointer to a
+ * constant character), {!Cil.voidPtrType},
+ * {!Cil.intPtrType} *)
+
+ | TArray of typ * exp option * attributes
+ (** Array type. It indicates the base type and the array length. *)
+
+ | TFun of typ * (string * typ * attributes) list option * bool * attributes
+ (** Function type. Indicates the type of the result, the name, type
+ * and name attributes of the formal arguments ([None] if no
+ * arguments were specified, as in a function whose definition or
+ * prototype we have not seen; [Some \[\]] means void). Use
+ * {!Cil.argsToList} to obtain a list of arguments. The boolean
+ * indicates if it is a variable-argument function. If this is the
+ * type of a varinfo for which we have a function declaration then
+ * the information for the formals must match that in the
+ * function's sformals. Use {!Cil.setFormals}, or
+ * {!Cil.setFunctionType}, or {!Cil.makeFormalVar} for this
+ * purpose. *)
+
+ | TNamed of typeinfo * attributes
+ (* The use of a named type. Each such type name must be preceded
+ * in the file by a [GType] global. This is printed as just the
+ * type name. The actual referred type is not printed here and is
+ * carried only to simplify processing. To see through a sequence
+ * of named type references, use {!Cil.unrollType} or
+ * {!Cil.unrollTypeDeep}. The attributes are in addition to those
+ * given when the type name was defined. *)
+
+ | TComp of compinfo * attributes
+(** The most delicate issue for C types is that recursion that is possible by
+ * using structures and pointers. To address this issue we have a more
+ * complex representation for structured types (struct and union). Each such
+ * type is represented using the {!Cil.compinfo} type. For each composite
+ * type the {!Cil.compinfo} structure must be declared at top level using
+ * [GCompTag] and all references to it must share the same copy of the
+ * structure. The attributes given are those pertaining to this use of the
+ * type and are in addition to the attributes that were given at the
+ * definition of the type and which are stored in the {!Cil.compinfo}. *)
+
+ | TEnum of enuminfo * attributes
+ (** A reference to an enumeration type. All such references must
+ share the enuminfo among them and with a [GEnumTag] global that
+ precedes all uses. The attributes refer to this use of the
+ enumeration and are in addition to the attributes of the
+ enumeration itself, which are stored inside the enuminfo *)
+
+
+ | TBuiltin_va_list of attributes
+ (** This is the same as the gcc's type with the same name *)
+
+(**
+ There are a number of functions for querying the kind of a type. These are
+ {!Cil.isIntegralType},
+ {!Cil.isArithmeticType},
+ {!Cil.isPointerType},
+ {!Cil.isFunctionType},
+ {!Cil.isArrayType}.
+
+ There are two easy ways to scan a type. First, you can use the
+{!Cil.existsType} to return a boolean answer about a type. This function
+is controlled by a user-provided function that is queried for each type that is
+used to construct the current type. The function can specify whether to
+terminate the scan with a boolean result or to continue the scan for the
+nested types.
+
+ The other method for scanning types is provided by the visitor interface (see
+ {!Cil.cilVisitor}).
+
+ If you want to compare types (or to use them as hash-values) then you should
+use instead type signatures (represented as {!Cil.typsig}). These
+contain the same information as types but canonicalized such that simple Ocaml
+structural equality will tell whether two types are equal. Use
+{!Cil.typeSig} to compute the signature of a type. If you want to ignore
+certain type attributes then use {!Cil.typeSigWithAttrs}.
+
+*)
+
+
+(** Various kinds of integers *)
+and ikind =
+ IChar (** [char] *)
+ | ISChar (** [signed char] *)
+ | IUChar (** [unsigned char] *)
+ | IInt (** [int] *)
+ | IUInt (** [unsigned int] *)
+ | IShort (** [short] *)
+ | IUShort (** [unsigned short] *)
+ | ILong (** [long] *)
+ | IULong (** [unsigned long] *)
+ | ILongLong (** [long long] (or [_int64] on Microsoft Visual C) *)
+ | IULongLong (** [unsigned long long] (or [unsigned _int64] on Microsoft
+ Visual C) *)
+
+(** Various kinds of floating-point numbers*)
+and fkind =
+ FFloat (** [float] *)
+ | FDouble (** [double] *)
+ | FLongDouble (** [long double] *)
+
+
+(** {b Attributes.} *)
+
+and attribute = Attr of string * attrparam list
+(** An attribute has a name and some optional parameters. The name should not
+ * start or end with underscore. When CIL parses attribute names it will
+ * strip leading and ending underscores (to ensure that the multitude of GCC
+ * attributes such as const, __const and __const__ all mean the same thing.) *)
+
+(** Attributes are lists sorted by the attribute name. Use the functions
+ * {!Cil.addAttribute} and {!Cil.addAttributes} to insert attributes in an
+ * attribute list and maintain the sortedness. *)
+and attributes = attribute list
+
+(** The type of parameters of attributes *)
+and attrparam =
+ | AInt of int (** An integer constant *)
+ | AStr of string (** A string constant *)
+ | ACons of string * attrparam list (** Constructed attributes. These
+ are printed [foo(a1,a2,...,an)].
+ The list of parameters can be
+ empty and in that case the
+ parentheses are not printed. *)
+ | ASizeOf of typ (** A way to talk about types *)
+ | ASizeOfE of attrparam
+ | ASizeOfS of typsig (** Replacement for ASizeOf in type
+ signatures. Only used for
+ attributes inside typsigs.*)
+ | AAlignOf of typ
+ | AAlignOfE of attrparam
+ | AAlignOfS of typsig
+ | AUnOp of unop * attrparam
+ | ABinOp of binop * attrparam * attrparam
+ | ADot of attrparam * string (** a.foo **)
+
+(** {b Structures.} The {!Cil.compinfo} describes the definition of a
+ * structure or union type. Each such {!Cil.compinfo} must be defined at the
+ * top-level using the [GCompTag] constructor and must be shared by all
+ * references to this type (using either the [TComp] type constructor or from
+ * the definition of the fields.
+
+ If all you need is to scan the definition of each
+ * composite type once, you can do that by scanning all top-level [GCompTag].
+
+ * Constructing a {!Cil.compinfo} can be tricky since it must contain fields
+ * that might refer to the host {!Cil.compinfo} and furthermore the type of
+ * the field might need to refer to the {!Cil.compinfo} for recursive types.
+ * Use the {!Cil.mkCompInfo} function to create a {!Cil.compinfo}. You can
+ * easily fetch the {!Cil.fieldinfo} for a given field in a structure with
+ * {!Cil.getCompField}. *)
+
+(** The definition of a structure or union type. Use {!Cil.mkCompInfo} to
+ * make one and use {!Cil.copyCompInfo} to copy one (this ensures that a new
+ * key is assigned and that the fields have the right pointers to parents.). *)
+and compinfo = {
+ mutable cstruct: bool;
+ (** True if struct, False if union *)
+ mutable cname: string;
+ (** The name. Always non-empty. Use {!Cil.compFullName} to get the full
+ * name of a comp (along with the struct or union) *)
+ mutable ckey: int;
+ (** A unique integer. This is assigned by {!Cil.mkCompInfo} using a
+ * global variable in the Cil module. Thus two identical structs in two
+ * different files might have different keys. Use {!Cil.copyCompInfo} to
+ * copy structures so that a new key is assigned. *)
+ mutable cfields: fieldinfo list;
+ (** Information about the fields. Notice that each fieldinfo has a
+ * pointer back to the host compinfo. This means that you should not
+ * share fieldinfo's between two compinfo's *)
+ mutable cattr: attributes;
+ (** The attributes that are defined at the same time as the composite
+ * type. These attributes can be supplemented individually at each
+ * reference to this [compinfo] using the [TComp] type constructor. *)
+ mutable cdefined: bool;
+ (** This boolean flag can be used to distinguish between structures
+ that have not been defined and those that have been defined but have
+ no fields (such things are allowed in gcc). *)
+ mutable creferenced: bool;
+ (** True if used. Initially set to false. *)
+ }
+
+(** {b Structure fields.} The {!Cil.fieldinfo} structure is used to describe
+ * a structure or union field. Fields, just like variables, can have
+ * attributes associated with the field itself or associated with the type of
+ * the field (stored along with the type of the field). *)
+
+(** Information about a struct/union field *)
+and fieldinfo = {
+ mutable fcomp: compinfo;
+ (** The host structure that contains this field. There can be only one
+ * [compinfo] that contains the field. *)
+ mutable fname: string;
+ (** The name of the field. Might be the value of {!Cil.missingFieldName}
+ * in which case it must be a bitfield and is not printed and it does not
+ * participate in initialization *)
+ mutable ftype: typ;
+ (** The type *)
+ mutable fbitfield: int option;
+ (** If a bitfield then ftype should be an integer type and the width of
+ * the bitfield must be 0 or a positive integer smaller or equal to the
+ * width of the integer type. A field of width 0 is used in C to control
+ * the alignment of fields. *)
+ mutable fattr: attributes;
+ (** The attributes for this field (not for its type) *)
+ mutable floc: location;
+ (** The location where this field is defined *)
+}
+
+
+
+(** {b Enumerations.} Information about an enumeration. This is shared by all
+ * references to an enumeration. Make sure you have a [GEnumTag] for each of
+ * of these. *)
+
+(** Information about an enumeration *)
+and enuminfo = {
+ mutable ename: string;
+ (** The name. Always non-empty. *)
+ mutable eitems: (string * exp * location) list;
+ (** Items with names and values. This list should be non-empty. The item
+ * values must be compile-time constants. *)
+ mutable eattr: attributes;
+ (** The attributes that are defined at the same time as the enumeration
+ * type. These attributes can be supplemented individually at each
+ * reference to this [enuminfo] using the [TEnum] type constructor. *)
+ mutable ereferenced: bool;
+ (** True if used. Initially set to false*)
+}
+
+(** {b Enumerations.} Information about an enumeration. This is shared by all
+ * references to an enumeration. Make sure you have a [GEnumTag] for each of
+ * of these. *)
+
+(** Information about a defined type *)
+and typeinfo = {
+ mutable tname: string;
+ (** The name. Can be empty only in a [GType] when introducing a composite
+ * or enumeration tag. If empty cannot be referred to from the file *)
+ mutable ttype: typ;
+ (** The actual type. This includes the attributes that were present in
+ * the typedef *)
+ mutable treferenced: bool;
+ (** True if used. Initially set to false*)
+}
+
+(** {b Variables.}
+ Each local or global variable is represented by a unique {!Cil.varinfo}
+structure. A global {!Cil.varinfo} can be introduced with the [GVarDecl] or
+[GVar] or [GFun] globals. A local varinfo can be introduced as part of a
+function definition {!Cil.fundec}.
+
+ All references to a given global or local variable must refer to the same
+copy of the [varinfo]. Each [varinfo] has a globally unique identifier that
+can be used to index maps and hashtables (the name can also be used for this
+purpose, except for locals from different functions). This identifier is
+constructor using a global counter.
+
+ It is very important that you construct [varinfo] structures using only one
+ of the following functions:
+- {!Cil.makeGlobalVar} : to make a global variable
+- {!Cil.makeTempVar} : to make a temporary local variable whose name
+will be generated so that to avoid conflict with other locals.
+- {!Cil.makeLocalVar} : like {!Cil.makeTempVar} but you can specify the
+exact name to be used.
+- {!Cil.copyVarinfo}: make a shallow copy of a varinfo assigning a new name
+and a new unique identifier
+
+ A [varinfo] is also used in a function type to denote the list of formals.
+
+*)
+
+(** Information about a variable. *)
+and varinfo = {
+ mutable vname: string;
+ (** The name of the variable. Cannot be empty. It is primarily your
+ * responsibility to ensure the uniqueness of a variable name. For local
+ * variables {!Cil.makeTempVar} helps you ensure that the name is unique.
+ *)
+
+ mutable vtype: typ;
+ (** The declared type of the variable. *)
+
+ mutable vattr: attributes;
+ (** A list of attributes associated with the variable.*)
+ mutable vstorage: storage;
+ (** The storage-class *)
+
+ mutable vglob: bool;
+ (** True if this is a global variable*)
+
+ mutable vinline: bool;
+ (** Whether this varinfo is for an inline function. *)
+
+ mutable vdecl: location;
+ (** Location of variable declaration. *)
+
+ mutable vid: int;
+ (** A unique integer identifier. This field will be
+ * set for you if you use one of the {!Cil.makeFormalVar},
+ * {!Cil.makeLocalVar}, {!Cil.makeTempVar}, {!Cil.makeGlobalVar}, or
+ * {!Cil.copyVarinfo}. *)
+
+ mutable vaddrof: bool;
+ (** True if the address of this variable is taken. CIL will set these
+ * flags when it parses C, but you should make sure to set the flag
+ * whenever your transformation create [AddrOf] expression. *)
+
+ mutable vreferenced: bool;
+ (** True if this variable is ever referenced. This is computed by
+ * [removeUnusedVars]. It is safe to just initialize this to False *)
+}
+
+(** Storage-class information *)
+and storage =
+ NoStorage (** The default storage. Nothing is printed *)
+ | Static
+ | Register
+ | Extern
+
+
+(** {b Expressions.} The CIL expression language contains only the side-effect free expressions of
+C. They are represented as the type {!Cil.exp}. There are several
+interesting aspects of CIL expressions:
+
+ Integer and floating point constants can carry their textual representation.
+This way the integer 15 can be printed as 0xF if that is how it occurred in the
+source.
+
+ CIL uses 64 bits to represent the integer constants and also stores the width
+of the integer type. Care must be taken to ensure that the constant is
+representable with the given width. Use the functions {!Cil.kinteger},
+{!Cil.kinteger64} and {!Cil.integer} to construct constant
+expressions. CIL predefines the constants {!Cil.zero},
+{!Cil.one} and {!Cil.mone} (for -1).
+
+ Use the functions {!Cil.isConstant} and {!Cil.isInteger} to test if
+an expression is a constant and a constant integer respectively.
+
+ CIL keeps the type of all unary and binary expressions. You can think of that
+type qualifying the operator. Furthermore there are different operators for
+arithmetic and comparisons on arithmetic types and on pointers.
+
+ Another unusual aspect of CIL is that the implicit conversion between an
+expression of array type and one of pointer type is made explicit, using the
+[StartOf] expression constructor (which is not printed). If you apply the
+[AddrOf}]constructor to an lvalue of type [T] then you will be getting an
+expression of type [TPtr(T)].
+
+ You can find the type of an expression with {!Cil.typeOf}.
+
+ You can perform constant folding on expressions using the function
+{!Cil.constFold}.
+*)
+
+(** Expressions (Side-effect free)*)
+and exp =
+ Const of constant (** Constant *)
+ | Lval of lval (** Lvalue *)
+ | SizeOf of typ
+ (** sizeof(<type>). Has [unsigned int] type (ISO 6.5.3.4). This is not
+ * turned into a constant because some transformations might want to
+ * change types *)
+
+ | SizeOfE of exp
+ (** sizeof(<expression>) *)
+
+ | SizeOfStr of string
+ (** sizeof(string_literal). We separate this case out because this is the
+ * only instance in which a string literal should not be treated as
+ * having type pointer to character. *)
+
+ | AlignOf of typ
+ (** This corresponds to the GCC __alignof_. Has [unsigned int] type *)
+ | AlignOfE of exp
+
+
+ | UnOp of unop * exp * typ
+ (** Unary operation. Includes the type of the result. *)
+
+ | BinOp of binop * exp * exp * typ
+ (** Binary operation. Includes the type of the result. The arithmetic
+ * conversions are made explicit for the arguments. *)
+
+ | CastE of typ * exp
+ (** Use {!Cil.mkCast} to make casts. *)
+
+ | AddrOf of lval
+ (** Always use {!Cil.mkAddrOf} to construct one of these. Apply to an
+ * lvalue of type [T] yields an expression of type [TPtr(T)] *)
+
+ | StartOf of lval
+ (** Conversion from an array to a pointer to the beginning of the array.
+ * Given an lval of type [TArray(T)] produces an expression of type
+ * [TPtr(T)]. In C this operation is implicit, the [StartOf] operator is
+ * not printed. We have it in CIL because it makes the typing rules
+ * simpler. *)
+
+(** {b Constants.} *)
+
+(** Literal constants *)
+and constant =
+ | CInt64 of int64 * ikind * string option
+ (** Integer constant. Give the ikind (see ISO9899 6.1.3.2) and the
+ * textual representation, if available. (This allows us to print a
+ * constant as, for example, 0xF instead of 15.) Use {!Cil.integer} or
+ * {!Cil.kinteger} to create these. Watch out for integers that cannot be
+ * represented on 64 bits. OCAML does not give Overflow exceptions. *)
+ | CStr of string
+ (* String constant. The escape characters inside the string have been
+ * already interpreted. This constant has pointer to character type! The
+ * only case when you would like a string literal to have an array type
+ * is when it is an argument to sizeof. In that case you should use
+ * SizeOfStr. *)
+ | CWStr of int64 list
+ (* Wide character string constant. Note that the local interpretation
+ * of such a literal depends on {!Cil.wcharType} and {!Cil.wcharKind}.
+ * Such a constant has type pointer to {!Cil.wcharType}. The
+ * escape characters in the string have not been "interpreted" in
+ * the sense that L"A\xabcd" remains "A\xabcd" rather than being
+ * represented as the wide character list with two elements: 65 and
+ * 43981. That "interpretation" depends on the underlying wide
+ * character type. *)
+ | CChr of char
+ (** Character constant. This has type int, so use charConstToInt
+ * to read the value in case sign-extension is needed. *)
+ | CReal of float * fkind * string option
+ (** Floating point constant. Give the fkind (see ISO 6.4.4.2) and also
+ * the textual representation, if available. *)
+ | CEnum of exp * string * enuminfo
+ (** An enumeration constant with the given value, name, from the given
+ * enuminfo. This is used only if {!Cil.lowerConstants} is true
+ * (default). Use {!Cil.constFoldVisitor} to replace these with integer
+ * constants. *)
+
+(** Unary operators *)
+and unop =
+ Neg (** Unary minus *)
+ | BNot (** Bitwise complement (~) *)
+ | LNot (** Logical Not (!) *)
+
+(** Binary operations *)
+and binop =
+ PlusA (** arithmetic + *)
+ | PlusPI (** pointer + integer *)
+ | IndexPI (** pointer + integer but only when
+ * it arises from an expression
+ * [e\[i\]] when [e] is a pointer and
+ * not an array. This is semantically
+ * the same as PlusPI but CCured uses
+ * this as a hint that the integer is
+ * probably positive. *)
+ | MinusA (** arithmetic - *)
+ | MinusPI (** pointer - integer *)
+ | MinusPP (** pointer - pointer *)
+ | Mult (** * *)
+ | Div (** / *)
+ | Mod (** % *)
+ | Shiftlt (** shift left *)
+ | Shiftrt (** shift right *)
+
+ | Lt (** < (arithmetic comparison) *)
+ | Gt (** > (arithmetic comparison) *)
+ | Le (** <= (arithmetic comparison) *)
+ | Ge (** > (arithmetic comparison) *)
+ | Eq (** == (arithmetic comparison) *)
+ | Ne (** != (arithmetic comparison) *)
+ | BAnd (** bitwise and *)
+ | BXor (** exclusive-or *)
+ | BOr (** inclusive-or *)
+
+ | LAnd (** logical and. Unlike other
+ * expressions this one does not
+ * always evaluate both operands. If
+ * you want to use these, you must
+ * set {!Cil.useLogicalOperators}. *)
+ | LOr (** logical or. Unlike other
+ * expressions this one does not
+ * always evaluate both operands. If
+ * you want to use these, you must
+ * set {!Cil.useLogicalOperators}. *)
+
+(** {b Lvalues.} Lvalues are the sublanguage of expressions that can appear at the left of an assignment or as operand to the address-of operator.
+In C the syntax for lvalues is not always a good indication of the meaning
+of the lvalue. For example the C value
+{v
+a[0][1][2]
+ v}
+ might involve 1, 2 or 3 memory reads when used in an expression context,
+depending on the declared type of the variable [a]. If [a] has type [int
+\[4\]\[4\]\[4\]] then we have one memory read from somewhere inside the area
+that stores the array [a]. On the other hand if [a] has type [int ***] then
+the expression really means [* ( * ( * (a + 0) + 1) + 2)], in which case it is
+clear that it involves three separate memory operations.
+
+An lvalue denotes the contents of a range of memory addresses. This range
+is denoted as a host object along with an offset within the object. The
+host object can be of two kinds: a local or global variable, or an object
+whose address is in a pointer expression. We distinguish the two cases so
+that we can tell quickly whether we are accessing some component of a
+variable directly or we are accessing a memory location through a pointer.
+To make it easy to
+tell what an lvalue means CIL represents lvalues as a host object and an
+offset (see {!Cil.lval}). The host object (represented as
+{!Cil.lhost}) can be a local or global variable or can be the object
+pointed-to by a pointer expression. The offset (represented as
+{!Cil.offset}) is a sequence of field or array index designators.
+
+ Both the typing rules and the meaning of an lvalue is very precisely
+specified in CIL.
+
+ The following are a few useful function for operating on lvalues:
+- {!Cil.mkMem} - makes an lvalue of [Mem] kind. Use this to ensure
+that certain equivalent forms of lvalues are canonized.
+For example, [*&x = x].
+- {!Cil.typeOfLval} - the type of an lvalue
+- {!Cil.typeOffset} - the type of an offset, given the type of the
+host.
+- {!Cil.addOffset} and {!Cil.addOffsetLval} - extend sequences
+of offsets.
+- {!Cil.removeOffset} and {!Cil.removeOffsetLval} - shrink sequences
+of offsets.
+
+The following equivalences hold {v
+Mem(AddrOf(Mem a, aoff)), off = Mem a, aoff + off
+Mem(AddrOf(Var v, aoff)), off = Var v, aoff + off
+AddrOf (Mem a, NoOffset) = a
+ v}
+
+*)
+(** An lvalue *)
+and lval =
+ lhost * offset
+
+(** The host part of an {!Cil.lval}. *)
+and lhost =
+ | Var of varinfo
+ (** The host is a variable. *)
+
+ | Mem of exp
+ (** The host is an object of type [T] when the expression has pointer
+ * [TPtr(T)]. *)
+
+
+(** The offset part of an {!Cil.lval}. Each offset can be applied to certain
+ * kinds of lvalues and its effect is that it advances the starting address
+ * of the lvalue and changes the denoted type, essentially focusing to some
+ * smaller lvalue that is contained in the original one. *)
+and offset =
+ | NoOffset (** No offset. Can be applied to any lvalue and does
+ * not change either the starting address or the type.
+ * This is used when the lval consists of just a host
+ * or as a terminator in a list of other kinds of
+ * offsets. *)
+
+ | Field of fieldinfo * offset
+ (** A field offset. Can be applied only to an lvalue
+ * that denotes a structure or a union that contains
+ * the mentioned field. This advances the offset to the
+ * beginning of the mentioned field and changes the
+ * type to the type of the mentioned field. *)
+
+ | Index of exp * offset
+ (** An array index offset. Can be applied only to an
+ * lvalue that denotes an array. This advances the
+ * starting address of the lval to the beginning of the
+ * mentioned array element and changes the denoted type
+ * to be the type of the array element *)
+
+
+(** {b Initializers.}
+A special kind of expressions are those that can appear as initializers for
+global variables (initialization of local variables is turned into
+assignments). The initializers are represented as type {!Cil.init}. You
+can create initializers with {!Cil.makeZeroInit} and you can conveniently
+scan compound initializers them with {!Cil.foldLeftCompound} or with {!Cil.foldLeftCompoundAll}.
+*)
+(** Initializers for global variables. *)
+and init =
+ | SingleInit of exp (** A single initializer *)
+ | CompoundInit of typ * (offset * init) list
+ (** Used only for initializers of structures, unions and arrays. The
+ * offsets are all of the form [Field(f, NoOffset)] or [Index(i,
+ * NoOffset)] and specify the field or the index being initialized. For
+ * structures all fields must have an initializer (except the unnamed
+ * bitfields), in the proper order. This is necessary since the offsets
+ * are not printed. For unions there must be exactly one initializer. If
+ * the initializer is not for the first field then a field designator is
+ * printed, so you better be on GCC since MSVC does not understand this.
+ * For arrays, however, we allow you to give only a prefix of the
+ * initializers. You can scan an initializer list with
+ * {!Cil.foldLeftCompound} or with {!Cil.foldLeftCompoundAll}. *)
+
+
+(** We want to be able to update an initializer in a global variable, so we
+ * define it as a mutable field *)
+and initinfo = {
+ mutable init : init option;
+ }
+
+(** {b Function definitions.}
+A function definition is always introduced with a [GFun] constructor at the
+top level. All the information about the function is stored into a
+{!Cil.fundec}. Some of the information (e.g. its name, type,
+storage, attributes) is stored as a {!Cil.varinfo} that is a field of the
+[fundec]. To refer to the function from the expression language you must use
+the [varinfo].
+
+ The function definition contains, in addition to the body, a list of all the
+local variables and separately a list of the formals. Both kind of variables
+can be referred to in the body of the function. The formals must also be shared
+with the formals that appear in the function type. For that reason, to
+manipulate formals you should use the provided functions
+{!Cil.makeFormalVar} and {!Cil.setFormals} and {!Cil.makeFormalVar}.
+*)
+(** Function definitions. *)
+and fundec =
+ { mutable svar: varinfo;
+ (** Holds the name and type as a variable, so we can refer to it
+ * easily from the program. All references to this function either
+ * in a function call or in a prototype must point to the same
+ * [varinfo]. *)
+ mutable sformals: varinfo list;
+ (** Formals. These must be in the same order and with the same
+ * information as the formal information in the type of the function.
+ * Use {!Cil.setFormals} or
+ * {!Cil.setFunctionType} or {!Cil.makeFormalVar}
+ * to set these formals and ensure that they
+ * are reflected in the function type. Do not make copies of these
+ * because the body refers to them. *)
+ mutable slocals: varinfo list;
+ (** Locals. Does NOT include the sformals. Do not make copies of
+ * these because the body refers to them. *)
+ mutable smaxid: int; (** Max local id. Starts at 0. Used for
+ * creating the names of new temporary
+ * variables. Updated by
+ * {!Cil.makeLocalVar} and
+ * {!Cil.makeTempVar}. You can also use
+ * {!Cil.setMaxId} to set it after you
+ * have added the formals and locals. *)
+ mutable sbody: block; (** The function body. *)
+ mutable smaxstmtid: int option; (** max id of a (reachable) statement
+ * in this function, if we have
+ * computed it. range = 0 ...
+ * (smaxstmtid-1). This is computed by
+ * {!Cil.computeCFGInfo}. *)
+ mutable sallstmts: stmt list; (** After you call {!Cil.computeCFGInfo}
+ * this field is set to contain all
+ * statements in the function *)
+ }
+
+
+(** A block is a sequence of statements with the control falling through from
+ one element to the next *)
+and block =
+ { mutable battrs: attributes; (** Attributes for the block *)
+ mutable bstmts: stmt list; (** The statements comprising the block*)
+ }
+
+
+(** {b Statements}.
+CIL statements are the structural elements that make the CFG. They are
+represented using the type {!Cil.stmt}. Every
+statement has a (possibly empty) list of labels. The
+{!Cil.stmtkind} field of a statement indicates what kind of statement it
+is.
+
+ Use {!Cil.mkStmt} to make a statement and the fill-in the fields.
+
+CIL also comes with support for control-flow graphs. The [sid] field in
+[stmt] can be used to give unique numbers to statements, and the [succs]
+and [preds] fields can be used to maintain a list of successors and
+predecessors for every statement. The CFG information is not computed by
+default. Instead you must explicitly use the functions
+{!Cil.prepareCFG} and {!Cil.computeCFGInfo} to do it.
+
+*)
+(** Statements. *)
+and stmt = {
+ mutable labels: label list;
+ (** Whether the statement starts with some labels, case statements or
+ * default statements. *)
+
+ mutable skind: stmtkind;
+ (** The kind of statement *)
+
+ mutable sid: int;
+ (** A number (>= 0) that is unique in a function. Filled in only after
+ * the CFG is computed. *)
+ mutable succs: stmt list;
+ (** The successor statements. They can always be computed from the skind
+ * and the context in which this statement appears. Filled in only after
+ * the CFG is computed. *)
+ mutable preds: stmt list;
+ (** The inverse of the succs function. *)
+ }
+
+(** Labels *)
+and label =
+ Label of string * location * bool
+ (** A real label. If the bool is "true", the label is from the
+ * input source program. If the bool is "false", the label was
+ * created by CIL or some other transformation *)
+ | Case of exp * location (** A case statement. This expression
+ * is lowered into a constant if
+ * {!Cil.lowerConstants} is set to
+ * true. *)
+ | Default of location (** A default statement *)
+
+
+
+(** The various kinds of control-flow statements statements *)
+and stmtkind =
+ | Instr of instr list
+ (** A group of instructions that do not contain control flow. Control
+ * implicitly falls through. *)
+
+ | Return of exp option * location
+ (** The return statement. This is a leaf in the CFG. *)
+
+ | Goto of stmt ref * location
+ (** A goto statement. Appears from actual goto's in the code or from
+ * goto's that have been inserted during elaboration. The reference
+ * points to the statement that is the target of the Goto. This means that
+ * you have to update the reference whenever you replace the target
+ * statement. The target statement MUST have at least a label. *)
+
+ | Break of location
+ (** A break to the end of the nearest enclosing loop or Switch *)
+
+ | Continue of location
+ (** A continue to the start of the nearest enclosing loop *)
+ | If of exp * block * block * location
+ (** A conditional. Two successors, the "then" and the "else" branches.
+ * Both branches fall-through to the successor of the If statement. *)
+
+ | Switch of exp * block * (stmt list) * location
+ (** A switch statement. The statements that implement the cases can be
+ * reached through the provided list. For each such target you can find
+ * among its labels what cases it implements. The statements that
+ * implement the cases are somewhere within the provided [block]. *)
+
+(*
+ | Loop of block * location * (stmt option) * (stmt option)
+ (** A [while(1)] loop. The termination test is implemented in the body of
+ * a loop using a [Break] statement. If prepareCFG has been called,
+ * the first stmt option will point to the stmt containing the continue
+ * label for this loop and the second will point to the stmt containing
+ * the break label for this loop. *)
+*)
+
+ | While of exp * block * location
+ (** A [while] loop. *)
+
+ | DoWhile of exp * block * location
+ (** A [do...while] loop. *)
+
+ | For of block * exp * block * block * location
+ (** A [for] loop. *)
+
+ | Block of block
+ (** Just a block of statements. Use it as a way to keep some block
+ * attributes local *)
+
+ (** On MSVC we support structured exception handling. This is what you
+ * might expect. Control can get into the finally block either from the
+ * end of the body block, or if an exception is thrown. *)
+ | TryFinally of block * block * location
+
+ (** On MSVC we support structured exception handling. The try/except
+ * statement is a bit tricky:
+ [__try { blk }
+ __except (e) {
+ handler
+ }]
+
+ The argument to __except must be an expression. However, we keep a
+ list of instructions AND an expression in case you need to make
+ function calls. We'll print those as a comma expression. The control
+ can get to the __except expression only if an exception is thrown.
+ After that, depending on the value of the expression the control
+ goes to the handler, propagates the exception, or retries the
+ exception !!!
+ *)
+ | TryExcept of block * (instr list * exp) * block * location
+
+
+(** {b Instructions}.
+ An instruction {!Cil.instr} is a statement that has no local
+(intraprocedural) control flow. It can be either an assignment,
+function call, or an inline assembly instruction. *)
+
+(** Instructions. *)
+and instr =
+ Set of lval * exp * location
+ (** An assignment. The type of the expression is guaranteed to be the same
+ * with that of the lvalue *)
+ | Call of lval option * exp * exp list * location
+ (** A function call with the (optional) result placed in an lval. It is
+ * possible that the returned type of the function is not identical to
+ * that of the lvalue. In that case a cast is printed. The type of the
+ * actual arguments are identical to those of the declared formals. The
+ * number of arguments is the same as that of the declared formals, except
+ * for vararg functions. This construct is also used to encode a call to
+ * "__builtin_va_arg". In this case the second argument (which should be a
+ * type T) is encoded SizeOf(T) *)
+
+ | Asm of attributes * (* Really only const and volatile can appear
+ * here *)
+ string list * (* templates (CR-separated) *)
+ (string * lval) list * (* outputs must be lvals with
+ * constraints. I would like these
+ * to be actually variables, but I
+ * run into some trouble with ASMs
+ * in the Linux sources *)
+ (string * exp) list * (* inputs with constraints *)
+ string list * (* register clobbers *)
+ location
+ (** There are for storing inline assembly. They follow the GCC
+ * specification:
+{v
+ asm [volatile] ("...template..." "..template.."
+ : "c1" (o1), "c2" (o2), ..., "cN" (oN)
+ : "d1" (i1), "d2" (i2), ..., "dM" (iM)
+ : "r1", "r2", ..., "nL" );
+ v}
+
+where the parts are
+
+ - [volatile] (optional): when present, the assembler instruction
+ cannot be removed, moved, or otherwise optimized
+ - template: a sequence of strings, with %0, %1, %2, etc. in the string to
+ refer to the input and output expressions. I think they're numbered
+ consecutively, but the docs don't specify. Each string is printed on
+ a separate line. This is the only part that is present for MSVC inline
+ assembly.
+ - "ci" (oi): pairs of constraint-string and output-lval; the
+ constraint specifies that the register used must have some
+ property, like being a floating-point register; the constraint
+ string for outputs also has "=" to indicate it is written, or
+ "+" to indicate it is both read and written; 'oi' is the
+ name of a C lvalue (probably a variable name) to be used as
+ the output destination
+ - "dj" (ij): pairs of constraint and input expression; the constraint
+ is similar to the "ci"s. the 'ij' is an arbitrary C expression
+ to be loaded into the corresponding register
+ - "rk": registers to be regarded as "clobbered" by the instruction;
+ "memory" may be specified for arbitrary memory effects
+
+an example (from gcc manual):
+{v
+ asm volatile ("movc3 %0,%1,%2"
+ : /* no outputs */
+ : "g" (from), "g" (to), "g" (count)
+ : "r0", "r1", "r2", "r3", "r4", "r5");
+ v}
+*)
+
+(** Describes a location in a source file. *)
+and location = {
+ line: int; (** The line number. -1 means "do not know" *)
+ file: string; (** The name of the source file*)
+ byte: int; (** The byte position in the source file *)
+}
+
+
+(** Type signatures. Two types are identical iff they have identical
+ * signatures. These contain the same information as types but canonicalized.
+ * For example, two function types that are identical except for the name of
+ * the formal arguments are given the same signature. Also, [TNamed]
+ * constructors are unrolled. *)
+and typsig =
+ TSArray of typsig * int64 option * attribute list
+ | TSPtr of typsig * attribute list
+ | TSComp of bool * string * attribute list
+ | TSFun of typsig * typsig list * bool * attribute list
+ | TSEnum of string * attribute list
+ | TSBase of typ
+
+
+
+(** {b Lowering Options} *)
+
+val lowerConstants: bool ref
+ (** Do lower constants (default true) *)
+
+val insertImplicitCasts: bool ref
+ (** Do insert implicit casts (default true) *)
+
+(** To be able to add/remove features easily, each feature should be package
+ * as an interface with the following interface. These features should be *)
+type featureDescr = {
+ fd_enabled: bool ref;
+ (** The enable flag. Set to default value *)
+
+ fd_name: string;
+ (** This is used to construct an option "--doxxx" and "--dontxxx" that
+ * enable and disable the feature *)
+
+ fd_description: string;
+ (* A longer name that can be used to document the new options *)
+
+ fd_extraopt: (string * Arg.spec * string) list;
+ (** Additional command line options *)
+
+ fd_doit: (file -> unit);
+ (** This performs the transformation *)
+
+ fd_post_check: bool;
+ (* Whether to perform a CIL consistency checking after this stage, if
+ * checking is enabled (--check is passed to cilly). Set this to true if
+ * your feature makes any changes for the program. *)
+}
+
+(** Comparison function for locations.
+ ** Compares first by filename, then line, then byte *)
+val compareLoc: location -> location -> int
+
+(** {b Values for manipulating globals} *)
+
+(** Make an empty function *)
+val emptyFunction: string -> fundec
+
+(** Update the formals of a [fundec] and make sure that the function type
+ has the same information. Will copy the name as well into the type. *)
+val setFormals: fundec -> varinfo list -> unit
+
+(** Set the types of arguments and results as given by the function type
+ * passed as the second argument. Will not copy the names from the function
+ * type to the formals *)
+val setFunctionType: fundec -> typ -> unit
+
+
+(** Set the type of the function and make formal arguments for them *)
+val setFunctionTypeMakeFormals: fundec -> typ -> unit
+
+(** Update the smaxid after you have populated with locals and formals
+ * (unless you constructed those using {!Cil.makeLocalVar} or
+ * {!Cil.makeTempVar}. *)
+val setMaxId: fundec -> unit
+
+(** A dummy function declaration handy when you need one as a placeholder. It
+ * contains inside a dummy varinfo. *)
+val dummyFunDec: fundec
+
+(** A dummy file *)
+val dummyFile: file
+
+(** Write a {!Cil.file} in binary form to the filesystem. The file can be
+ * read back in later using {!Cil.loadBinaryFile}, possibly saving parsing
+ * time. The second argument is the name of the file that should be
+ * created. *)
+val saveBinaryFile : file -> string -> unit
+
+(** Write a {!Cil.file} in binary form to the filesystem. The file can be
+ * read back in later using {!Cil.loadBinaryFile}, possibly saving parsing
+ * time. Does not close the channel. *)
+val saveBinaryFileChannel : file -> out_channel -> unit
+
+(** Read a {!Cil.file} in binary form from the filesystem. The first
+ * argument is the name of a file previously created by
+ * {!Cil.saveBinaryFile}. *)
+val loadBinaryFile : string -> file
+
+(** Get the global initializer and create one if it does not already exist.
+ * When it creates a global initializer it attempts to place a call to it in
+ * the main function named by the optional argument (default "main") *)
+val getGlobInit: ?main_name:string -> file -> fundec
+
+(** Iterate over all globals, including the global initializer *)
+val iterGlobals: file -> (global -> unit) -> unit
+
+(** Fold over all globals, including the global initializer *)
+val foldGlobals: file -> ('a -> global -> 'a) -> 'a -> 'a
+
+(** Map over all globals, including the global initializer and change things
+ in place *)
+val mapGlobals: file -> (global -> global) -> unit
+
+val new_sid : unit -> int
+
+(** Prepare a function for CFG information computation by
+ * {!Cil.computeCFGInfo}. This function converts all [Break], [Switch],
+ * [Default] and [Continue] {!Cil.stmtkind}s and {!Cil.label}s into [If]s
+ * and [Goto]s, giving the function body a very CFG-like character. This
+ * function modifies its argument in place. *)
+val prepareCFG: fundec -> unit
+
+(** Compute the CFG information for all statements in a fundec and return a
+ * list of the statements. The input fundec cannot have [Break], [Switch],
+ * [Default], or [Continue] {!Cil.stmtkind}s or {!Cil.label}s. Use
+ * {!Cil.prepareCFG} to transform them away. The second argument should
+ * be [true] if you wish a global statement number, [false] if you wish a
+ * local (per-function) statement numbering. The list of statements is set
+ * in the sallstmts field of a fundec.
+ *
+ * NOTE: unless you want the simpler control-flow graph provided by
+ * prepareCFG, or you need the function's smaxstmtid and sallstmt fields
+ * filled in, we recommend you use {!Cfg.computeFileCFG} instead of this
+ * function to compute control-flow information.
+ * {!Cfg.computeFileCFG} is newer and will handle switch, break, and
+ * continue correctly.*)
+val computeCFGInfo: fundec -> bool -> unit
+
+
+(** Create a deep copy of a function. There should be no sharing between the
+ * copy and the original function *)
+val copyFunction: fundec -> string -> fundec
+
+
+(** CIL keeps the types at the beginning of the file and the variables at the
+ * end of the file. This function will take a global and add it to the
+ * corresponding stack. Its operation is actually more complicated because if
+ * the global declares a type that contains references to variables (e.g. in
+ * sizeof in an array length) then it will also add declarations for the
+ * variables to the types stack *)
+val pushGlobal: global -> types: global list ref
+ -> variables: global list ref -> unit
+
+(** An empty statement. Used in pretty printing *)
+val invalidStmt: stmt
+
+(** A list of the GCC built-in functions. Maps the name to the result and
+ * argument types, and whether it is vararg *)
+val gccBuiltins: (string, typ * typ list * bool) Hashtbl.t
+
+
+(** A list of the MSVC built-in functions. Maps the name to the result and
+ * argument types, and whether it is vararg *)
+val msvcBuiltins: (string, typ * typ list * bool) Hashtbl.t
+
+(** {b Values for manipulating initializers} *)
+
+
+(** Make a initializer for zero-ing a data type *)
+val makeZeroInit: typ -> init
+
+
+(** Fold over the list of initializers in a Compound. [doinit] is called on
+ * every present initializer, even if it is of compound type. In the case of
+ * arrays there might be missing zero-initializers at the end of the list.
+ * These are not scanned. This is much like [List.fold_left] except we also
+ * pass the type of the initializer *)
+val foldLeftCompound:
+ doinit: (offset -> init -> typ -> 'a -> 'a) ->
+ ct: typ ->
+ initl: (offset * init) list ->
+ acc: 'a -> 'a
+
+
+(** Fold over the list of initializers in a Compound, like
+ * {!Cil.foldLeftCompound} but in the case of an array it scans even missing
+ * zero initializers at the end of the array *)
+val foldLeftCompoundAll:
+ doinit: (offset -> init -> typ -> 'a -> 'a) ->
+ ct: typ ->
+ initl: (offset * init) list ->
+ acc: 'a -> 'a
+
+
+
+(** {b Values for manipulating types} *)
+
+(** void *)
+val voidType: typ
+
+(* is the given type "void"? *)
+val isVoidType: typ -> bool
+
+(* is the given type "void *"? *)
+val isVoidPtrType: typ -> bool
+
+(** int *)
+val intType: typ
+
+(** unsigned int *)
+val uintType: typ
+
+(** long *)
+val longType: typ
+
+(** unsigned long *)
+val ulongType: typ
+
+(** char *)
+val charType: typ
+
+(** char * *)
+val charPtrType: typ
+
+(** wchar_t (depends on architecture) and is set when you call
+ * {!Cil.initCIL}. *)
+val wcharKind: ikind ref
+val wcharType: typ ref
+
+(** char const * *)
+val charConstPtrType: typ
+
+(** void * *)
+val voidPtrType: typ
+
+(** int * *)
+val intPtrType: typ
+
+(** unsigned int * *)
+val uintPtrType: typ
+
+(** double *)
+val doubleType: typ
+
+(* An unsigned integer type that fits pointers. Depends on {!Cil.msvcMode}
+ * and is set when you call {!Cil.initCIL}. *)
+val upointType: typ ref
+
+(* An unsigned integer type that is the type of sizeof. Depends on
+ * {!Cil.msvcMode} and is set when you call {!Cil.initCIL}. *)
+val typeOfSizeOf: typ ref
+
+(** Returns true if and only if the given integer type is signed. *)
+val isSigned: ikind -> bool
+
+
+(** Creates a a (potentially recursive) composite type. The arguments are:
+ * (1) a boolean indicating whether it is a struct or a union, (2) the name
+ * (always non-empty), (3) a function that when given a representation of the
+ * structure type constructs the type of the fields recursive type (the first
+ * argument is only useful when some fields need to refer to the type of the
+ * structure itself), and (4) a list of attributes to be associated with the
+ * composite type. The resulting compinfo has the field "cdefined" only if
+ * the list of fields is non-empty. *)
+val mkCompInfo: bool -> (* whether it is a struct or a union *)
+ string -> (* name of the composite type; cannot be empty *)
+ (compinfo ->
+ (string * typ * int option * attributes * location) list) ->
+ (* a function that when given a forward
+ representation of the structure type constructs the type of
+ the fields. The function can ignore this argument if not
+ constructing a recursive type. *)
+ attributes -> compinfo
+
+(** Makes a shallow copy of a {!Cil.compinfo} changing the name and the key.*)
+val copyCompInfo: compinfo -> string -> compinfo
+
+(** This is a constant used as the name of an unnamed bitfield. These fields
+ do not participate in initialization and their name is not printed. *)
+val missingFieldName: string
+
+(** Get the full name of a comp *)
+val compFullName: compinfo -> string
+
+(** Returns true if this is a complete type.
+ This means that sizeof(t) makes sense.
+ Incomplete types are not yet defined
+ structures and empty arrays. *)
+val isCompleteType: typ -> bool
+
+(** Unroll a type until it exposes a non
+ * [TNamed]. Will collect all attributes appearing in [TNamed]!!! *)
+val unrollType: typ -> typ
+
+(** Unroll all the TNamed in a type (even under type constructors such as
+ * [TPtr], [TFun] or [TArray]. Does not unroll the types of fields in [TComp]
+ * types. Will collect all attributes *)
+val unrollTypeDeep: typ -> typ
+
+(** Separate out the storage-modifier name attributes *)
+val separateStorageModifiers: attribute list -> attribute list * attribute list
+
+(** True if the argument is an integral type (i.e. integer or enum) *)
+val isIntegralType: typ -> bool
+
+(** True if the argument is an arithmetic type (i.e. integer, enum or
+ floating point *)
+val isArithmeticType: typ -> bool
+
+(**True if the argument is a pointer type *)
+val isPointerType: typ -> bool
+
+(** True if the argument is a function type *)
+val isFunctionType: typ -> bool
+
+(** Obtain the argument list ([] if None) *)
+val argsToList: (string * typ * attributes) list option
+ -> (string * typ * attributes) list
+
+(** True if the argument is an array type *)
+val isArrayType: typ -> bool
+
+(** Raised when {!Cil.lenOfArray} fails either because the length is [None]
+ * or because it is a non-constant expression *)
+exception LenOfArray
+
+(** Call to compute the array length as present in the array type, to an
+ * integer. Raises {!Cil.LenOfArray} if not able to compute the length, such
+ * as when there is no length or the length is not a constant. *)
+val lenOfArray: exp option -> int
+
+(** Return a named fieldinfo in compinfo, or raise Not_found *)
+val getCompField: compinfo -> string -> fieldinfo
+
+
+(** A datatype to be used in conjunction with [existsType] *)
+type existsAction =
+ ExistsTrue (* We have found it *)
+ | ExistsFalse (* Stop processing this branch *)
+ | ExistsMaybe (* This node is not what we are
+ * looking for but maybe its
+ * successors are *)
+
+(** Scans a type by applying the function on all elements.
+ When the function returns ExistsTrue, the scan stops with
+ true. When the function returns ExistsFalse then the current branch is not
+ scanned anymore. Care is taken to
+ apply the function only once on each composite type, thus avoiding
+ circularity. When the function returns ExistsMaybe then the types that
+ construct the current type are scanned (e.g. the base type for TPtr and
+ TArray, the type of fields for a TComp, etc). *)
+val existsType: (typ -> existsAction) -> typ -> bool
+
+
+(** Given a function type split it into return type,
+ * arguments, is_vararg and attributes. An error is raised if the type is not
+ * a function type *)
+val splitFunctionType:
+ typ -> typ * (string * typ * attributes) list option * bool * attributes
+(** Same as {!Cil.splitFunctionType} but takes a varinfo. Prints a nicer
+ * error message if the varinfo is not for a function *)
+val splitFunctionTypeVI:
+ varinfo -> typ * (string * typ * attributes) list option * bool * attributes
+
+
+(** {b Type signatures} *)
+
+(** Type signatures. Two types are identical iff they have identical
+ * signatures. These contain the same information as types but canonicalized.
+ * For example, two function types that are identical except for the name of
+ * the formal arguments are given the same signature. Also, [TNamed]
+ * constructors are unrolled. You shoud use [Util.equals] to compare type
+ * signatures because they might still contain circular structures (through
+ * attributes, and sizeof) *)
+
+(** Print a type signature *)
+val d_typsig: unit -> typsig -> Pretty.doc
+
+(** Compute a type signature *)
+val typeSig: typ -> typsig
+
+(** Like {!Cil.typeSig} but customize the incorporation of attributes.
+ Use ~ignoreSign:true to convert all signed integer types to unsigned,
+ so that signed and unsigned will compare the same. *)
+val typeSigWithAttrs: ?ignoreSign:bool -> (attributes -> attributes) -> typ -> typsig
+
+(** Replace the attributes of a signature (only at top level) *)
+val setTypeSigAttrs: attributes -> typsig -> typsig
+
+(** Get the top-level attributes of a signature *)
+val typeSigAttrs: typsig -> attributes
+
+(*********************************************************)
+(** LVALUES *)
+
+(** Make a varinfo. Use this (rarely) to make a raw varinfo. Use other
+ * functions to make locals ({!Cil.makeLocalVar} or {!Cil.makeFormalVar} or
+ * {!Cil.makeTempVar}) and globals ({!Cil.makeGlobalVar}). Note that this
+ * function will assign a new identifier. The first argument specifies
+ * whether the varinfo is for a global. *)
+val makeVarinfo: bool -> string -> typ -> varinfo
+
+(** Make a formal variable for a function. Insert it in both the sformals
+ and the type of the function. You can optionally specify where to insert
+ this one. If where = "^" then it is inserted first. If where = "$" then
+ it is inserted last. Otherwise where must be the name of a formal after
+ which to insert this. By default it is inserted at the end. *)
+val makeFormalVar: fundec -> ?where:string -> string -> typ -> varinfo
+
+(** Make a local variable and add it to a function's slocals (only if insert =
+ true, which is the default). Make sure you know what you are doing if you
+ set insert=false. *)
+val makeLocalVar: fundec -> ?insert:bool -> string -> typ -> varinfo
+
+(** Make a temporary variable and add it to a function's slocals. The name of
+ the temporary variable will be generated based on the given name hint so
+ that to avoid conflicts with other locals. *)
+val makeTempVar: fundec -> ?name: string -> typ -> varinfo
+
+
+(** Make a global variable. Your responsibility to make sure that the name
+ is unique *)
+val makeGlobalVar: string -> typ -> varinfo
+
+(** Make a shallow copy of a [varinfo] and assign a new identifier *)
+val copyVarinfo: varinfo -> string -> varinfo
+
+
+(** Generate a new variable ID. This will be different than any variable ID
+ * that is generated by {!Cil.makeLocalVar} and friends *)
+val newVID: unit -> int
+
+(** Add an offset at the end of an lvalue. Make sure the type of the lvalue
+ * and the offset are compatible. *)
+val addOffsetLval: offset -> lval -> lval
+
+(** [addOffset o1 o2] adds [o1] to the end of [o2]. *)
+val addOffset: offset -> offset -> offset
+
+(** Remove ONE offset from the end of an lvalue. Returns the lvalue with the
+ * trimmed offset and the final offset. If the final offset is [NoOffset]
+ * then the original [lval] did not have an offset. *)
+val removeOffsetLval: lval -> lval * offset
+
+(** Remove ONE offset from the end of an offset sequence. Returns the
+ * trimmed offset and the final offset. If the final offset is [NoOffset]
+ * then the original [lval] did not have an offset. *)
+val removeOffset: offset -> offset * offset
+
+(** Compute the type of an lvalue *)
+val typeOfLval: lval -> typ
+
+(** Compute the type of an offset from a base type *)
+val typeOffset: typ -> offset -> typ
+
+
+(*******************************************************)
+(** {b Values for manipulating expressions} *)
+
+
+(* Construct integer constants *)
+
+(** 0 *)
+val zero: exp
+
+(** 1 *)
+val one: exp
+
+(** -1 *)
+val mone: exp
+
+
+(** Construct an integer of a given kind, using OCaml's int64 type. If needed
+ * it will truncate the integer to be within the representable range for the
+ * given kind. *)
+val kinteger64: ikind -> int64 -> exp
+
+(** Construct an integer of a given kind. Converts the integer to int64 and
+ * then uses kinteger64. This might truncate the value if you use a kind
+ * that cannot represent the given integer. This can only happen for one of
+ * the Char or Short kinds *)
+val kinteger: ikind -> int -> exp
+
+(** Construct an integer of kind IInt. You can use this always since the
+ OCaml integers are 31 bits and are guaranteed to fit in an IInt *)
+val integer: int -> exp
+
+
+(** True if the given expression is a (possibly cast'ed)
+ character or an integer constant *)
+val isInteger: exp -> int64 option
+
+(** True if the expression is a compile-time constant *)
+val isConstant: exp -> bool
+
+(** True if the given expression is a (possibly cast'ed) integer or character
+ constant with value zero *)
+val isZero: exp -> bool
+
+(** Given the character c in a (CChr c), sign-extend it to 32 bits.
+ (This is the official way of interpreting character constants, according to
+ ISO C 6.4.4.4.10, which says that character constants are chars cast to ints)
+ Returns CInt64(sign-extened c, IInt, None) *)
+val charConstToInt: char -> constant
+
+(** Do constant folding on an expression. If the first argument is true then
+ will also compute compiler-dependent expressions such as sizeof *)
+val constFold: bool -> exp -> exp
+
+(** Do constant folding on a binary operation. The bulk of the work done by
+ [constFold] is done here. If the first argument is true then
+ will also compute compiler-dependent expressions such as sizeof *)
+val constFoldBinOp: bool -> binop -> exp -> exp -> typ -> exp
+
+(** Increment an expression. Can be arithmetic or pointer type *)
+val increm: exp -> int -> exp
+
+
+(** Makes an lvalue out of a given variable *)
+val var: varinfo -> lval
+
+(** Make an AddrOf. Given an lvalue of type T will give back an expression of
+ type ptr(T). It optimizes somewhat expressions like "& v" and "& v[0]" *)
+val mkAddrOf: lval -> exp
+
+
+(** Like mkAddrOf except if the type of lval is an array then it uses
+ StartOf. This is the right operation for getting a pointer to the start
+ of the storage denoted by lval. *)
+val mkAddrOrStartOf: lval -> exp
+
+(** Make a Mem, while optimizing AddrOf. The type of the addr must be
+ TPtr(t) and the type of the resulting lval is t. Note that in CIL the
+ implicit conversion between an array and the pointer to the first
+ element does not apply. You must do the conversion yourself using
+ StartOf *)
+val mkMem: addr:exp -> off:offset -> lval
+
+(** Make an expression that is a string constant (of pointer type) *)
+val mkString: string -> exp
+
+(** Construct a cast when having the old type of the expression. If the new
+ * type is the same as the old type, then no cast is added. *)
+val mkCastT: e:exp -> oldt:typ -> newt:typ -> exp
+
+(** Like {!Cil.mkCastT} but uses typeOf to get [oldt] *)
+val mkCast: e:exp -> newt:typ -> exp
+
+(** Removes casts from this expression, but ignores casts within
+ other expression constructs. So we delete the (A) and (B) casts from
+ "(A)(B)(x + (C)y)", but leave the (C) cast. *)
+val stripCasts: exp -> exp
+
+(** Compute the type of an expression *)
+val typeOf: exp -> typ
+
+(** Convert a string representing a C integer literal to an expression.
+ * Handles the prefixes 0x and 0 and the suffixes L, U, UL, LL, ULL *)
+val parseInt: string -> exp
+
+
+(**********************************************)
+(** {b Values for manipulating statements} *)
+
+(** Construct a statement, given its kind. Initialize the [sid] field to -1,
+ and [labels], [succs] and [preds] to the empty list *)
+val mkStmt: stmtkind -> stmt
+
+(** Construct a block with no attributes, given a list of statements *)
+val mkBlock: stmt list -> block
+
+(** Construct a statement consisting of just one instruction *)
+val mkStmtOneInstr: instr -> stmt
+
+(** Try to compress statements so as to get maximal basic blocks *)
+(* use this instead of List.@ because you get fewer basic blocks *)
+val compactStmts: stmt list -> stmt list
+
+(** Returns an empty statement (of kind [Instr]) *)
+val mkEmptyStmt: unit -> stmt
+
+(** A instr to serve as a placeholder *)
+val dummyInstr: instr
+
+(** A statement consisting of just [dummyInstr] *)
+val dummyStmt: stmt
+
+(** Make a while loop. Can contain Break or Continue *)
+val mkWhile: guard:exp -> body:stmt list -> stmt list
+
+(** Make a for loop for(i=start; i<past; i += incr) \{ ... \}. The body
+ can contain Break but not Continue. Can be used with i a pointer
+ or an integer. Start and done must have the same type but incr
+ must be an integer *)
+val mkForIncr: iter:varinfo -> first:exp -> stopat:exp -> incr:exp
+ -> body:stmt list -> stmt list
+
+(** Make a for loop for(start; guard; next) \{ ... \}. The body can
+ contain Break but not Continue !!! *)
+val mkFor: start:stmt list -> guard:exp -> next: stmt list ->
+ body: stmt list -> stmt list
+
+
+
+(**************************************************)
+(** {b Values for manipulating attributes} *)
+
+(** Various classes of attributes *)
+type attributeClass =
+ AttrName of bool
+ (** Attribute of a name. If argument is true and we are on MSVC then
+ the attribute is printed using __declspec as part of the storage
+ specifier *)
+ | AttrFunType of bool
+ (** Attribute of a function type. If argument is true and we are on
+ MSVC then the attribute is printed just before the function name *)
+ | AttrType (** Attribute of a type *)
+
+(** This table contains the mapping of predefined attributes to classes.
+ Extend this table with more attributes as you need. This table is used to
+ determine how to associate attributes with names or types *)
+val attributeHash: (string, attributeClass) Hashtbl.t
+
+(** Partition the attributes into classes:name attributes, function type,
+ and type attributes *)
+val partitionAttributes: default:attributeClass ->
+ attributes -> attribute list * (* AttrName *)
+ attribute list * (* AttrFunType *)
+ attribute list (* AttrType *)
+
+(** Add an attribute. Maintains the attributes in sorted order of the second
+ argument *)
+val addAttribute: attribute -> attributes -> attributes
+
+(** Add a list of attributes. Maintains the attributes in sorted order. The
+ second argument must be sorted, but not necessarily the first *)
+val addAttributes: attribute list -> attributes -> attributes
+
+(** Remove all attributes with the given name. Maintains the attributes in
+ sorted order. *)
+val dropAttribute: string -> attributes -> attributes
+
+(** Remove all attributes with names appearing in the string list.
+ * Maintains the attributes in sorted order *)
+val dropAttributes: string list -> attributes -> attributes
+
+(** Retains attributes with the given name *)
+val filterAttributes: string -> attributes -> attributes
+
+(** True if the named attribute appears in the attribute list. The list of
+ attributes must be sorted. *)
+val hasAttribute: string -> attributes -> bool
+
+(** Returns all the attributes contained in a type. This requires a traversal
+ of the type structure, in case of composite, enumeration and named types *)
+val typeAttrs: typ -> attribute list
+
+val setTypeAttrs: typ -> attributes -> typ (* Resets the attributes *)
+
+
+(** Add some attributes to a type *)
+val typeAddAttributes: attribute list -> typ -> typ
+
+(** Remove all attributes with the given names from a type. Note that this
+ does not remove attributes from typedef and tag definitions, just from
+ their uses *)
+val typeRemoveAttributes: string list -> typ -> typ
+
+
+(******************
+ ****************** VISITOR
+ ******************)
+(** {b The visitor} *)
+
+(** Different visiting actions. 'a will be instantiated with [exp], [instr],
+ etc. *)
+type 'a visitAction =
+ SkipChildren (** Do not visit the children. Return
+ the node as it is. *)
+ | DoChildren (** Continue with the children of this
+ node. Rebuild the node on return
+ if any of the children changes
+ (use == test) *)
+ | ChangeTo of 'a (** Replace the expression with the
+ given one *)
+ | ChangeDoChildrenPost of 'a * ('a -> 'a) (** First consider that the entire
+ exp is replaced by the first
+ parameter. Then continue with
+ the children. On return rebuild
+ the node if any of the children
+ has changed and then apply the
+ function on the node *)
+
+
+
+(** A visitor interface for traversing CIL trees. Create instantiations of
+ * this type by specializing the class {!Cil.nopCilVisitor}. Each of the
+ * specialized visiting functions can also call the [queueInstr] to specify
+ * that some instructions should be inserted before the current instruction
+ * or statement. Use syntax like [self#queueInstr] to call a method
+ * associated with the current object. *)
+class type cilVisitor = object
+ method vvdec: varinfo -> varinfo visitAction
+ (** Invoked for each variable declaration. The subtrees to be traversed
+ * are those corresponding to the type and attributes of the variable.
+ * Note that variable declarations are all the [GVar], [GVarDecl], [GFun],
+ * all the [varinfo] in formals of function types, and the formals and
+ * locals for function definitions. This means that the list of formals
+ * in a function definition will be traversed twice, once as part of the
+ * function type and second as part of the formals in a function
+ * definition. *)
+
+ method vvrbl: varinfo -> varinfo visitAction
+ (** Invoked on each variable use. Here only the [SkipChildren] and
+ * [ChangeTo] actions make sense since there are no subtrees. Note that
+ * the type and attributes of the variable are not traversed for a
+ * variable use *)
+
+ method vexpr: exp -> exp visitAction
+ (** Invoked on each expression occurrence. The subtrees are the
+ * subexpressions, the types (for a [Cast] or [SizeOf] expression) or the
+ * variable use. *)
+
+ method vlval: lval -> lval visitAction
+ (** Invoked on each lvalue occurrence *)
+
+ method voffs: offset -> offset visitAction
+ (** Invoked on each offset occurrence that is *not* as part
+ * of an initializer list specification, i.e. in an lval or
+ * recursively inside an offset. *)
+
+ method vinitoffs: offset -> offset visitAction
+ (** Invoked on each offset appearing in the list of a
+ * CompoundInit initializer. *)
+
+ method vinst: instr -> instr list visitAction
+ (** Invoked on each instruction occurrence. The [ChangeTo] action can
+ * replace this instruction with a list of instructions *)
+
+ method vstmt: stmt -> stmt visitAction
+ (** Control-flow statement. The default [DoChildren] action does not
+ * create a new statement when the components change. Instead it updates
+ * the contents of the original statement. This is done to preserve the
+ * sharing with [Goto] and [Case] statements that point to the original
+ * statement. If you use the [ChangeTo] action then you should take care
+ * of preserving that sharing yourself. *)
+
+ method vblock: block -> block visitAction (** Block. *)
+ method vfunc: fundec -> fundec visitAction (** Function definition.
+ Replaced in place. *)
+ method vglob: global -> global list visitAction (** Global (vars, types,
+ etc.) *)
+ method vinit: init -> init visitAction (** Initializers for globals *)
+ method vtype: typ -> typ visitAction (** Use of some type. Note
+ * that for structure/union
+ * and enumeration types the
+ * definition of the
+ * composite type is not
+ * visited. Use [vglob] to
+ * visit it. *)
+ method vattr: attribute -> attribute list visitAction
+ (** Attribute. Each attribute can be replaced by a list *)
+ method vattrparam: attrparam -> attrparam visitAction
+ (** Attribute parameters. *)
+
+ (** Add here instructions while visiting to queue them to preceede the
+ * current statement or instruction being processed. Use this method only
+ * when you are visiting an expression that is inside a function body, or
+ * a statement, because otherwise there will no place for the visitor to
+ * place your instructions. *)
+ method queueInstr: instr list -> unit
+
+ (** Gets the queue of instructions and resets the queue. This is done
+ * automatically for you when you visit statments. *)
+ method unqueueInstr: unit -> instr list
+
+end
+
+(** Default Visitor. Traverses the CIL tree without modifying anything *)
+class nopCilVisitor: cilVisitor
+
+(* other cil constructs *)
+
+(** Visit a file. This will will re-cons all globals TWICE (so that it is
+ * tail-recursive). Use {!Cil.visitCilFileSameGlobals} if your visitor will
+ * not change the list of globals. *)
+val visitCilFile: cilVisitor -> file -> unit
+
+(** A visitor for the whole file that does not change the globals (but maybe
+ * changes things inside the globals). Use this function instead of
+ * {!Cil.visitCilFile} whenever appropriate because it is more efficient for
+ * long files. *)
+val visitCilFileSameGlobals: cilVisitor -> file -> unit
+
+(** Visit a global *)
+val visitCilGlobal: cilVisitor -> global -> global list
+
+(** Visit a function definition *)
+val visitCilFunction: cilVisitor -> fundec -> fundec
+
+(* Visit an expression *)
+val visitCilExpr: cilVisitor -> exp -> exp
+
+(** Visit an lvalue *)
+val visitCilLval: cilVisitor -> lval -> lval
+
+(** Visit an lvalue or recursive offset *)
+val visitCilOffset: cilVisitor -> offset -> offset
+
+(** Visit an initializer offset *)
+val visitCilInitOffset: cilVisitor -> offset -> offset
+
+(** Visit an instruction *)
+val visitCilInstr: cilVisitor -> instr -> instr list
+
+(** Visit a statement *)
+val visitCilStmt: cilVisitor -> stmt -> stmt
+
+(** Visit a block *)
+val visitCilBlock: cilVisitor -> block -> block
+
+(** Visit a type *)
+val visitCilType: cilVisitor -> typ -> typ
+
+(** Visit a variable declaration *)
+val visitCilVarDecl: cilVisitor -> varinfo -> varinfo
+
+(** Visit an initializer *)
+val visitCilInit: cilVisitor -> init -> init
+
+
+(** Visit a list of attributes *)
+val visitCilAttributes: cilVisitor -> attribute list -> attribute list
+
+(* And some generic visitors. The above are built with these *)
+
+
+(** {b Utility functions} *)
+
+(** Whether the pretty printer should print output for the MS VC compiler.
+ Default is GCC. After you set this function you should call {!Cil.initCIL}. *)
+val msvcMode: bool ref
+
+
+(** Whether to use the logical operands LAnd and LOr. By default, do not use
+ * them because they are unlike other expressions and do not evaluate both of
+ * their operands *)
+val useLogicalOperators: bool ref
+
+
+(** A visitor that does constant folding. Pass as argument whether you want
+ * machine specific simplifications to be done, or not. *)
+val constFoldVisitor: bool -> cilVisitor
+
+(** Styles of printing line directives *)
+type lineDirectiveStyle =
+ | LineComment
+ | LinePreprocessorInput
+ | LinePreprocessorOutput
+
+(** How to print line directives *)
+val lineDirectiveStyle: lineDirectiveStyle option ref
+
+(** Whether we print something that will only be used as input to our own
+ * parser. In that case we are a bit more liberal in what we print *)
+val print_CIL_Input: bool ref
+
+(** Whether to print the CIL as they are, without trying to be smart and
+ * print nicer code. Normally this is false, in which case the pretty
+ * printer will turn the while(1) loops of CIL into nicer loops, will not
+ * print empty "else" blocks, etc. These is one case howewer in which if you
+ * turn this on you will get code that does not compile: if you use varargs
+ * the __builtin_va_arg function will be printed in its internal form. *)
+val printCilAsIs: bool ref
+
+(** The length used when wrapping output lines. Setting this variable to
+ * a large integer will prevent wrapping and make #line directives more
+ * accurate.
+ *)
+val lineLength: int ref
+
+(** Return the string 's' if we're printing output for gcc, suppres
+ * it if we're printing for CIL to parse back in. the purpose is to
+ * hide things from gcc that it complains about, but still be able
+ * to do lossless transformations when CIL is the consumer *)
+val forgcc: string -> string
+
+(** {b Debugging support} *)
+
+(** A reference to the current location. If you are careful to set this to
+ * the current location then you can use some built-in logging functions that
+ * will print the location. *)
+val currentLoc: location ref
+
+(** A reference to the current global being visited *)
+val currentGlobal: global ref
+
+
+(** CIL has a fairly easy to use mechanism for printing error messages. This
+ * mechanism is built on top of the pretty-printer mechanism (see
+ * {!Pretty.doc}) and the error-message modules (see {!Errormsg.error}).
+
+ Here is a typical example for printing a log message: {v
+ignore (Errormsg.log "Expression %a is not positive (at %s:%i)\n"
+ d_exp e loc.file loc.line)
+ v}
+
+ and here is an example of how you print a fatal error message that stop the
+* execution: {v
+Errormsg.s (Errormsg.bug "Why am I here?")
+ v}
+
+ Notice that you can use C format strings with some extension. The most
+useful extension is "%a" that means to consumer the next two argument from
+the argument list and to apply the first to [unit] and then to the second
+and to print the resulting {!Pretty.doc}. For each major type in CIL there is
+a corresponding function that pretty-prints an element of that type:
+*)
+
+
+(** Pretty-print a location *)
+val d_loc: unit -> location -> Pretty.doc
+
+(** Pretty-print the {!Cil.currentLoc} *)
+val d_thisloc: unit -> Pretty.doc
+
+(** Pretty-print an integer of a given kind *)
+val d_ikind: unit -> ikind -> Pretty.doc
+
+(** Pretty-print a floating-point kind *)
+val d_fkind: unit -> fkind -> Pretty.doc
+
+(** Pretty-print storage-class information *)
+val d_storage: unit -> storage -> Pretty.doc
+
+(** Pretty-print a constant *)
+val d_const: unit -> constant -> Pretty.doc
+
+
+val derefStarLevel: int
+val indexLevel: int
+val arrowLevel: int
+val addrOfLevel: int
+val additiveLevel: int
+val comparativeLevel: int
+val bitwiseLevel: int
+
+(** Parentheses level. An expression "a op b" is printed parenthesized if its
+ * parentheses level is >= that that of its context. Identifiers have the
+ * lowest level and weakly binding operators (e.g. |) have the largest level.
+ * The correctness criterion is that a smaller level MUST correspond to a
+ * stronger precedence!
+ *)
+val getParenthLevel: exp -> int
+
+(** A printer interface for CIL trees. Create instantiations of
+ * this type by specializing the class {!Cil.defaultCilPrinterClass}. *)
+class type cilPrinter = object
+ method pVDecl: unit -> varinfo -> Pretty.doc
+ (** Invoked for each variable declaration. Note that variable
+ * declarations are all the [GVar], [GVarDecl], [GFun], all the [varinfo]
+ * in formals of function types, and the formals and locals for function
+ * definitions. *)
+
+ method pVar: varinfo -> Pretty.doc
+ (** Invoked on each variable use. *)
+
+ method pLval: unit -> lval -> Pretty.doc
+ (** Invoked on each lvalue occurrence *)
+
+ method pOffset: Pretty.doc -> offset -> Pretty.doc
+ (** Invoked on each offset occurrence. The second argument is the base. *)
+
+ method pInstr: unit -> instr -> Pretty.doc
+ (** Invoked on each instruction occurrence. *)
+
+ method pLabel: unit -> label -> Pretty.doc
+ (** Print a label. *)
+
+ method pStmt: unit -> stmt -> Pretty.doc
+ (** Control-flow statement. This is used by
+ * {!Cil.printGlobal} and by {!Cil.dumpGlobal}. *)
+
+ method dStmt: out_channel -> int -> stmt -> unit
+ (** Dump a control-flow statement to a file with a given indentation.
+ * This is used by {!Cil.dumpGlobal}. *)
+
+ method dBlock: out_channel -> int -> block -> unit
+ (** Dump a control-flow block to a file with a given indentation.
+ * This is used by {!Cil.dumpGlobal}. *)
+
+ method pBlock: unit -> block -> Pretty.doc
+
+ method pBlock: unit -> block -> Pretty.doc
+ (** Print a block. *)
+
+ method pGlobal: unit -> global -> Pretty.doc
+ (** Global (vars, types, etc.). This can be slow and is used only by
+ * {!Cil.printGlobal} but not by {!Cil.dumpGlobal}. *)
+
+ method dGlobal: out_channel -> global -> unit
+ (** Dump a global to a file with a given indentation. This is used by
+ * {!Cil.dumpGlobal} *)
+
+ method pFieldDecl: unit -> fieldinfo -> Pretty.doc
+ (** A field declaration *)
+
+ method pType: Pretty.doc option -> unit -> typ -> Pretty.doc
+ (* Use of some type in some declaration. The first argument is used to print
+ * the declared element, or is None if we are just printing a type with no
+ * name being declared. Note that for structure/union and enumeration types
+ * the definition of the composite type is not visited. Use [vglob] to
+ * visit it. *)
+
+ method pAttr: attribute -> Pretty.doc * bool
+ (** Attribute. Also return an indication whether this attribute must be
+ * printed inside the __attribute__ list or not. *)
+
+ method pAttrParam: unit -> attrparam -> Pretty.doc
+ (** Attribute parameter *)
+
+ method pAttrs: unit -> attributes -> Pretty.doc
+ (** Attribute lists *)
+
+ method pLineDirective: ?forcefile:bool -> location -> Pretty.doc
+ (** Print a line-number. This is assumed to come always on an empty line.
+ * If the forcefile argument is present and is true then the file name
+ * will be printed always. Otherwise the file name is printed only if it
+ * is different from the last time time this function is called. The last
+ * file name is stored in a private field inside the cilPrinter object. *)
+
+ method pStmtKind: stmt -> unit -> stmtkind -> Pretty.doc
+ (** Print a statement kind. The code to be printed is given in the
+ * {!Cil.stmtkind} argument. The initial {!Cil.stmt} argument
+ * records the statement which follows the one being printed;
+ * {!Cil.defaultCilPrinterClass} uses this information to prettify
+ * statement printing in certain special cases. *)
+
+ method pExp: unit -> exp -> Pretty.doc
+ (** Print expressions *)
+
+ method pInit: unit -> init -> Pretty.doc
+ (** Print initializers. This can be slow and is used by
+ * {!Cil.printGlobal} but not by {!Cil.dumpGlobal}. *)
+
+ method dInit: out_channel -> int -> init -> unit
+ (** Dump a global to a file with a given indentation. This is used by
+ * {!Cil.dumpGlobal} *)
+end
+
+class defaultCilPrinterClass: cilPrinter
+val defaultCilPrinter: cilPrinter
+
+(** These are pretty-printers that will show you more details on the internal
+ * CIL representation, without trying hard to make it look like C *)
+class plainCilPrinterClass: cilPrinter
+val plainCilPrinter: cilPrinter
+
+(* zra: This is the pretty printer that Maincil will use.
+ by default it is set to defaultCilPrinter *)
+val printerForMaincil: cilPrinter ref
+
+(* Top-level printing functions *)
+(** Print a type given a pretty printer *)
+val printType: cilPrinter -> unit -> typ -> Pretty.doc
+
+(** Print an expression given a pretty printer *)
+val printExp: cilPrinter -> unit -> exp -> Pretty.doc
+
+(** Print an lvalue given a pretty printer *)
+val printLval: cilPrinter -> unit -> lval -> Pretty.doc
+
+(** Print a global given a pretty printer *)
+val printGlobal: cilPrinter -> unit -> global -> Pretty.doc
+
+(** Print an attribute given a pretty printer *)
+val printAttr: cilPrinter -> unit -> attribute -> Pretty.doc
+
+(** Print a set of attributes given a pretty printer *)
+val printAttrs: cilPrinter -> unit -> attributes -> Pretty.doc
+
+(** Print an instruction given a pretty printer *)
+val printInstr: cilPrinter -> unit -> instr -> Pretty.doc
+
+(** Print a statement given a pretty printer. This can take very long
+ * (or even overflow the stack) for huge statements. Use {!Cil.dumpStmt}
+ * instead. *)
+val printStmt: cilPrinter -> unit -> stmt -> Pretty.doc
+
+(** Print a block given a pretty printer. This can take very long
+ * (or even overflow the stack) for huge block. Use {!Cil.dumpBlock}
+ * instead. *)
+val printBlock: cilPrinter -> unit -> block -> Pretty.doc
+
+(** Dump a statement to a file using a given indentation. Use this instead of
+ * {!Cil.printStmt} whenever possible. *)
+val dumpStmt: cilPrinter -> out_channel -> int -> stmt -> unit
+
+(** Dump a block to a file using a given indentation. Use this instead of
+ * {!Cil.printBlock} whenever possible. *)
+val dumpBlock: cilPrinter -> out_channel -> int -> block -> unit
+
+(** Print an initializer given a pretty printer. This can take very long
+ * (or even overflow the stack) for huge initializers. Use {!Cil.dumpInit}
+ * instead. *)
+val printInit: cilPrinter -> unit -> init -> Pretty.doc
+
+(** Dump an initializer to a file using a given indentation. Use this instead of
+ * {!Cil.printInit} whenever possible. *)
+val dumpInit: cilPrinter -> out_channel -> int -> init -> unit
+
+(** Pretty-print a type using {!Cil.defaultCilPrinter} *)
+val d_type: unit -> typ -> Pretty.doc
+
+(** Pretty-print an expression using {!Cil.defaultCilPrinter} *)
+val d_exp: unit -> exp -> Pretty.doc
+
+(** Pretty-print an lvalue using {!Cil.defaultCilPrinter} *)
+val d_lval: unit -> lval -> Pretty.doc
+
+(** Pretty-print an offset using {!Cil.defaultCilPrinter}, given the pretty
+ * printing for the base. *)
+val d_offset: Pretty.doc -> unit -> offset -> Pretty.doc
+
+(** Pretty-print an initializer using {!Cil.defaultCilPrinter}. This can be
+ * extremely slow (or even overflow the stack) for huge initializers. Use
+ * {!Cil.dumpInit} instead. *)
+val d_init: unit -> init -> Pretty.doc
+
+(** Pretty-print a binary operator *)
+val d_binop: unit -> binop -> Pretty.doc
+
+(** Pretty-print a unary operator *)
+val d_unop: unit -> unop -> Pretty.doc
+
+(** Pretty-print an attribute using {!Cil.defaultCilPrinter} *)
+val d_attr: unit -> attribute -> Pretty.doc
+
+(** Pretty-print an argument of an attribute using {!Cil.defaultCilPrinter} *)
+val d_attrparam: unit -> attrparam -> Pretty.doc
+
+(** Pretty-print a list of attributes using {!Cil.defaultCilPrinter} *)
+val d_attrlist: unit -> attributes -> Pretty.doc
+
+(** Pretty-print an instruction using {!Cil.defaultCilPrinter} *)
+val d_instr: unit -> instr -> Pretty.doc
+
+(** Pretty-print a label using {!Cil.defaultCilPrinter} *)
+val d_label: unit -> label -> Pretty.doc
+
+(** Pretty-print a statement using {!Cil.defaultCilPrinter}. This can be
+ * extremely slow (or even overflow the stack) for huge statements. Use
+ * {!Cil.dumpStmt} instead. *)
+val d_stmt: unit -> stmt -> Pretty.doc
+
+(** Pretty-print a block using {!Cil.defaultCilPrinter}. This can be
+ * extremely slow (or even overflow the stack) for huge blocks. Use
+ * {!Cil.dumpBlock} instead. *)
+val d_block: unit -> block -> Pretty.doc
+
+(** Pretty-print the internal representation of a global using
+ * {!Cil.defaultCilPrinter}. This can be extremely slow (or even overflow the
+ * stack) for huge globals (such as arrays with lots of initializers). Use
+ * {!Cil.dumpGlobal} instead. *)
+val d_global: unit -> global -> Pretty.doc
+
+
+(** Versions of the above pretty printers, that don't print #line directives *)
+val dn_exp : unit -> exp -> Pretty.doc
+val dn_lval : unit -> lval -> Pretty.doc
+(* dn_offset is missing because it has a different interface *)
+val dn_init : unit -> init -> Pretty.doc
+val dn_type : unit -> typ -> Pretty.doc
+val dn_global : unit -> global -> Pretty.doc
+val dn_attrlist : unit -> attributes -> Pretty.doc
+val dn_attr : unit -> attribute -> Pretty.doc
+val dn_attrparam : unit -> attrparam -> Pretty.doc
+val dn_stmt : unit -> stmt -> Pretty.doc
+val dn_instr : unit -> instr -> Pretty.doc
+
+
+(** Pretty-print a short description of the global. This is useful for error
+ * messages *)
+val d_shortglobal: unit -> global -> Pretty.doc
+
+(** Pretty-print a global. Here you give the channel where the printout
+ * should be sent. *)
+val dumpGlobal: cilPrinter -> out_channel -> global -> unit
+
+(** Pretty-print an entire file. Here you give the channel where the printout
+ * should be sent. *)
+val dumpFile: cilPrinter -> out_channel -> string -> file -> unit
+
+
+(* the following error message producing functions also print a location in
+ * the code. use {!Errormsg.bug} and {!Errormsg.unimp} if you do not want
+ * that *)
+
+(** Like {!Errormsg.bug} except that {!Cil.currentLoc} is also printed *)
+val bug: ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Errormsg.unimp} except that {!Cil.currentLoc}is also printed *)
+val unimp: ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Errormsg.error} except that {!Cil.currentLoc} is also printed *)
+val error: ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Cil.error} except that it explicitly takes a location argument,
+ * instead of using the {!Cil.currentLoc} *)
+val errorLoc: location -> ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Errormsg.warn} except that {!Cil.currentLoc} is also printed *)
+val warn: ('a,unit,Pretty.doc) format -> 'a
+
+
+(** Like {!Errormsg.warnOpt} except that {!Cil.currentLoc} is also printed.
+ * This warning is printed only of {!Errormsg.warnFlag} is set. *)
+val warnOpt: ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Errormsg.warn} except that {!Cil.currentLoc} and context
+ is also printed *)
+val warnContext: ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Errormsg.warn} except that {!Cil.currentLoc} and context is also
+ * printed. This warning is printed only of {!Errormsg.warnFlag} is set. *)
+val warnContextOpt: ('a,unit,Pretty.doc) format -> 'a
+
+(** Like {!Cil.warn} except that it explicitly takes a location argument,
+ * instead of using the {!Cil.currentLoc} *)
+val warnLoc: location -> ('a,unit,Pretty.doc) format -> 'a
+
+(** Sometimes you do not want to see the syntactic sugar that the above
+ * pretty-printing functions add. In that case you can use the following
+ * pretty-printing functions. But note that the output of these functions is
+ * not valid C *)
+
+(** Pretty-print the internal representation of an expression *)
+val d_plainexp: unit -> exp -> Pretty.doc
+
+(** Pretty-print the internal representation of an integer *)
+val d_plaininit: unit -> init -> Pretty.doc
+
+(** Pretty-print the internal representation of an lvalue *)
+val d_plainlval: unit -> lval -> Pretty.doc
+
+(** Pretty-print the internal representation of an lvalue offset
+val d_plainoffset: unit -> offset -> Pretty.doc *)
+
+(** Pretty-print the internal representation of a type *)
+val d_plaintype: unit -> typ -> Pretty.doc
+
+
+
+(** {b ALPHA conversion} has been moved to the Alpha module. *)
+
+
+(** Assign unique names to local variables. This might be necessary after you
+ * transformed the code and added or renamed some new variables. Names are
+ * not used by CIL internally, but once you print the file out the compiler
+ * downstream might be confused. You might
+ * have added a new global that happens to have the same name as a local in
+ * some function. Rename the local to ensure that there would never be
+ * confusioin. Or, viceversa, you might have added a local with a name that
+ * conflicts with a global *)
+val uniqueVarNames: file -> unit
+
+(** {b Optimization Passes} *)
+
+(** A peephole optimizer that processes two adjacent statements and possibly
+ replaces them both. If some replacement happens, then the new statements
+ are themselves subject to optimization *)
+val peepHole2: (instr * instr -> instr list option) -> stmt list -> unit
+
+(** Similar to [peepHole2] except that the optimization window consists of
+ one statement, not two *)
+val peepHole1: (instr -> instr list option) -> stmt list -> unit
+
+(** {b Machine dependency} *)
+
+
+(** Raised when one of the bitsSizeOf functions cannot compute the size of a
+ * type. This can happen because the type contains array-length expressions
+ * that we don't know how to compute or because it is a type whose size is
+ * not defined (e.g. TFun or an undefined compinfo). The string is an
+ * explanation of the error *)
+exception SizeOfError of string * typ
+
+(** The size of a type, in bits. Trailing padding is added for structs and
+ * arrays. Raises {!Cil.SizeOfError} when it cannot compute the size. This
+ * function is architecture dependent, so you should only call this after you
+ * call {!Cil.initCIL}. Remember that on GCC sizeof(void) is 1! *)
+val bitsSizeOf: typ -> int
+
+(* The size of a type, in bytes. Returns a constant expression or a "sizeof"
+ * expression if it cannot compute the size. This function is architecture
+ * dependent, so you should only call this after you call {!Cil.initCIL}. *)
+val sizeOf: typ -> exp
+
+(** The minimum alignment (in bytes) for a type. This function is
+ * architecture dependent, so you should only call this after you call
+ * {!Cil.initCIL}. *)
+val alignOf_int: typ -> int
+
+(** Give a type of a base and an offset, returns the number of bits from the
+ * base address and the width (also expressed in bits) for the subobject
+ * denoted by the offset. Raises {!Cil.SizeOfError} when it cannot compute
+ * the size. This function is architecture dependent, so you should only call
+ * this after you call {!Cil.initCIL}. *)
+val bitsOffset: typ -> offset -> int * int
+
+
+(** Whether "char" is unsigned. Set after you call {!Cil.initCIL} *)
+val char_is_unsigned: bool ref
+
+(** Whether the machine is little endian. Set after you call {!Cil.initCIL} *)
+val little_endian: bool ref
+
+(** Whether the compiler generates assembly labels by prepending "_" to the
+ identifier. That is, will function foo() have the label "foo", or "_foo"?
+ Set after you call {!Cil.initCIL} *)
+val underscore_name: bool ref
+
+(** Represents a location that cannot be determined *)
+val locUnknown: location
+
+(** Return the location of an instruction *)
+val get_instrLoc: instr -> location
+
+(** Return the location of a global, or locUnknown *)
+val get_globalLoc: global -> location
+
+(** Return the location of a statement, or locUnknown *)
+val get_stmtLoc: stmtkind -> location
+
+
+(** Generate an {!Cil.exp} to be used in case of errors. *)
+val dExp: Pretty.doc -> exp
+
+(** Generate an {!Cil.instr} to be used in case of errors. *)
+val dInstr: Pretty.doc -> location -> instr
+
+(** Generate a {!Cil.global} to be used in case of errors. *)
+val dGlobal: Pretty.doc -> location -> global
+
+(** Like map but try not to make a copy of the list *)
+val mapNoCopy: ('a -> 'a) -> 'a list -> 'a list
+
+(** Like map but each call can return a list. Try not to make a copy of the
+ list *)
+val mapNoCopyList: ('a -> 'a list) -> 'a list -> 'a list
+
+(** sm: return true if the first is a prefix of the second string *)
+val startsWith: string -> string -> bool
+
+
+(** {b An Interpreter for constructing CIL constructs} *)
+
+(** The type of argument for the interpreter *)
+type formatArg =
+ Fe of exp
+ | Feo of exp option (** For array lengths *)
+ | Fu of unop
+ | Fb of binop
+ | Fk of ikind
+ | FE of exp list (** For arguments in a function call *)
+ | Ff of (string * typ * attributes) (** For a formal argument *)
+ | FF of (string * typ * attributes) list (** For formal argument lists *)
+ | Fva of bool (** For the ellipsis in a function type *)
+ | Fv of varinfo
+ | Fl of lval
+ | Flo of lval option
+
+ | Fo of offset
+
+ | Fc of compinfo
+ | Fi of instr
+ | FI of instr list
+ | Ft of typ
+ | Fd of int
+ | Fg of string
+ | Fs of stmt
+ | FS of stmt list
+ | FA of attributes
+
+ | Fp of attrparam
+ | FP of attrparam list
+
+ | FX of string
+
+
+(** Pretty-prints a format arg *)
+val d_formatarg: unit -> formatArg -> Pretty.doc
+
+val lowerConstants: bool ref
+ (** Do lower constant expressions into constants (default true) *)
diff --git a/cil/src/cillower.ml b/cil/src/cillower.ml
new file mode 100755
index 0000000..61745bf
--- /dev/null
+++ b/cil/src/cillower.ml
@@ -0,0 +1,57 @@
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** A number of lowering passes over CIL *)
+open Cil
+open Pretty
+module E = Errormsg
+
+(** Lower CEnum constants *)
+class lowerEnumVisitorClass : cilVisitor = object (self)
+ inherit nopCilVisitor
+
+ method vexpr (e: exp) =
+ match e with
+ Const (CEnum(v, s, ei)) ->
+ ChangeTo (visitCilExpr (self :>cilVisitor) v)
+
+ | _ -> DoChildren
+
+end
+
+let lowerEnumVisitor = new lowerEnumVisitorClass
diff --git a/cil/src/cillower.mli b/cil/src/cillower.mli
new file mode 100755
index 0000000..a62c9e3
--- /dev/null
+++ b/cil/src/cillower.mli
@@ -0,0 +1,42 @@
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** A number of lowering passes over CIL *)
+
+(** Replace enumeration constants with integer constants *)
+val lowerEnumVisitor : Cil.cilVisitor
diff --git a/cil/src/ciloptions.ml b/cil/src/ciloptions.ml
new file mode 100755
index 0000000..9a2b4bd
--- /dev/null
+++ b/cil/src/ciloptions.ml
@@ -0,0 +1,196 @@
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+module E = Errormsg
+
+let setDebugFlag v name =
+ E.debugFlag := v;
+ if v then Pretty.flushOften := true
+
+type outfile =
+ { fname: string;
+ fchan: out_channel }
+
+let setTraceDepth n =
+ Pretty.printDepth := n
+
+
+ (* Processign of output file arguments *)
+let openFile (what: string) (takeit: outfile -> unit) (fl: string) =
+ if !E.verboseFlag then
+ ignore (Printf.printf "Setting %s to %s\n" what fl);
+ (try takeit { fname = fl;
+ fchan = open_out fl }
+ with _ ->
+ raise (Arg.Bad ("Cannot open " ^ what ^ " file " ^ fl)))
+
+
+let fileNames : string list ref = ref []
+let recordFile fname =
+ fileNames := fname :: (!fileNames)
+
+ (* Parsing of files with additional names *)
+let parseExtraFile (s: string) =
+ try
+ let sfile = open_in s in
+ while true do
+ let line = try input_line sfile with e -> (close_in sfile; raise e) in
+ let linelen = String.length line in
+ let rec scan (pos: int) (* next char to look at *)
+ (start: int) : unit (* start of the word,
+ or -1 if none *) =
+ if pos >= linelen then
+ if start >= 0 then
+ recordFile (String.sub line start (pos - start))
+ else
+ () (* Just move on to the next line *)
+ else
+ let c = String.get line pos in
+ match c with
+ ' ' | '\n' | '\r' | '\t' ->
+ (* whitespace *)
+ if start >= 0 then begin
+ recordFile (String.sub line start (pos - start));
+ end;
+ scan (pos + 1) (-1)
+
+ | _ -> (* non-whitespace *)
+ if start >= 0 then
+ scan (pos + 1) start
+ else
+ scan (pos + 1) pos
+ in
+ scan 0 (-1)
+ done
+ with Sys_error _ -> E.s (E.error "Cannot find extra file: %s\n" s)
+ | End_of_file -> ()
+
+
+let options : (string * Arg.spec * string) list =
+ [
+ (* General Options *)
+ "", Arg.Unit (fun () -> ()), "\n\t\tGeneral Options\n" ;
+
+ "--version", Arg.Unit
+ (fun _ -> print_endline ("CIL version " ^ Cil.cilVersion ^
+ "\nMore information at http://cil.sourceforge.net/\n");
+ exit 0),
+ "output version information and exit";
+ "--verbose", Arg.Unit (fun _ -> E.verboseFlag := true),
+ "Print lots of random stuff. This is passed on from cilly.";
+ "--warnall", Arg.Unit (fun _ -> E.warnFlag := true), "Show all warnings";
+ "--debug", Arg.String (setDebugFlag true),
+ "<xxx> turns on debugging flag xxx";
+ "--nodebug", Arg.String (setDebugFlag false),
+ "<xxx> turns off debugging flag xxx";
+
+ "--flush", Arg.Unit (fun _ -> Pretty.flushOften := true),
+ "Flush the output streams often (aids debugging)" ;
+ "--check", Arg.Unit (fun _ -> Cilutil.doCheck := true),
+ "Run a consistency check over the CIL after every operation.";
+ "--nocheck", Arg.Unit (fun _ -> Cilutil.doCheck := false),
+ "turns off consistency checking of CIL";
+ "--noPrintLn", Arg.Unit (fun _ -> Cil.lineDirectiveStyle := None;
+ Cprint.printLn := false),
+ "Don't output #line directives in the output.";
+ "--commPrintLn", Arg.Unit (fun _ -> Cil.lineDirectiveStyle := Some Cil.LineComment;
+ Cprint.printLnComment := true),
+ "Print #line directives in the output, but put them in comments.";
+ "--stats", Arg.Unit (fun _ -> Cilutil.printStats := true),
+ "Print statistics about running times and memory usage.";
+
+
+ "--log", Arg.String (openFile "log" (fun oc -> E.logChannel := oc.fchan)),
+ "Set the name of the log file. By default stderr is used";
+
+ "--MSVC", Arg.Unit (fun _ -> Cil.msvcMode := true;
+ Frontc.setMSVCMode ();
+ if not Machdep.hasMSVC then
+ ignore (E.warn "Will work in MSVC mode but will be using machine-dependent parameters for GCC since you do not have the MSVC compiler installed\n")
+ ), "Enable MSVC compatibility. Default is GNU.";
+
+ "--testcil", Arg.String (fun s -> Cilutil.testcil := s),
+ "test CIL using the given compiler";
+
+ "--ignore-merge-conflicts",
+ Arg.Unit (fun _ -> Mergecil.ignore_merge_conflicts := true),
+ "ignore merging conflicts";
+ "--sliceGlobal", Arg.Unit (fun _ -> Cilutil.sliceGlobal := true),
+ "output is the slice of #pragma cilnoremove(sym) symbols";
+
+ (* sm: some more debugging options *)
+ "--tr", Arg.String Trace.traceAddMulti,
+ "<sys>: subsystem to show debug printfs for";
+ "--pdepth", Arg.Int setTraceDepth,
+ "<n>: set max print depth (default: 5)";
+
+ "--extrafiles", Arg.String parseExtraFile,
+ "<filename>: the name of a file that contains a list of additional files to process, separated by whitespace of newlines";
+
+ (* Lowering Options *)
+ "", Arg.Unit (fun () -> ()), "\n\t\tLowering Options\n" ;
+
+ "--noLowerConstants", Arg.Unit (fun _ -> Cil.lowerConstants := false),
+ "do not lower constant expressions";
+
+ "--noInsertImplicitCasts", Arg.Unit (fun _ -> Cil.insertImplicitCasts := false),
+ "do not insert implicit casts";
+
+ "--forceRLArgEval",
+ Arg.Unit (fun n -> Cabs2cil.forceRLArgEval := true),
+ "Forces right to left evaluation of function arguments";
+ "--nocil", Arg.Int (fun n -> Cabs2cil.nocil := n),
+ "Do not compile to CIL the global with the given index";
+ "--disallowDuplication", Arg.Unit (fun n -> Cabs2cil.allowDuplication := false),
+ "Prevent small chunks of code from being duplicated";
+ "--keepunused", Arg.Set Rmtmps.keepUnused,
+ "Do not remove the unused variables and types";
+ "--rmUnusedInlines", Arg.Set Rmtmps.rmUnusedInlines,
+ "Delete any unused inline functions. This is the default in MSVC mode";
+
+
+
+ "", Arg.Unit (fun () -> ()), "\n\t\tOutput Options\n" ;
+ "--printCilAsIs", Arg.Unit (fun _ -> Cil.printCilAsIs := true),
+ "do not try to simplify the CIL when printing. Without this flag, CIL will attempt to produce prettier output by e.g. changing while(1) into more meaningful loops.";
+ "--noWrap", Arg.Unit (fun _ -> Cil.lineLength := 100000),
+ "do not wrap long lines when printing";
+
+ ]
+
diff --git a/cil/src/ciloptions.mli b/cil/src/ciloptions.mli
new file mode 100755
index 0000000..13f65cf
--- /dev/null
+++ b/cil/src/ciloptions.mli
@@ -0,0 +1,48 @@
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(** The command-line options for CIL *)
+val options : (string * Arg.spec * string) list
+
+
+(** The list of file names *)
+val fileNames : string list ref
+
+(** Adds the file to the start of fileNames *)
+val recordFile: string -> unit
diff --git a/cil/src/cilutil.ml b/cil/src/cilutil.ml
new file mode 100644
index 0000000..b9a4da9
--- /dev/null
+++ b/cil/src/cilutil.ml
@@ -0,0 +1,72 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* Keep here the globally-visible flags *)
+let doCheck= ref false (* Whether to check CIL *)
+
+let logCalls = ref false (* Whether to produce a log with all the function
+ * calls made *)
+let logWrites = ref false (* Whether to produce a log with all the mem
+ * writes made *)
+let doPartial = ref false (* Whether to do partial evaluation and constant
+ * folding *)
+let doSimpleMem = ref false (* reduce complex memory expressions so that
+ * they contain at most one lval *)
+let doOneRet = ref false (* make a functions have at most one 'return' *)
+let doStackGuard = ref false (* instrument function calls and returns to
+maintain a separate stack for return addresses *)
+let doHeapify = ref false (* move stack-allocated arrays to the heap *)
+let makeCFG = ref false (* turn the input CIL file into something more like
+ * a CFG *)
+let printStats = ref false
+
+(* when 'sliceGlobal' is set, then when 'rmtmps' runs, only globals*)
+(* marked with #pragma cilnoremove(whatever) are kept; when used with *)
+(* cilly.asm.exe, the effect is to slice the input on the noremove symbols *)
+let sliceGlobal = ref false
+
+
+let printStages = ref false
+
+
+let doCxxPP = ref false
+
+let libDir = ref ""
+
+let dumpFCG = ref false
+let testcil = ref ""
+
diff --git a/cil/src/escape.ml b/cil/src/escape.ml
new file mode 100644
index 0000000..198c9e5
--- /dev/null
+++ b/cil/src/escape.ml
@@ -0,0 +1,93 @@
+(*
+ *
+ * Copyright (c) 2003,
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(** OCaml types used to represent wide characters and strings *)
+type wchar = int64
+type wstring = wchar list
+
+
+let escape_char = function
+ | '\007' -> "\\a"
+ | '\b' -> "\\b"
+ | '\t' -> "\\t"
+ | '\n' -> "\\n"
+ | '\011' -> "\\v"
+ | '\012' -> "\\f"
+ | '\r' -> "\\r"
+ | '"' -> "\\\""
+ | '\'' -> "\\'"
+ | '\\' -> "\\\\"
+ | ' ' .. '~' as printable -> String.make 1 printable
+ | unprintable -> Printf.sprintf "\\%03o" (Char.code unprintable)
+
+let escape_string str =
+ let length = String.length str in
+ let buffer = Buffer.create length in
+ for index = 0 to length - 1 do
+ Buffer.add_string buffer (escape_char (String.get str index))
+ done;
+ Buffer.contents buffer
+
+(* a wide char represented as an int64 *)
+let escape_wchar =
+ (* limit checks whether upper > probe *)
+ let limit upper probe = (Int64.to_float (Int64.sub upper probe)) > 0.5 in
+ let fits_byte = limit (Int64.of_int 0x100) in
+ let fits_octal_escape = limit (Int64.of_int 0o1000) in
+ let fits_universal_4 = limit (Int64.of_int 0x10000) in
+ let fits_universal_8 = limit (Int64.of_string "0x100000000") in
+ fun charcode ->
+ if fits_byte charcode then
+ escape_char (Char.chr (Int64.to_int charcode))
+ else if fits_octal_escape charcode then
+ Printf.sprintf "\\%03Lo" charcode
+ else if fits_universal_4 charcode then
+ Printf.sprintf "\\u%04Lx" charcode
+ else if fits_universal_8 charcode then
+ Printf.sprintf "\\u%04Lx" charcode
+ else
+ invalid_arg "Cprint.escape_string_intlist"
+
+(* a wide string represented as a list of int64s *)
+let escape_wstring (str : int64 list) =
+ let length = List.length str in
+ let buffer = Buffer.create length in
+ let append charcode =
+ let addition = escape_wchar charcode in
+ Buffer.add_string buffer addition
+ in
+ List.iter append str;
+ Buffer.contents buffer
diff --git a/cil/src/escape.mli b/cil/src/escape.mli
new file mode 100644
index 0000000..b932ef1
--- /dev/null
+++ b/cil/src/escape.mli
@@ -0,0 +1,48 @@
+(*
+ *
+ * Copyright (c) 2003,
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(*
+ * Character and string escaping utilities
+ *)
+
+(** OCaml types used to represent wide characters and strings *)
+type wchar = int64
+type wstring = wchar list
+
+(** escape various constructs in accordance with C lexical rules *)
+val escape_char : char -> string
+val escape_string : string -> string
+val escape_wchar : wchar -> string
+val escape_wstring : wstring -> string
diff --git a/cil/src/ext/astslicer.ml b/cil/src/ext/astslicer.ml
new file mode 100644
index 0000000..ffba482
--- /dev/null
+++ b/cil/src/ext/astslicer.ml
@@ -0,0 +1,454 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+open Cil
+module E = Errormsg
+(*
+ * Weimer: an AST Slicer for use in Daniel's Delta Debugging Algorithm.
+ *)
+let debug = ref false
+
+(*
+ * This type encapsulates a mapping form program locations to names
+ * in our naming convention.
+ *)
+type enumeration_info = {
+ statements : (stmt, string) Hashtbl.t ;
+ instructions : (instr, string) Hashtbl.t ;
+}
+
+(**********************************************************************
+ * Enumerate 1
+ *
+ * Given a cil file, enumerate all of the statement names in it using
+ * our naming scheme.
+ **********************************************************************)
+let enumerate out (f : Cil.file) =
+ let st_ht = Hashtbl.create 32767 in
+ let in_ht = Hashtbl.create 32767 in
+
+ let emit base i ht elt =
+ let str = Printf.sprintf "%s.%d" base !i in
+ Printf.fprintf out "%s\n" str ;
+ Hashtbl.add ht elt str ;
+ incr i
+ in
+ let emit_call base i str2 ht elt =
+ let str = Printf.sprintf "%s.%d" base !i in
+ Printf.fprintf out "%s - %s\n" str str2 ;
+ Hashtbl.add ht elt str ;
+ incr i
+ in
+ let descend base i =
+ let res = (Printf.sprintf "%s.%d" base !i),(ref 0) in
+ res
+ in
+ let rec doBlock b base i =
+ doStmtList b.bstmts base i
+ and doStmtList sl base i =
+ List.iter (fun s -> match s.skind with
+ | Instr(il) -> doIL il base i
+ | Return(_,_)
+ | Goto(_,_)
+ | Continue(_)
+ | Break(_) -> emit base i st_ht s
+ | If(e,b1,b2,_) ->
+ emit base i st_ht s ;
+ decr i ;
+ Printf.fprintf out "(\n" ;
+ let base',i' = descend base i in
+ doBlock b1 base' i' ;
+ Printf.fprintf out ") (\n" ;
+ let base'',i'' = descend base i in
+ doBlock b2 base'' i'' ;
+ Printf.fprintf out ")\n" ;
+ incr i
+ | Switch(_,b,_,_)
+(*
+ | Loop(b,_,_,_)
+*)
+ | While(_,b,_)
+ | DoWhile(_,b,_)
+ | For(_,_,_,b,_)
+ | Block(b) ->
+ emit base i st_ht s ;
+ decr i ;
+ let base',i' = descend base i in
+ Printf.fprintf out "(\n" ;
+ doBlock b base' i' ;
+ Printf.fprintf out ")\n" ;
+ incr i
+ | TryExcept _ | TryFinally _ ->
+ E.s (E.unimp "astslicer:enumerate")
+ ) sl
+ and doIL il base i =
+ List.iter (fun ins -> match ins with
+ | Set _
+ | Asm _ -> emit base i in_ht ins
+ | Call(_,(Lval(Var(vi),NoOffset)),_,_) ->
+ emit_call base i vi.vname in_ht ins
+ | Call(_,f,_,_) -> emit_call base i "*" in_ht ins
+ ) il
+ in
+ let doGlobal g = match g with
+ | GFun(fd,_) ->
+ Printf.fprintf out "%s (\n" fd.svar.vname ;
+ let cur = ref 0 in
+ doBlock fd.sbody fd.svar.vname cur ;
+ Printf.fprintf out ")\n" ;
+ ()
+ | _ -> ()
+ in
+ List.iter doGlobal f.globals ;
+ { statements = st_ht ;
+ instructions = in_ht ; }
+
+(**********************************************************************
+ * Enumerate 2
+ *
+ * Given a cil file and some enumeration information, do a log-calls-like
+ * transformation on it that prints out our names as you reach them.
+ **********************************************************************)
+(*
+ * This is the visitor that handles annotations
+ *)
+let print_it pfun name =
+ ((Call(None,Lval(Var(pfun),NoOffset),
+ [mkString (name ^ "\n")],locUnknown)))
+
+class enumVisitor pfun st_ht in_ht = object
+ inherit nopCilVisitor
+ method vinst i =
+ if Hashtbl.mem in_ht i then begin
+ let name = Hashtbl.find in_ht i in
+ let newinst = print_it pfun name in
+ ChangeTo([newinst ; i])
+ end else
+ DoChildren
+ method vstmt s =
+ if Hashtbl.mem st_ht s then begin
+ let name = Hashtbl.find st_ht s in
+ let newinst = print_it pfun name in
+ let newstmt = mkStmtOneInstr newinst in
+ let newblock = mkBlock [newstmt ; s] in
+ let replace_with = mkStmt (Block(newblock)) in
+ ChangeDoChildrenPost(s,(fun i -> replace_with))
+ end else
+ DoChildren
+ method vfunc f =
+ let newinst = print_it pfun f.svar.vname in
+ let newstmt = mkStmtOneInstr newinst in
+ let new_f = { f with sbody = { f.sbody with
+ bstmts = newstmt :: f.sbody.bstmts }} in
+ ChangeDoChildrenPost(new_f,(fun i -> i))
+end
+
+let annotate (f : Cil.file) ei = begin
+ (* Create a prototype for the logging function *)
+ let printfFun =
+ let fdec = emptyFunction "printf" in
+ let argf = makeLocalVar fdec "format" charConstPtrType in
+ fdec.svar.vtype <- TFun(intType, Some [ ("format", charConstPtrType, [])],
+ true, []);
+ fdec
+ in
+ let visitor = (new enumVisitor printfFun.svar ei.statements
+ ei.instructions) in
+ visitCilFileSameGlobals visitor f;
+ f
+end
+
+(**********************************************************************
+ * STAGE 2
+ *
+ * Perform a transitive-closure-like operation on the parts of the program
+ * that the user wants to keep. We use a CIL visitor to walk around
+ * and a number of hash tables to keep track of the things we want to keep.
+ **********************************************************************)
+(*
+ * Hashtables:
+ * ws - wanted stmts
+ * wi - wanted instructions
+ * wt - wanted typeinfo
+ * wc - wanted compinfo
+ * we - wanted enuminfo
+ * wv - wanted varinfo
+ *)
+
+let mode = ref false (* was our parented wanted? *)
+let finished = ref true (* set to false if we update something *)
+
+(* In the given hashtable, mark the given element was "wanted" *)
+let update ht elt =
+ if Hashtbl.mem ht elt && (Hashtbl.find ht elt = true) then ()
+ else begin
+ Hashtbl.add ht elt true ;
+ finished := false
+ end
+
+(* Handle a particular stage of the AST tree walk. Use "mode" (i.e.,
+ * whether our parent was wanted) and the hashtable (which tells us whether
+ * the user had any special instructions for this element) to determine
+ * what do to. *)
+let handle ht elt rep =
+ if !mode then begin
+ if Hashtbl.mem ht elt && (Hashtbl.find ht elt = false) then begin
+ (* our parent is Wanted but we were told to ignore this subtree,
+ * so we won't be wanted. *)
+ mode := false ;
+ ChangeDoChildrenPost(rep,(fun elt -> mode := true ; elt))
+ end else begin
+ (* we were not told to ignore this subtree, and our parent is
+ * Wanted, so we will be Wanted too! *)
+ update ht elt ;
+ DoChildren
+ end
+ end else if Hashtbl.mem ht elt && (Hashtbl.find ht elt = true) then begin
+ (* our parent was not wanted but we were wanted, so turn the
+ * mode on for now *)
+ mode := true ;
+ ChangeDoChildrenPost(rep,(fun elt -> mode := false ; elt))
+ end else
+ DoChildren
+
+let handle_no_default ht elt rep old_mode =
+ if Hashtbl.mem ht elt && (Hashtbl.find ht elt = true) then begin
+ (* our parent was not wanted but we were wanted, so turn the
+ * mode on for now *)
+ mode := true ;
+ ChangeDoChildrenPost(rep,(fun elt -> mode := old_mode ; elt))
+ end else begin
+ mode := false ;
+ ChangeDoChildrenPost(rep,(fun elt -> mode := old_mode ; elt))
+ end
+
+(*
+ * This is the visitor that handles elements (marks them as wanted)
+ *)
+class transVisitor ws wi wt wc we wv = object
+ inherit nopCilVisitor
+
+ method vvdec vi = handle_no_default wv vi vi !mode
+ method vvrbl vi = handle wv vi vi
+ method vinst i = handle wi i [i]
+ method vstmt s = handle ws s s
+ method vfunc f = handle wv f.svar f
+ method vglob g = begin
+ match g with
+ | GType(ti,_) -> handle wt ti [g]
+ | GCompTag(ci,_)
+ | GCompTagDecl(ci,_) -> handle wc ci [g]
+ | GEnumTag(ei,_)
+ | GEnumTagDecl(ei,_) -> handle we ei [g]
+ | GVarDecl(vi,_)
+ | GVar(vi,_,_) -> handle wv vi [g]
+ | GFun(f,_) -> handle wv f.svar [g]
+ | _ -> DoChildren
+ end
+ method vtype t = begin
+ match t with
+ | TNamed(ti,_) -> handle wt ti t
+ | TComp(ci,_) -> handle wc ci t
+ | TEnum(ei,_) -> handle we ei t
+ | _ -> DoChildren
+ end
+end
+
+(**********************************************************************
+ * STAGE 3
+ *
+ * Eliminate all of the elements from the program that are not marked
+ * "keep".
+ **********************************************************************)
+(*
+ * This is the visitor that throws away elements
+ *)
+let handle ht elt keep drop =
+ if (Hashtbl.mem ht elt) && (Hashtbl.find ht elt = true) then
+ (* DoChildren *) ChangeDoChildrenPost(keep,(fun a -> a))
+ else
+ ChangeTo(drop)
+
+class dropVisitor ws wi wt wc we wv = object
+ inherit nopCilVisitor
+
+ method vinst i = handle wi i [i] []
+ method vstmt s = handle ws s s (mkStmt (Instr([])))
+ method vglob g = begin
+ match g with
+ | GType(ti,_) -> handle wt ti [g] []
+ | GCompTag(ci,_)
+ | GCompTagDecl(ci,_) -> handle wc ci [g] []
+ | GEnumTag(ei,_)
+ | GEnumTagDecl(ei,_) -> handle we ei [g] []
+ | GVarDecl(vi,_)
+ | GVar(vi,_,_) -> handle wv vi [g] []
+ | GFun(f,l) ->
+ let new_locals = List.filter (fun vi ->
+ Hashtbl.mem wv vi && (Hashtbl.find wv vi = true)) f.slocals in
+ let new_fundec = { f with slocals = new_locals} in
+ handle wv f.svar [(GFun(new_fundec,l))] []
+ | _ -> DoChildren
+ end
+end
+
+(**********************************************************************
+ * STAGE 1
+ *
+ * Mark up the file with user-given information about what to keep and
+ * what to drop.
+ **********************************************************************)
+type mark = Wanted | Unwanted | Unspecified
+(* Given a cil file and a list of strings, mark all of the given ASTSlicer
+ * points as wanted or unwanted. *)
+let mark_file (f : Cil.file) (names : (string, mark) Hashtbl.t) =
+ let ws = Hashtbl.create 32767 in
+ let wi = Hashtbl.create 32767 in
+ let wt = Hashtbl.create 32767 in
+ let wc = Hashtbl.create 32767 in
+ let we = Hashtbl.create 32767 in
+ let wv = Hashtbl.create 32767 in
+ if !debug then Printf.printf "Applying user marks to file ...\n" ;
+ let descend base i =
+ let res = (Printf.sprintf "%s.%d" base !i),(ref 0) in
+ res
+ in
+ let check base i (default : mark) =
+ let str = Printf.sprintf "%s.%d" base !i in
+ if !debug then Printf.printf "Looking for [%s]\n" str ;
+ try Hashtbl.find names str
+ with _ -> default
+ in
+ let mark ht stmt wanted = match wanted with
+ Unwanted -> Hashtbl.replace ht stmt false
+ | Wanted -> Hashtbl.replace ht stmt true
+ | Unspecified -> ()
+ in
+ let rec doBlock b base i default =
+ doStmtList b.bstmts base i default
+ and doStmtList sl base i default =
+ List.iter (fun s -> match s.skind with
+ | Instr(il) -> doIL il base i default
+ | Return(_,_)
+ | Goto(_,_)
+ | Continue(_)
+ | Break(_) ->
+ mark ws s (check base i default) ; incr i
+ | If(e,b1,b2,_) ->
+ let inside = check base i default in
+ mark ws s inside ;
+ let base',i' = descend base i in
+ doBlock b1 base' i' inside ;
+ let base'',i'' = descend base i in
+ doBlock b2 base'' i'' inside ;
+ incr i
+ | Switch(_,b,_,_)
+(*
+ | Loop(b,_,_,_)
+*)
+ | While(_,b,_)
+ | DoWhile(_,b,_)
+ | For(_,_,_,b,_)
+ | Block(b) ->
+ let inside = check base i default in
+ mark ws s inside ;
+ let base',i' = descend base i in
+ doBlock b base' i' inside ;
+ incr i
+ | TryExcept _ | TryFinally _ ->
+ E.s (E.unimp "astslicer: mark")
+ ) sl
+ and doIL il base i default =
+ List.iter (fun ins -> mark wi ins (check base i default) ; incr i) il
+ in
+ let doGlobal g = match g with
+ | GFun(fd,_) ->
+ let cur = ref 0 in
+ if Hashtbl.mem names fd.svar.vname then begin
+ if Hashtbl.find names fd.svar.vname = Wanted then begin
+ Hashtbl.replace wv fd.svar true ;
+ doBlock fd.sbody fd.svar.vname cur (Wanted);
+ end else begin
+ Hashtbl.replace wv fd.svar false ;
+ doBlock fd.sbody fd.svar.vname cur (Unspecified);
+ end
+ end else begin
+ doBlock fd.sbody fd.svar.vname cur (Unspecified);
+ end
+ | _ -> ()
+ in
+ List.iter doGlobal f.globals ;
+ if !debug then begin
+ Hashtbl.iter (fun k v ->
+ ignore (Pretty.printf "want-s %b %a\n" v d_stmt k)) ws ;
+ Hashtbl.iter (fun k v ->
+ ignore (Pretty.printf "want-i %b %a\n" v d_instr k)) wi ;
+ Hashtbl.iter (fun k v ->
+ ignore (Pretty.printf "want-v %b %s\n" v k.vname)) wv ;
+ end ;
+ (*
+ * Now repeatedly mark all other things that must be kept.
+ *)
+ let visitor = (new transVisitor ws wi wt wc we wv) in
+ finished := false ;
+ if !debug then (Printf.printf "\nPerforming Transitive Closure\n\n" );
+ while not !finished do
+ finished := true ;
+ visitCilFileSameGlobals visitor f
+ done ;
+ if !debug then begin
+ Hashtbl.iter (fun k v ->
+ if v then ignore (Pretty.printf "want-s %a\n" d_stmt k)) ws ;
+ Hashtbl.iter (fun k v ->
+ if v then ignore (Pretty.printf "want-i %a\n" d_instr k)) wi ;
+ Hashtbl.iter (fun k v ->
+ if v then ignore (Pretty.printf "want-t %s\n" k.tname)) wt ;
+ Hashtbl.iter (fun k v ->
+ if v then ignore (Pretty.printf "want-c %s\n" k.cname)) wc ;
+ Hashtbl.iter (fun k v ->
+ if v then ignore (Pretty.printf "want-e %s\n" k.ename)) we ;
+ Hashtbl.iter (fun k v ->
+ if v then ignore (Pretty.printf "want-v %s\n" k.vname)) wv ;
+ end ;
+
+ (*
+ * Now drop everything we didn't need.
+ *)
+ if !debug then (Printf.printf "Dropping Unwanted Elements\n" );
+ let visitor = (new dropVisitor ws wi wt wc we wv) in
+ visitCilFile visitor f
diff --git a/cil/src/ext/availexps.ml b/cil/src/ext/availexps.ml
new file mode 100644
index 0000000..28c22c0
--- /dev/null
+++ b/cil/src/ext/availexps.ml
@@ -0,0 +1,359 @@
+(* compute available expressions, although in a somewhat
+ non-traditional way. the abstract state is a mapping from
+ variable ids to expressions as opposed to a set of
+ expressions *)
+
+open Cil
+open Pretty
+
+module E = Errormsg
+module DF = Dataflow
+module UD = Usedef
+module IH = Inthash
+module U = Util
+module S = Stats
+
+let debug = ref false
+
+(* exp IH.t -> exp IH.t -> bool *)
+let eh_equals eh1 eh2 =
+ if not(IH.length eh1 = IH.length eh2)
+ then false
+ else IH.fold (fun vid e b ->
+ if not b then b else
+ try let e2 = IH.find eh2 vid in
+ if not(Util.equals e e2)
+ then false
+ else true
+ with Not_found -> false)
+ eh1 true
+
+let eh_pretty () eh = line ++ seq line (fun (vid,e) ->
+ text "AE:vid:" ++ num vid ++ text ": " ++
+ (d_exp () e)) (IH.tolist eh)
+
+(* the result must be the intersection of eh1 and eh2 *)
+(* exp IH.t -> exp IH.t -> exp IH.t *)
+let eh_combine eh1 eh2 =
+ if !debug then ignore(E.log "eh_combine: combining %a\n and\n %a\n"
+ eh_pretty eh1 eh_pretty eh2);
+ let eh' = IH.copy eh1 in (* eh' gets all of eh1 *)
+ IH.iter (fun vid e1 ->
+ try let e2l = IH.find_all eh2 vid in
+ if not(List.exists (fun e2 -> Util.equals e1 e2) e2l)
+ (* remove things from eh' that eh2 doesn't have *)
+ then let e1l = IH.find_all eh' vid in
+ let e1l' = List.filter (fun e -> not(Util.equals e e1)) e1l in
+ IH.remove_all eh' vid;
+ List.iter (fun e -> IH.add eh' vid e) e1l'
+ with Not_found ->
+ IH.remove_all eh' vid) eh1;
+ if !debug then ignore(E.log "with result %a\n"
+ eh_pretty eh');
+ eh'
+
+(* On a memory write, kill expressions containing memory writes
+ * or variables whose address has been taken. *)
+let exp_ok = ref false
+class memReadOrAddrOfFinderClass = object(self)
+ inherit nopCilVisitor
+
+ method vexpr e = match e with
+ Lval(Mem _, _) ->
+ exp_ok := true;
+ SkipChildren
+ | _ -> DoChildren
+
+ method vvrbl vi =
+ if vi.vaddrof then
+ (exp_ok := true;
+ SkipChildren)
+ else DoChildren
+
+end
+
+let memReadOrAddrOfFinder = new memReadOrAddrOfFinderClass
+
+(* exp -> bool *)
+let exp_has_mem_read e =
+ exp_ok := false;
+ ignore(visitCilExpr memReadOrAddrOfFinder e);
+ !exp_ok
+
+let eh_kill_mem eh =
+ IH.iter (fun vid e ->
+ if exp_has_mem_read e
+ then IH.remove eh vid)
+ eh
+
+(* need to kill exps containing a particular vi sometimes *)
+let has_vi = ref false
+class viFinderClass vi = object(self)
+ inherit nopCilVisitor
+
+ method vvrbl vi' =
+ if vi.vid = vi'.vid
+ then (has_vi := true; SkipChildren)
+ else DoChildren
+
+end
+
+let exp_has_vi e vi =
+ let vis = new viFinderClass vi in
+ has_vi := false;
+ ignore(visitCilExpr vis e);
+ !has_vi
+
+let eh_kill_vi eh vi =
+ IH.iter (fun vid e ->
+ if exp_has_vi e vi
+ then IH.remove eh vid)
+ eh
+
+let varHash = IH.create 32
+
+let eh_kill_addrof_or_global eh =
+ if !debug then ignore(E.log "eh_kill: in eh_kill\n");
+ IH.iter (fun vid e ->
+ try let vi = IH.find varHash vid in
+ if vi.vaddrof
+ then begin
+ if !debug then ignore(E.log "eh_kill: %s has its address taken\n"
+ vi.vname);
+ IH.remove eh vid
+ end
+ else if vi.vglob
+ then begin
+ if !debug then ignore(E.log "eh_kill: %s is global\n"
+ vi.vname);
+ IH.remove eh vid
+ end
+ with Not_found -> ()) eh
+
+let eh_handle_inst i eh = match i with
+ (* if a pointer write, kill things with read in them.
+ also kill mappings from vars that have had their address taken,
+ and globals.
+ otherwise kill things with lv in them and add e *)
+ Set(lv,e,_) -> (match lv with
+ (Mem _, _) ->
+ (eh_kill_mem eh;
+ eh_kill_addrof_or_global eh;
+ eh)
+ | (Var vi, NoOffset) ->
+ (match e with
+ Lval(Var vi', NoOffset) -> (* ignore x = x *)
+ if vi'.vid = vi.vid then eh else
+ (IH.replace eh vi.vid e;
+ eh_kill_vi eh vi;
+ eh)
+ | _ ->
+ (IH.replace eh vi.vid e;
+ eh_kill_vi eh vi;
+ eh))
+ | _ -> eh) (* do nothing for now. *)
+| Call(Some(Var vi,NoOffset),_,_,_) ->
+ (IH.remove eh vi.vid;
+ eh_kill_vi eh vi;
+ eh_kill_mem eh;
+ eh_kill_addrof_or_global eh;
+ eh)
+| Call(_,_,_,_) ->
+ (eh_kill_mem eh;
+ eh_kill_addrof_or_global eh;
+ eh)
+| Asm(_,_,_,_,_,_) ->
+ let _,d = UD.computeUseDefInstr i in
+ (UD.VS.iter (fun vi ->
+ eh_kill_vi eh vi) d;
+ eh)
+
+let allExpHash = IH.create 128
+
+module AvailableExps =
+ struct
+
+ let name = "Available Expressions"
+
+ let debug = debug
+
+ (* mapping from var id to expression *)
+ type t = exp IH.t
+
+ let copy = IH.copy
+
+ let stmtStartData = IH.create 64
+
+ let pretty = eh_pretty
+
+ let computeFirstPredecessor stm eh =
+ eh_combine (IH.copy allExpHash) eh
+
+ let combinePredecessors (stm:stmt) ~(old:t) (eh:t) =
+ if S.time "eh_equals" (eh_equals old) eh then None else
+ Some(S.time "eh_combine" (eh_combine old) eh)
+
+ let doInstr i eh =
+ let action = eh_handle_inst i in
+ DF.Post(action)
+
+ let doStmt stm astate = DF.SDefault
+
+ let doGuard c astate = DF.GDefault
+
+ let filterStmt stm = true
+
+ end
+
+module AE = DF.ForwardsDataFlow(AvailableExps)
+
+(* make an exp IH.t with everything in it,
+ * also, fill in varHash while we're here.
+ *)
+class expCollectorClass = object(self)
+ inherit nopCilVisitor
+
+ method vinst i = match i with
+ Set((Var vi,NoOffset),e,_) ->
+ let e2l = IH.find_all allExpHash vi.vid in
+ if not(List.exists (fun e2 -> Util.equals e e2) e2l)
+ then IH.add allExpHash vi.vid e;
+ DoChildren
+ | _ -> DoChildren
+
+ method vvrbl vi =
+ (if not(IH.mem varHash vi.vid)
+ then
+ (if !debug && vi.vglob then ignore(E.log "%s is global\n" vi.vname);
+ if !debug && not(vi.vglob) then ignore(E.log "%s is not global\n" vi.vname);
+ IH.add varHash vi.vid vi));
+ DoChildren
+
+end
+
+let expCollector = new expCollectorClass
+
+let make_all_exps fd =
+ IH.clear allExpHash;
+ IH.clear varHash;
+ ignore(visitCilFunction expCollector fd)
+
+
+
+(* set all statement data to allExpHash, make
+ * a list of statements
+ *)
+let all_stmts = ref []
+class allExpSetterClass = object(self)
+ inherit nopCilVisitor
+
+ method vstmt s =
+ all_stmts := s :: (!all_stmts);
+ IH.add AvailableExps.stmtStartData s.sid (IH.copy allExpHash);
+ DoChildren
+
+end
+
+let allExpSetter = new allExpSetterClass
+
+let set_all_exps fd =
+ IH.clear AvailableExps.stmtStartData;
+ ignore(visitCilFunction allExpSetter fd)
+
+(*
+ * Computes AEs for function fd.
+ *
+ *
+ *)
+(*let iAEsHtbl = Hashtbl.create 128*)
+let computeAEs fd =
+ try let slst = fd.sbody.bstmts in
+ let first_stm = List.hd slst in
+ S.time "make_all_exps" make_all_exps fd;
+ all_stmts := [];
+ (*S.time "set_all_exps" set_all_exps fd;*)
+ (*Hashtbl.clear iAEsHtbl;*)
+ (*IH.clear (IH.find AvailableExps.stmtStartData first_stm.sid);*)
+ IH.add AvailableExps.stmtStartData first_stm.sid (IH.create 4);
+ S.time "compute" AE.compute [first_stm](*(List.rev !all_stmts)*)
+ with Failure "hd" -> if !debug then ignore(E.log "fn w/ no stmts?\n")
+ | Not_found -> if !debug then ignore(E.log "no data for first_stm?\n")
+
+
+(* get the AE data for a statement *)
+let getAEs sid =
+ try Some(IH.find AvailableExps.stmtStartData sid)
+ with Not_found -> None
+
+(* get the AE data for an instruction list *)
+let instrAEs il sid eh out =
+ (*if Hashtbl.mem iAEsHtbl (sid,out)
+ then Hashtbl.find iAEsHtbl (sid,out)
+ else*)
+ let proc_one hil i =
+ match hil with
+ [] -> let eh' = IH.copy eh in
+ let eh'' = eh_handle_inst i eh' in
+ (*if !debug then ignore(E.log "instrAEs: proc_one []: for %a\n data is %a\n"
+ d_instr i eh_pretty eh'');*)
+ eh''::hil
+ | eh'::ehrst as l ->
+ let eh' = IH.copy eh' in
+ let eh'' = eh_handle_inst i eh' in
+ (*if !debug then ignore(E.log "instrAEs: proc_one: for %a\n data is %a\n"
+ d_instr i eh_pretty eh'');*)
+ eh''::l
+ in
+ let folded = List.fold_left proc_one [eh] il in
+ (*let foldedout = List.tl (List.rev folded) in*)
+ let foldednotout = List.rev (List.tl folded) in
+ (*Hashtbl.add iAEsHtbl (sid,true) foldedout;
+ Hashtbl.add iAEsHtbl (sid,false) foldednotout;*)
+ (*if out then foldedout else*) foldednotout
+
+class aeVisitorClass = object(self)
+ inherit nopCilVisitor
+
+ val mutable sid = -1
+
+ val mutable ae_dat_lst = []
+
+ val mutable cur_ae_dat = None
+
+ method vstmt stm =
+ sid <- stm.sid;
+ match getAEs sid with
+ None ->
+ if !debug then ignore(E.log "aeVis: stm %d has no data\n" sid);
+ cur_ae_dat <- None;
+ DoChildren
+ | Some eh ->
+ match stm.skind with
+ Instr il ->
+ if !debug then ignore(E.log "aeVist: visit il\n");
+ ae_dat_lst <- S.time "instrAEs" (instrAEs il stm.sid eh) false;
+ DoChildren
+ | _ ->
+ if !debug then ignore(E.log "aeVisit: visit non-il\n");
+ cur_ae_dat <- None;
+ DoChildren
+
+ method vinst i =
+ if !debug then ignore(E.log "aeVist: before %a, ae_dat_lst is %d long\n"
+ d_instr i (List.length ae_dat_lst));
+ try
+ let data = List.hd ae_dat_lst in
+ cur_ae_dat <- Some(data);
+ ae_dat_lst <- List.tl ae_dat_lst;
+ if !debug then ignore(E.log "aeVisit: data is %a\n" eh_pretty data);
+ DoChildren
+ with Failure "hd" ->
+ if !debug then ignore(E.log "aeVis: il ae_dat_lst mismatch\n");
+ DoChildren
+
+ method get_cur_eh () =
+ match cur_ae_dat with
+ None -> getAEs sid
+ | Some eh -> Some eh
+
+end
diff --git a/cil/src/ext/bitmap.ml b/cil/src/ext/bitmap.ml
new file mode 100644
index 0000000..da1f8b9
--- /dev/null
+++ b/cil/src/ext/bitmap.ml
@@ -0,0 +1,224 @@
+
+ (* Imperative bitmaps *)
+type t = { mutable nrWords : int;
+ mutable nrBits : int; (* This is 31 * nrWords *)
+ mutable bitmap : int array }
+
+
+ (* Enlarge a bitmap to contain at
+ * least newBits *)
+let enlarge b newWords =
+ let newbitmap =
+ if newWords > b.nrWords then
+ let a = Array.create newWords 0 in
+ Array.blit b.bitmap 0 a 0 b.nrWords;
+ a
+ else
+ b.bitmap in
+ b.nrWords <- newWords;
+ b.nrBits <- (newWords lsl 5) - newWords;
+ b.bitmap <- newbitmap
+
+
+ (* Create a new empty bitmap *)
+let make size =
+ let wrd = (size + 30) / 31 in
+ { nrWords = wrd;
+ nrBits = (wrd lsl 5) - wrd;
+ bitmap = Array.make wrd 0
+ }
+
+let size t = t.nrBits
+ (* Make an initialized array *)
+let init size how =
+ let wrd = (size + 30) / 31 in
+ let how' w =
+ let first = (w lsl 5) - w in
+ let last = min size (first + 31) in
+ let rec loop i acc =
+ if i >= last then acc
+ else
+ let acc' = acc lsl 1 in
+ if how i then loop (i + 1) (acc' lor 1)
+ else loop (i + 1) acc'
+ in
+ loop first 0
+ in
+ { nrWords = wrd;
+ nrBits = (wrd lsl 5) - wrd;
+ bitmap = Array.init wrd how'
+ }
+
+let clone b =
+ { nrWords = b.nrWords;
+ nrBits = b.nrBits;
+ bitmap = Array.copy b.bitmap;
+ }
+
+let cloneEmpty b =
+ { nrWords = b.nrWords;
+ nrBits = b.nrBits;
+ bitmap = Array.make b.nrWords 0;
+ }
+
+let union b1 b2 =
+ begin
+ let n = b2.nrWords in
+ if b1.nrWords < n then enlarge b1 n else ();
+ let a1 = b1.bitmap in
+ let a2 = b2.bitmap in
+ let changed = ref false in
+ for i=0 to n - 1 do
+ begin
+ let t = a1.(i) in
+ let upd = t lor a2.(i) in
+ let _ = if upd <> t then changed := true else () in
+ Array.unsafe_set a1 i upd
+ end
+ done;
+ ! changed
+ end
+ (* lin += (lout - def) *)
+let accLive lin lout def =
+ begin (* Need to enlarge def to lout *)
+ let n = lout.nrWords in
+ if def.nrWords < n then enlarge def n else ();
+ (* Need to enlarge lin to lout *)
+ if lin.nrWords < n then enlarge lin n else ();
+ let changed = ref false in
+ let alin = lin.bitmap in
+ let alout = lout.bitmap in
+ let adef = def.bitmap in
+ for i=0 to n - 1 do
+ begin
+ let old = alin.(i) in
+ let nw = old lor (alout.(i) land (lnot adef.(i))) in
+ alin.(i) <- nw;
+ changed := (old <> nw) || (!changed)
+ end
+ done;
+ !changed
+ end
+
+ (* b1 *= b2 *)
+let inters b1 b2 =
+ begin
+ let n = min b1.nrWords b2.nrWords in
+ let a1 = b1.bitmap in
+ let a2 = b2.bitmap in
+ for i=0 to n - 1 do
+ begin
+ a1.(i) <- a1.(i) land a2.(i)
+ end
+ done;
+ if n < b1.nrWords then
+ Array.fill a1 n (b1.nrWords - n) 0
+ else
+ ()
+ end
+
+let emptyInt b start =
+ let n = b.nrWords in
+ let a = b.bitmap in
+ let rec loop i = i >= n || (a.(i) = 0 && loop (i + 1))
+ in
+ loop start
+
+let empty b = emptyInt b 0
+
+ (* b1 =? b2 *)
+let equal b1 b2 =
+ begin
+ let n = min b1.nrWords b2.nrWords in
+ let a1 = b1.bitmap in
+ let a2 = b2.bitmap in
+ let res = ref true in
+ for i=0 to n - 1 do
+ begin
+ if a1.(i) != a2.(i) then res := false else ()
+ end
+ done;
+ if !res then
+ if b1.nrWords > n then
+ emptyInt b1 n
+ else if b2.nrWords > n then
+ emptyInt b2 n
+ else
+ true
+ else
+ false
+ end
+
+let assign b1 b2 =
+ begin
+ let n = b2.nrWords in
+ if b1.nrWords < n then enlarge b1 n else ();
+ let a1 = b1.bitmap in
+ let a2 = b2.bitmap in
+ Array.blit a2 0 a1 0 n
+ end
+
+ (* b1 -= b2 *)
+let diff b1 b2 =
+ begin
+ let n = min b1.nrWords b2.nrWords in
+ let a1 = b1.bitmap in
+ let a2 = b2.bitmap in
+ for i=0 to n - 1 do
+ a1.(i) <- a1.(i) land (lnot a2.(i))
+ done;
+ if n < b1.nrWords then
+ Array.fill a1 n (b1.nrWords - n) 0
+ else
+ ()
+ end
+
+
+
+
+let get bmp i =
+ assert (i >= 0);
+ if i >= bmp.nrBits then enlarge bmp (i / 31 + 1) else ();
+ let wrd = i / 31 in
+ let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
+ bmp.bitmap.(wrd) land msk != 0
+
+
+let set bmp i tv =
+ assert(i >= 0);
+ let wrd = i / 31 in
+ let msk = 1 lsl (i + wrd - (wrd lsl 5)) in
+ if i >= bmp.nrBits then enlarge bmp (wrd + 1) else ();
+ if tv then
+ bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) lor msk
+ else
+ bmp.bitmap.(wrd) <- bmp.bitmap.(wrd) land (lnot msk)
+
+
+
+ (* Iterate over all elements in a
+ * bitmap *)
+let fold f bmp arg =
+ let a = bmp.bitmap in
+ let n = bmp.nrWords in
+ let rec allWords i bit arg =
+ if i >= n then
+ arg
+ else
+ let rec allBits msk bit left arg =
+ if left = 0 then
+ allWords (i + 1) bit arg
+ else
+ allBits ((lsr) msk 1) (bit + 1) (left - 1)
+ (if (land) msk 1 != 0 then f arg bit else arg)
+ in
+ allBits a.(i) bit 31 arg
+ in
+ allWords 0 0 arg
+
+
+let iter f t = fold (fun x y -> f y) t ()
+
+let toList bmp = fold (fun acc i -> i :: acc) bmp []
+
+let card bmp = fold (fun acc _ -> acc + 1) bmp 0
diff --git a/cil/src/ext/bitmap.mli b/cil/src/ext/bitmap.mli
new file mode 100644
index 0000000..5247e35
--- /dev/null
+++ b/cil/src/ext/bitmap.mli
@@ -0,0 +1,50 @@
+
+ (* Imperative bitmaps *)
+
+type t
+ (* Create a bitmap given the number
+ * of bits *)
+val make : int -> t
+val init : int -> (int -> bool) -> t (* Also initialize it *)
+
+val size : t -> int (* How much space it is reserved *)
+
+ (* The cardinality of a set *)
+val card : t -> int
+
+ (* Make a copy of a bitmap *)
+val clone : t -> t
+
+val cloneEmpty : t -> t (* An empty set with the same
+ * dimentions *)
+
+val set : t -> int -> bool -> unit
+val get : t -> int -> bool
+ (* destructive union. The first
+ * element is updated. Returns true
+ * if any change was actually
+ * necessary *)
+val union : t -> t -> bool
+
+ (* accLive livein liveout def. Does
+ * liveIn += (liveout - def) *)
+val accLive : t -> t -> t -> bool
+
+ (* Copy the second argument onto the
+ * first *)
+val assign : t -> t -> unit
+
+
+val inters : t -> t -> unit
+val diff : t -> t -> unit
+
+
+val empty : t -> bool
+
+val equal : t -> t -> bool
+
+val toList : t -> int list
+
+val iter : (int -> unit) -> t -> unit
+val fold : ('a -> int -> 'a) -> t -> 'a -> 'a
+
diff --git a/cil/src/ext/blockinggraph.ml b/cil/src/ext/blockinggraph.ml
new file mode 100644
index 0000000..281678a
--- /dev/null
+++ b/cil/src/ext/blockinggraph.ml
@@ -0,0 +1,769 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+open Cil
+open Pretty
+module E = Errormsg
+
+let debug = false
+
+let fingerprintAll = true
+
+
+type blockkind =
+ NoBlock
+ | BlockTrans
+ | BlockPoint
+ | EndPoint
+
+(* For each function we have a node *)
+type node =
+{
+ nodeid: int;
+ name: string;
+ mutable scanned: bool;
+ mutable expand: bool;
+ mutable fptr: bool;
+ mutable stacksize: int;
+ mutable fds: fundec option;
+ mutable bkind: blockkind;
+ mutable origkind: blockkind;
+ mutable preds: node list;
+ mutable succs: node list;
+ mutable predstmts: (stmt * node) list;
+}
+
+type blockpt =
+{
+ id: int;
+ point: stmt;
+ callfun: string;
+ infun: string;
+ mutable leadsto: blockpt list;
+}
+
+
+(* Fresh ids for each node. *)
+let curNodeNum : int ref = ref 0
+let getFreshNodeNum () : int =
+ let num = !curNodeNum in
+ incr curNodeNum;
+ num
+
+(* Initialize a node. *)
+let newNode (name: string) (fptr: bool) (mangle: bool) : node =
+ let id = getFreshNodeNum () in
+ { nodeid = id; name = if mangle then name ^ (string_of_int id) else name;
+ scanned = false; expand = false;
+ fptr = fptr; stacksize = 0; fds = None;
+ bkind = NoBlock; origkind = NoBlock;
+ preds = []; succs = []; predstmts = []; }
+
+
+(* My type signature ignores attributes and function pointers. *)
+let myTypeSig (t: typ) : typsig =
+ let rec removeFunPtrs (ts: typsig) : typsig =
+ match ts with
+ TSPtr (TSFun _, a) ->
+ TSPtr (TSBase voidType, a)
+ | TSPtr (base, a) ->
+ TSPtr (removeFunPtrs base, a)
+ | TSArray (base, e, a) ->
+ TSArray (removeFunPtrs base, e, a)
+ | TSFun (ret, args, v, a) ->
+ TSFun (removeFunPtrs ret, List.map removeFunPtrs args, v, a)
+ | _ -> ts
+ in
+ removeFunPtrs (typeSigWithAttrs (fun _ -> []) t)
+
+
+(* We add a dummy function whose name is "@@functionPointer@@" that is called
+ * at all invocations of function pointers and itself calls all functions
+ * whose address is taken. *)
+let functionPointerName = "@@functionPointer@@"
+
+(* We map names to nodes *)
+let functionNodes: (string, node) Hashtbl.t = Hashtbl.create 113
+let getFunctionNode (n: string) : node =
+ Util.memoize
+ functionNodes
+ n
+ (fun _ -> newNode n false false)
+
+(* We map types to nodes for function pointers *)
+let functionPtrNodes: (typsig, node) Hashtbl.t = Hashtbl.create 113
+let getFunctionPtrNode (t: typ) : node =
+ Util.memoize
+ functionPtrNodes
+ (myTypeSig t)
+ (fun _ -> newNode functionPointerName true true)
+
+let startNode: node = newNode "@@startNode@@" true false
+
+
+(*
+(** Dump the function call graph. *)
+let dumpFunctionCallGraph (start: node) =
+ Hashtbl.iter (fun _ x -> x.scanned <- false) functionNodes;
+ let rec dumpOneNode (ind: int) (n: node) : unit =
+ output_string !E.logChannel "\n";
+ for i = 0 to ind do
+ output_string !E.logChannel " "
+ done;
+ output_string !E.logChannel (n.name ^ " ");
+ begin
+ match n.bkind with
+ NoBlock -> ()
+ | BlockTrans -> output_string !E.logChannel " <blocks>"
+ | BlockPoint -> output_string !E.logChannel " <blockpt>"
+ | EndPoint -> output_string !E.logChannel " <endpt>"
+ end;
+ if n.scanned then (* Already dumped *)
+ output_string !E.logChannel " <rec> "
+ else begin
+ n.scanned <- true;
+ List.iter (fun n -> if n.bkind <> EndPoint then dumpOneNode (ind + 1) n)
+ n.succs
+ end
+ in
+ dumpOneNode 0 start;
+ output_string !E.logChannel "\n\n"
+*)
+
+let dumpFunctionCallGraphToFile () =
+ let channel = open_out "graph" in
+ let dumpNode _ (n: node) : unit =
+ let first = ref true in
+ let dumpSucc (n: node) : unit =
+ if !first then
+ first := false
+ else
+ output_string channel ",";
+ output_string channel n.name
+ in
+ output_string channel (string_of_int n.nodeid);
+ output_string channel ":";
+ output_string channel (string_of_int n.stacksize);
+ output_string channel ":";
+ if n.fds = None && not n.fptr then
+ output_string channel "x";
+ output_string channel ":";
+ output_string channel n.name;
+ output_string channel ":";
+ List.iter dumpSucc n.succs;
+ output_string channel "\n";
+ in
+ dumpNode () startNode;
+ Hashtbl.iter dumpNode functionNodes;
+ Hashtbl.iter dumpNode functionPtrNodes;
+ close_out channel
+
+
+let addCall (callerNode: node) (calleeNode: node) (sopt: stmt option) =
+ if not (List.exists (fun n -> n.name = calleeNode.name)
+ callerNode.succs) then begin
+ if debug then
+ ignore (E.log "found call from %s to %s\n"
+ callerNode.name calleeNode.name);
+ callerNode.succs <- calleeNode :: callerNode.succs;
+ calleeNode.preds <- callerNode :: calleeNode.preds;
+ end;
+ match sopt with
+ Some s ->
+ if not (List.exists (fun (s', _) -> s' = s) calleeNode.predstmts) then
+ calleeNode.predstmts <- (s, callerNode) :: calleeNode.predstmts
+ | None -> ()
+
+
+class findCallsVisitor (host: node) : cilVisitor = object
+ inherit nopCilVisitor
+
+ val mutable curStmt : stmt ref = ref (mkEmptyStmt ())
+
+ method vstmt s =
+ curStmt := s;
+ DoChildren
+
+ method vinst i =
+ match i with
+ | Call(_,Lval(Var(vi),NoOffset),args,l) ->
+ addCall host (getFunctionNode vi.vname) (Some !curStmt);
+ SkipChildren
+
+ | Call(_,e,_,l) -> (* Calling a function pointer *)
+ addCall host (getFunctionPtrNode (typeOf e)) (Some !curStmt);
+ SkipChildren
+
+ | _ -> SkipChildren (* No calls in other instructions *)
+
+ (* There are no calls in expressions and types *)
+ method vexpr e = SkipChildren
+ method vtype t = SkipChildren
+
+end
+
+
+let endPt = { id = 0; point = mkEmptyStmt (); callfun = "end"; infun = "end";
+ leadsto = []; }
+
+(* These values will be initialized for real in makeBlockingGraph. *)
+let curId : int ref = ref 1
+let startName : string ref = ref ""
+let blockingPoints : blockpt list ref = ref []
+let blockingPointsNew : blockpt Queue.t = Queue.create ()
+let blockingPointsHash : (int, blockpt) Hashtbl.t = Hashtbl.create 113
+
+let getFreshNum () : int =
+ let num = !curId in
+ curId := !curId + 1;
+ num
+
+let getBlockPt (s: stmt) (cfun: string) (ifun: string) : blockpt =
+ try
+ Hashtbl.find blockingPointsHash s.sid
+ with Not_found ->
+ let num = getFreshNum () in
+ let bpt = { id = num; point = s; callfun = cfun; infun = ifun;
+ leadsto = []; } in
+ Hashtbl.add blockingPointsHash s.sid bpt;
+ blockingPoints := bpt :: !blockingPoints;
+ Queue.add bpt blockingPointsNew;
+ bpt
+
+
+type action =
+ Process of stmt * node
+ | Next of stmt * node
+ | Return of node
+
+let getStmtNode (s: stmt) : node option =
+ match s.skind with
+ Instr instrs -> begin
+ let len = List.length instrs in
+ if len > 0 then
+ match List.nth instrs (len - 1) with
+ Call (_, Lval (Var vi, NoOffset), args, _) ->
+ Some (getFunctionNode vi.vname)
+ | Call (_, e, _, _) -> (* Calling a function pointer *)
+ Some (getFunctionPtrNode (typeOf e))
+ | _ ->
+ None
+ else
+ None
+ end
+ | _ -> None
+
+let addBlockingPointEdge (bptFrom: blockpt) (bptTo: blockpt) : unit =
+ if not (List.exists (fun bpt -> bpt = bptTo) bptFrom.leadsto) then
+ bptFrom.leadsto <- bptTo :: bptFrom.leadsto
+
+let findBlockingPointEdges (bpt: blockpt) : unit =
+ let seenStmts = Hashtbl.create 117 in
+ let worklist = Queue.create () in
+ Queue.add (Next (bpt.point, getFunctionNode bpt.infun)) worklist;
+ while Queue.length worklist > 0 do
+ let act = Queue.take worklist in
+ match act with
+ Process (curStmt, curNode) -> begin
+ Hashtbl.add seenStmts curStmt.sid ();
+ match getStmtNode curStmt with
+ Some node -> begin
+ if debug then
+ ignore (E.log "processing node %s\n" node.name);
+ match node.bkind with
+ NoBlock ->
+ Queue.add (Next (curStmt, curNode)) worklist
+ | BlockTrans -> begin
+ let processFundec (fd: fundec) : unit =
+ let s = List.hd fd.sbody.bstmts in
+ if not (Hashtbl.mem seenStmts s.sid) then
+ let n = getFunctionNode fd.svar.vname in
+ Queue.add (Process (s, n)) worklist
+ in
+ match node.fds with
+ Some fd ->
+ processFundec fd
+ | None ->
+ List.iter
+ (fun n ->
+ match n.fds with
+ Some fd -> processFundec fd
+ | None -> E.s (bug "expected fundec"))
+ node.succs
+ end
+ | BlockPoint ->
+ addBlockingPointEdge bpt
+ (getBlockPt curStmt node.name curNode.name)
+ | EndPoint ->
+ addBlockingPointEdge bpt endPt
+ end
+ | _ ->
+ Queue.add (Next (curStmt, curNode)) worklist
+ end
+ | Next (curStmt, curNode) -> begin
+ match curStmt.Cil.succs with
+ [] ->
+ if debug then
+ ignore (E.log "hit end of %s\n" curNode.name);
+ Queue.add (Return curNode) worklist
+ | _ ->
+ List.iter (fun s ->
+ if not (Hashtbl.mem seenStmts s.sid) then
+ Queue.add (Process (s, curNode)) worklist)
+ curStmt.Cil.succs
+ end
+ | Return curNode when curNode.bkind = NoBlock ->
+ ()
+ | Return curNode when curNode.name = !startName ->
+ addBlockingPointEdge bpt endPt
+ | Return curNode ->
+ List.iter (fun (s, n) -> if n.bkind <> NoBlock then
+ Queue.add (Next (s, n)) worklist)
+ curNode.predstmts;
+ List.iter (fun n -> if n.fptr then
+ Queue.add (Return n) worklist)
+ curNode.preds
+ done
+
+let markYieldPoints (n: node) : unit =
+ let rec markNode (n: node) : unit =
+ if n.bkind = NoBlock then
+ match n.origkind with
+ BlockTrans ->
+ if n.expand || n.fptr then begin
+ n.bkind <- BlockTrans;
+ List.iter markNode n.succs
+ end else begin
+ n.bkind <- BlockPoint
+ end
+ | _ ->
+ n.bkind <- n.origkind
+ in
+ Hashtbl.iter (fun _ n -> n.bkind <- NoBlock) functionNodes;
+ Hashtbl.iter (fun _ n -> n.bkind <- NoBlock) functionPtrNodes;
+ markNode n
+
+let makeBlockingGraph (start: node) =
+ let startStmt =
+ match start.fds with
+ Some fd -> List.hd fd.sbody.bstmts
+ | None -> E.s (bug "expected fundec")
+ in
+ curId := 1;
+ startName := start.name;
+ blockingPoints := [endPt];
+ Queue.clear blockingPointsNew;
+ Hashtbl.clear blockingPointsHash;
+ ignore (getBlockPt startStmt start.name start.name);
+ while Queue.length blockingPointsNew > 0 do
+ let bpt = Queue.take blockingPointsNew in
+ findBlockingPointEdges bpt;
+ done
+
+let dumpBlockingGraph () =
+ List.iter
+ (fun bpt ->
+ if bpt.id < 2 then begin
+ ignore (E.log "bpt %d (%s): " bpt.id bpt.callfun)
+ end else begin
+ ignore (E.log "bpt %d (%s in %s): " bpt.id bpt.callfun bpt.infun)
+ end;
+ List.iter (fun bpt -> ignore (E.log "%d " bpt.id)) bpt.leadsto;
+ ignore (E.log "\n"))
+ !blockingPoints;
+ ignore (E.log "\n")
+
+let beforeFun =
+ makeGlobalVar "before_bg_node"
+ (TFun (voidType, Some [("node_idx", intType, []);
+ ("num_edges", intType, [])],
+ false, []))
+
+let initFun =
+ makeGlobalVar "init_blocking_graph"
+ (TFun (voidType, Some [("num_nodes", intType, [])],
+ false, []))
+
+let fingerprintVar =
+ let vi = makeGlobalVar "stack_fingerprint" intType in
+ vi.vstorage <- Extern;
+ vi
+
+let startNodeAddrs =
+ let vi = makeGlobalVar "start_node_addrs" (TPtr (voidPtrType, [])) in
+ vi.vstorage <- Extern;
+ vi
+
+let startNodeStacks =
+ let vi = makeGlobalVar "start_node_stacks" (TPtr (intType, [])) in
+ vi.vstorage <- Extern;
+ vi
+
+let startNodeAddrsArray =
+ makeGlobalVar "start_node_addrs_array" (TArray (voidPtrType, None, []))
+
+let startNodeStacksArray =
+ makeGlobalVar "start_node_stacks_array" (TArray (intType, None, []))
+
+let insertInstr (newInstr: instr) (s: stmt) : unit =
+ match s.skind with
+ Instr instrs ->
+ let rec insert (instrs: instr list) : instr list =
+ match instrs with
+ [] -> E.s (bug "instr list does not end with call\n")
+ | [Call _] -> newInstr :: instrs
+ | i :: rest -> i :: (insert rest)
+ in
+ s.skind <- Instr (insert instrs)
+ | _ ->
+ E.s (bug "instr stmt expected\n")
+
+let instrumentBlockingPoints () =
+ List.iter
+ (fun bpt ->
+ if bpt.id > 1 then
+ let arg1 = integer bpt.id in
+ let arg2 = integer (List.length bpt.leadsto) in
+ let call = Call (None, Lval (var beforeFun),
+ [arg1; arg2], locUnknown) in
+ insertInstr call bpt.point;
+ addCall (getFunctionNode bpt.infun)
+ (getFunctionNode beforeFun.vname) None)
+ !blockingPoints
+
+
+let startNodes : node list ref = ref []
+
+let makeAndDumpBlockingGraphs () : unit =
+ if List.length !startNodes > 1 then
+ E.s (unimp "We can't handle more than one start node right now.\n");
+ List.iter
+ (fun n ->
+ markYieldPoints n;
+ (*dumpFunctionCallGraph n;*)
+ makeBlockingGraph n;
+ dumpBlockingGraph ();
+ instrumentBlockingPoints ())
+ !startNodes
+
+
+let pragmas : (string, int) Hashtbl.t = Hashtbl.create 13
+
+let gatherPragmas (f: file) : unit =
+ List.iter
+ (function
+ GPragma (Attr ("stacksize", [AStr s; AInt n]), _) ->
+ Hashtbl.add pragmas s n
+ | _ -> ())
+ f.globals
+
+
+let blockingNodes : node list ref = ref []
+
+let markBlockingFunctions () : unit =
+ let rec markFunction (n: node) : unit =
+ if debug then
+ ignore (E.log "marking %s\n" n.name);
+ if n.origkind = NoBlock then begin
+ n.origkind <- BlockTrans;
+ List.iter markFunction n.preds;
+ end
+ in
+ List.iter (fun n -> List.iter markFunction n.preds) !blockingNodes
+
+let hasFunctionTypeAttribute (n: string) (t: typ) : bool =
+ let _, _, _, a = splitFunctionType t in
+ hasAttribute n a
+
+let markVar (vi: varinfo) : unit =
+ let node = getFunctionNode vi.vname in
+ if node.origkind = NoBlock then begin
+ if hasAttribute "yield" vi.vattr then begin
+ node.origkind <- BlockPoint;
+ blockingNodes := node :: !blockingNodes;
+ end else if hasFunctionTypeAttribute "noreturn" vi.vtype then begin
+ node.origkind <- EndPoint;
+ end else if hasAttribute "expand" vi.vattr then begin
+ node.expand <- true;
+ end
+ end;
+ begin
+ try
+ node.stacksize <- Hashtbl.find pragmas node.name
+ with Not_found -> begin
+ match filterAttributes "stacksize" vi.vattr with
+ (Attr (_, [AInt n])) :: _ when n > node.stacksize ->
+ node.stacksize <- n
+ | _ -> ()
+ end
+ end
+
+let makeFunctionCallGraph (f: Cil.file) : unit =
+ Hashtbl.clear functionNodes;
+ (* Scan the file and construct the control-flow graph *)
+ List.iter
+ (function
+ GFun(fdec, _) ->
+ let curNode = getFunctionNode fdec.svar.vname in
+ if fdec.svar.vaddrof then begin
+ addCall (getFunctionPtrNode fdec.svar.vtype)
+ curNode None;
+ end;
+ if hasAttribute "start" fdec.svar.vattr then begin
+ startNodes := curNode :: !startNodes;
+ end;
+ markVar fdec.svar;
+ curNode.fds <- Some fdec;
+ let vis = new findCallsVisitor curNode in
+ ignore (visitCilBlock vis fdec.sbody)
+
+ | GVarDecl(vi, _) when isFunctionType vi.vtype ->
+ (* TODO: what if we take the addr of an extern? *)
+ markVar vi
+
+ | _ -> ())
+ f.globals
+
+let makeStartNodeLinks () : unit =
+ addCall startNode (getFunctionNode "main") None;
+ List.iter (fun n -> addCall startNode n None) !startNodes
+
+let funType (ret_t: typ) (args: (string * typ) list) =
+ TFun(ret_t,
+ Some (List.map (fun (n,t) -> (n, t, [])) args),
+ false, [])
+
+class instrumentClass = object
+ inherit nopCilVisitor
+
+ val mutable curNode : node ref = ref (getFunctionNode "main")
+ val mutable seenRet : bool ref = ref false
+
+ val mutable funId : int ref = ref 0
+
+ method vfunc (fdec: fundec) : fundec visitAction = begin
+ (* Remember the current function. *)
+ curNode := getFunctionNode fdec.svar.vname;
+ seenRet := false;
+ funId := Random.bits ();
+ (* Add useful locals. *)
+ ignore (makeLocalVar fdec "savesp" voidPtrType);
+ ignore (makeLocalVar fdec "savechunk" voidPtrType);
+ ignore (makeLocalVar fdec "savebottom" voidPtrType);
+ (* Add macro for function entry when we're done. *)
+ let addEntryNode (fdec: fundec) : fundec =
+ if not !seenRet then E.s (bug "didn't find a return statement");
+ let node = getFunctionNode fdec.svar.vname in
+ if fingerprintAll || node.origkind <> NoBlock then begin
+ let fingerprintSet =
+ Set (var fingerprintVar, BinOp (BXor, Lval (var fingerprintVar),
+ integer !funId, intType),
+ locUnknown)
+ in
+ fdec.sbody.bstmts <- mkStmtOneInstr fingerprintSet :: fdec.sbody.bstmts
+ end;
+ let nodeFun = emptyFunction ("NODE_CALL_"^(string_of_int node.nodeid)) in
+ let nodeCall = Call (None, Lval (var nodeFun.svar), [], locUnknown) in
+ nodeFun.svar.vtype <- funType voidType [];
+ nodeFun.svar.vstorage <- Static;
+ fdec.sbody.bstmts <- mkStmtOneInstr nodeCall :: fdec.sbody.bstmts;
+ fdec
+ in
+ ChangeDoChildrenPost (fdec, addEntryNode)
+ end
+
+ method vstmt (s: stmt) : stmt visitAction = begin
+ begin
+ match s.skind with
+ Instr instrs -> begin
+ let instrumentNode (callNode: node) : unit =
+ (* Make calls to macros. *)
+ let suffix = "_" ^ (string_of_int !curNode.nodeid) ^
+ "_" ^ (string_of_int callNode.nodeid)
+ in
+ let beforeFun = emptyFunction ("BEFORE_CALL" ^ suffix) in
+ let beforeCall = Call (None, Lval (var beforeFun.svar),
+ [], locUnknown) in
+ beforeFun.svar.vtype <- funType voidType [];
+ beforeFun.svar.vstorage <- Static;
+ let afterFun = emptyFunction ("AFTER_CALL" ^ suffix) in
+ let afterCall = Call (None, Lval (var afterFun.svar),
+ [], locUnknown) in
+ afterFun.svar.vtype <- funType voidType [];
+ afterFun.svar.vstorage <- Static;
+ (* Insert instrumentation around call site. *)
+ let rec addCalls (is: instr list) : instr list =
+ match is with
+ [call] -> [beforeCall; call; afterCall]
+ | cur :: rest -> cur :: addCalls rest
+ | [] -> E.s (bug "expected list of non-zero length")
+ in
+ s.skind <- Instr (addCalls instrs)
+ in
+ (* If there's a call site here, instrument it. *)
+ let len = List.length instrs in
+ if len > 0 then begin
+ match List.nth instrs (len - 1) with
+ Call (_, Lval (Var vi, NoOffset), _, _) ->
+ (*
+ if (try String.sub vi.vname 0 10 <> "NODE_CALL_"
+ with Invalid_argument _ -> true) then
+*)
+ instrumentNode (getFunctionNode vi.vname)
+ | Call (_, e, _, _) -> (* Calling a function pointer *)
+ instrumentNode (getFunctionPtrNode (typeOf e))
+ | _ -> ()
+ end;
+ DoChildren
+ end
+ | Cil.Return _ -> begin
+ if !seenRet then E.s (bug "found multiple returns");
+ seenRet := true;
+ if fingerprintAll || !curNode.origkind <> NoBlock then begin
+ let fingerprintSet =
+ Set (var fingerprintVar, BinOp (BXor, Lval (var fingerprintVar),
+ integer !funId, intType),
+ locUnknown)
+ in
+ s.skind <- Block (mkBlock [mkStmtOneInstr fingerprintSet;
+ mkStmt s.skind]);
+ end;
+ SkipChildren
+ end
+ | _ -> DoChildren
+ end
+ end
+end
+
+let makeStartNodeTable (globs: global list) : global list =
+ if List.length !startNodes = 0 then
+ globs
+ else
+ let addrInitInfo = { init = None } in
+ let stackInitInfo = { init = None } in
+ let rec processNode (nodes: node list) (i: int) =
+ match nodes with
+ node :: rest ->
+ let curGlobs, addrInit, stackInit = processNode rest (i + 1) in
+ let fd =
+ match node.fds with
+ Some fd -> fd
+ | None -> E.s (bug "expected fundec")
+ in
+ let stack =
+ makeGlobalVar ("NODE_STACK_" ^ (string_of_int node.nodeid)) intType
+ in
+ GVarDecl (fd.svar, locUnknown) :: curGlobs,
+ ((Index (integer i, NoOffset), SingleInit (mkAddrOf (var fd.svar))) ::
+ addrInit),
+ ((Index (integer i, NoOffset), SingleInit (Lval (var stack))) ::
+ stackInit)
+ | [] -> (GVarDecl (startNodeAddrs, locUnknown) ::
+ GVarDecl (startNodeStacks, locUnknown) ::
+ GVar (startNodeAddrsArray, addrInitInfo, locUnknown) ::
+ GVar (startNodeStacksArray, stackInitInfo, locUnknown) ::
+ []),
+ [Index (integer i, NoOffset), SingleInit zero],
+ [Index (integer i, NoOffset), SingleInit zero]
+ in
+ let newGlobs, addrInit, stackInit = processNode !startNodes 0 in
+ addrInitInfo.init <-
+ Some (CompoundInit (TArray (voidPtrType, None, []), addrInit));
+ stackInitInfo.init <-
+ Some (CompoundInit (TArray (intType, None, []), stackInit));
+ let file = { fileName = "startnode.h"; globals = newGlobs;
+ globinit = None; globinitcalled = false; } in
+ let channel = open_out file.fileName in
+ dumpFile defaultCilPrinter channel file;
+ close_out channel;
+ GText ("#include \"" ^ file.fileName ^ "\"") :: globs
+
+let instrumentProgram (f: file) : unit =
+ (* Add function prototypes. *)
+ f.globals <- makeStartNodeTable f.globals;
+ f.globals <- GText ("#include \"stack.h\"") ::
+ GVarDecl (initFun, locUnknown) ::
+ GVarDecl (beforeFun, locUnknown) ::
+ GVarDecl (fingerprintVar, locUnknown) ::
+ f.globals;
+ (* Add instrumentation to call sites. *)
+ visitCilFile ((new instrumentClass) :> cilVisitor) f;
+ (* Force creation of this node. *)
+ ignore (getFunctionNode beforeFun.vname);
+ (* Add initialization call to main(). *)
+ let mainNode = getFunctionNode "main" in
+ match mainNode.fds with
+ Some fdec ->
+ let arg1 = integer (List.length !blockingPoints) in
+ let initInstr = Call (None, Lval (var initFun), [arg1], locUnknown) in
+ let addrsInstr =
+ Set (var startNodeAddrs, StartOf (var startNodeAddrsArray),
+ locUnknown)
+ in
+ let stacksInstr =
+ Set (var startNodeStacks, StartOf (var startNodeStacksArray),
+ locUnknown)
+ in
+ let newStmt =
+ if List.length !startNodes = 0 then
+ mkStmtOneInstr initInstr
+ else
+ mkStmt (Instr [addrsInstr; stacksInstr; initInstr])
+ in
+ fdec.sbody.bstmts <- newStmt :: fdec.sbody.bstmts;
+ addCall mainNode (getFunctionNode initFun.vname) None
+ | None ->
+ E.s (bug "expected main fundec")
+
+
+
+let feature : featureDescr =
+ { fd_name = "FCG";
+ fd_enabled = ref false;
+ fd_description = "computing and printing a static call graph";
+ fd_extraopt = [];
+ fd_doit =
+ (function (f : file) ->
+ Random.init 0; (* Use the same seed so that results are predictable. *)
+ gatherPragmas f;
+ makeFunctionCallGraph f;
+ makeStartNodeLinks ();
+ markBlockingFunctions ();
+ (* makeAndDumpBlockingGraphs (); *)
+ instrumentProgram f;
+ dumpFunctionCallGraphToFile ());
+ fd_post_check = true;
+ }
diff --git a/cil/src/ext/blockinggraph.mli b/cil/src/ext/blockinggraph.mli
new file mode 100644
index 0000000..72f9ba7
--- /dev/null
+++ b/cil/src/ext/blockinggraph.mli
@@ -0,0 +1,40 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* This module finds and analyzes yield points. *)
+
+val feature: Cil.featureDescr
diff --git a/cil/src/ext/callgraph.ml b/cil/src/ext/callgraph.ml
new file mode 100644
index 0000000..58472ac
--- /dev/null
+++ b/cil/src/ext/callgraph.ml
@@ -0,0 +1,250 @@
+(* callgraph.ml *)
+(* code for callgraph.mli *)
+
+(* see copyright notice at end of this file *)
+
+open Cil
+open Trace
+open Printf
+module P = Pretty
+module IH = Inthash
+module H = Hashtbl
+module E = Errormsg
+
+(* ------------------- interface ------------------- *)
+(* a call node describes the local calling structure for a
+ * single function: which functions it calls, and which
+ * functions call it *)
+type callnode = {
+ (* An id *)
+ cnid: int;
+
+ (* the function this node describes *)
+ cnInfo: nodeinfo;
+
+ (* set of functions this one calls, indexed by the node id *)
+ cnCallees: callnode IH.t;
+
+ (* set of functions that call this one , indexed by the node id *)
+ cnCallers: callnode IH.t;
+}
+
+and nodeinfo =
+ NIVar of varinfo * bool ref
+ (* Node corresponding to a function. If the boolean
+ * is true, then the function is defined, otherwise
+ * it is external *)
+
+ | NIIndirect of string (* Indirect nodes have a string associated to them.
+ * These strings must be invalid function names *)
+ * varinfo list ref
+ (* A list of functions that this indirect node might
+ * denote *)
+
+let nodeName (n: nodeinfo) : string =
+ match n with
+ NIVar (v, _) -> v.vname
+ | NIIndirect (n, _) -> n
+
+(* a call graph is a hashtable, mapping a function name to
+ * the node which describes that function's call structure *)
+type callgraph =
+ (string, callnode) Hashtbl.t
+
+(* given the name of a function, retrieve its callnode; this will create a
+ * node if one doesn't already exist. Will use the given nodeinfo only when
+ * creating nodes. *)
+let nodeId = ref 0
+let getNodeByName (cg: callgraph) (ni: nodeinfo) : callnode =
+ let name = nodeName ni in
+ try
+ H.find cg name
+ with Not_found -> (
+ (* make a new node *)
+ let ret:callnode = {
+ cnInfo = ni;
+ cnid = !nodeId;
+ cnCallees = IH.create 5;
+ cnCallers = IH.create 5;
+ }
+ in
+ incr nodeId;
+ (* add it to the table, then return it *)
+ H.add cg name ret;
+ ret
+ )
+
+(* Get the node for a variable *)
+let getNodeForVar (cg: callgraph) (v: varinfo) : callnode =
+ getNodeByName cg (NIVar (v, ref false))
+
+let getNodeForIndirect (cg: callgraph) (e: exp) : callnode =
+ getNodeByName cg (NIIndirect ("<indirect>", ref []))
+
+
+(* Find the name of an indirect node that a function whose address is taken
+ * belongs *)
+let markFunctionAddrTaken (cg: callgraph) (f: varinfo) : unit =
+ (*
+ ignore (E.log "markFunctionAddrTaken %s\n" f.vname);
+ *)
+ let n = getNodeForIndirect cg (AddrOf (Var f, NoOffset)) in
+ match n.cnInfo with
+ NIIndirect (_, r) -> r := f :: !r
+ | _ -> assert false
+
+
+
+class cgComputer (graph: callgraph) = object(self)
+ inherit nopCilVisitor
+
+ (* the current function we're in, so when we visit a call node
+ * we know who is the caller *)
+ val mutable curFunc: callnode option = None
+
+
+ (* begin visiting a function definition *)
+ method vfunc (f:fundec) : fundec visitAction = begin
+ (trace "callgraph" (P.dprintf "entering function %s\n" f.svar.vname));
+ let node = getNodeForVar graph f.svar in
+ (match node.cnInfo with
+ NIVar (v, r) -> r := true
+ | _ -> assert false);
+ curFunc <- (Some node);
+ DoChildren
+ end
+
+ (* visit an instruction; we're only interested in calls *)
+ method vinst (i:instr) : instr list visitAction = begin
+ (*(trace "callgraph" (P.dprintf "visiting instruction: %a\n" dn_instr i));*)
+ let caller : callnode =
+ match curFunc with
+ None -> assert false
+ | Some c -> c
+ in
+ let callerName: string = nodeName caller.cnInfo in
+ (match i with
+ Call(_,f,_,_) -> (
+ let callee: callnode =
+ match f with
+ | Lval(Var(vi),NoOffset) ->
+ (trace "callgraph" (P.dprintf "I see a call by %s to %s\n"
+ callerName vi.vname));
+ getNodeForVar graph vi
+
+ | _ ->
+ (trace "callgraph" (P.dprintf "indirect call: %a\n"
+ dn_instr i));
+ getNodeForIndirect graph f
+ in
+
+ (* add one entry to each node's appropriate list *)
+ IH.replace caller.cnCallees callee.cnid callee;
+ IH.replace callee.cnCallers caller.cnid caller
+ )
+
+ | _ -> ()); (* ignore other kinds instructions *)
+
+ DoChildren
+ end
+
+ method vexpr (e: exp) =
+ (match e with
+ AddrOf (Var fv, NoOffset) when isFunctionType fv.vtype ->
+ markFunctionAddrTaken graph fv
+ | _ -> ());
+
+ DoChildren
+end
+
+let computeGraph (f:file) : callgraph = begin
+ let graph = H.create 37 in
+ let obj:cgComputer = new cgComputer graph in
+
+ (* visit the whole file, computing the graph *)
+ visitCilFileSameGlobals (obj :> cilVisitor) f;
+
+
+ (* return the computed graph *)
+ graph
+end
+
+let printGraph (out:out_channel) (g:callgraph) : unit = begin
+ let printEntry _ (n:callnode) : unit =
+ let name = nodeName n.cnInfo in
+ (Printf.fprintf out " %s" name)
+ in
+
+ let printCalls (node:callnode) : unit =
+ (fprintf out " calls:");
+ (IH.iter printEntry node.cnCallees);
+ (fprintf out "\n is called by:");
+ (IH.iter printEntry node.cnCallers);
+ (fprintf out "\n")
+ in
+
+ H.iter (fun (name: string) (node: callnode) ->
+ match node.cnInfo with
+ NIVar (v, def) ->
+ (fprintf out "%s (%s):\n"
+ v.vname (if !def then "defined" else "external"));
+ printCalls node
+
+ | NIIndirect (n, funcs) ->
+ fprintf out "Indirect %s:\n" n;
+ fprintf out " possible aliases: ";
+ List.iter (fun a -> fprintf out "%s " a.vname) !funcs;
+ fprintf out "\n"
+
+ )
+
+ g
+ end
+
+let doCallGraph = ref false
+
+let feature : featureDescr =
+ { fd_name = "callgraph";
+ fd_enabled = doCallGraph;
+ fd_description = "generation of a static call graph";
+ fd_extraopt = [];
+ fd_doit =
+ (function (f: file) ->
+ let graph:callgraph = computeGraph f in
+ printGraph stdout graph);
+ fd_post_check = false;
+ }
+
+
+(*
+ *
+ * Copyright (c) 2001-2002 by
+ * George C. Necula necula@cs.berkeley.edu
+ * Scott McPeak smcpeak@cs.berkeley.edu
+ * Wes Weimer weimer@cs.berkeley.edu
+ * Ben Liblit liblit@cs.berkeley.edu
+ *
+ * All rights reserved. Permission to use, copy, modify and distribute
+ * this software for research purposes only is hereby granted,
+ * provided that the following conditions are met:
+ * 1. XSRedistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the authors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * DISCLAIMER:
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
diff --git a/cil/src/ext/callgraph.mli b/cil/src/ext/callgraph.mli
new file mode 100644
index 0000000..bc76018
--- /dev/null
+++ b/cil/src/ext/callgraph.mli
@@ -0,0 +1,123 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(* callgraph.mli *)
+(* compute a static call graph *)
+
+(* module maintainer: scott *)
+(* see copyright notice at end of this file *)
+
+
+(* ------------------ types ------------------- *)
+(* a call node describes the local calling structure for a
+ * single function: which functions it calls, and which
+ * functions call it *)
+type callnode = {
+ (* An id *)
+ cnid: int;
+
+ (* the function this node describes *)
+ cnInfo: nodeinfo;
+
+ (* set of functions this one calls, indexed by the node id *)
+ cnCallees: callnode Inthash.t;
+
+ (* set of functions that call this one , indexed by the node id *)
+ cnCallers: callnode Inthash.t;
+}
+
+and nodeinfo =
+ NIVar of Cil.varinfo * bool ref
+ (* Node corresponding to a function. If the boolean
+ * is true, then the function is defined, otherwise
+ * it is external *)
+
+ | NIIndirect of string (* Indirect nodes have a string associated to them.
+ * These strings must be invalid function names *)
+ * Cil.varinfo list ref
+ (* A list of functions that this indirect node might
+ * denote *)
+
+
+val nodeName: nodeinfo -> string
+
+(* a call graph is a hashtable, mapping a function name to
+ * the node which describes that function's call structure *)
+type callgraph =
+ (string, callnode) Hashtbl.t
+
+
+(* ----------------- functions ------------------- *)
+(* given a CIL file, compute its static call graph *)
+val computeGraph : Cil.file -> callgraph
+
+(* print the callgraph in a human-readable format to a channel *)
+val printGraph : out_channel -> callgraph -> unit
+
+
+val feature: Cil.featureDescr
+(*
+ *
+ * Copyright (c) 2001-2002 by
+ * George C. Necula necula@cs.berkeley.edu
+ * Scott McPeak smcpeak@cs.berkeley.edu
+ * Wes Weimer weimer@cs.berkeley.edu
+ * Ben Liblit liblit@cs.berkeley.edu
+ *
+ * All rights reserved. Permission to use, copy, modify and distribute
+ * this software for research purposes only is hereby granted,
+ * provided that the following conditions are met:
+ * 1. Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the authors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * DISCLAIMER:
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
diff --git a/cil/src/ext/canonicalize.ml b/cil/src/ext/canonicalize.ml
new file mode 100644
index 0000000..a75deea
--- /dev/null
+++ b/cil/src/ext/canonicalize.ml
@@ -0,0 +1,292 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+
+(************************************************************************
+ * canonicalize performs several transformations to correct differences
+ * between C and C++, so that the output is (hopefully) valid C++ code.
+ * This is incomplete -- certain fixes which are necessary
+ * for some programs are not yet implemented.
+ *
+ * #1) C allows global variables to have multiple declarations and multiple
+ * (equivalent) definitions. This transformation removes all but one
+ * declaration and all but one definition.
+ *
+ * #2) Any variables that use C++ keywords as identifiers are renamed.
+ *
+ * #3) __inline is #defined to inline, and __restrict is #defined to nothing.
+ *
+ * #4) C allows function pointers with no specified arguments to be used on
+ * any argument list. To make C++ accept this code, we insert a cast
+ * from the function pointer to a type that matches the arguments. Of
+ * course, this does nothing to guarantee that the pointer actually has
+ * that type.
+ *
+ * #5) Makes casts from int to enum types explicit. (CIL changes enum
+ * constants to int constants, but doesn't use a cast.)
+ *
+ ************************************************************************)
+
+open Cil
+module E = Errormsg
+module H = Hashtbl
+
+(* For transformation #1. Stores all variable definitions in the file. *)
+let varDefinitions: (varinfo, global) H.t = H.create 111
+
+
+class canonicalizeVisitor = object(self)
+ inherit nopCilVisitor
+ val mutable currentFunction: fundec = Cil.dummyFunDec;
+
+ (* A hashtable to prevent duplicate declarations. *)
+ val alreadyDeclared: (varinfo, unit) H.t = H.create 111
+ val alreadyDefined: (varinfo, unit) H.t = H.create 111
+
+ (* move variable declarations around *)
+ method vglob g = match g with
+ GVar(v, ({init = Some _} as inito), l) ->
+ (* A definition. May have been moved to an earlier position. *)
+ if H.mem alreadyDefined v then begin
+ ignore (E.warn "Duplicate definition of %s at %a.\n"
+ v.vname d_loc !currentLoc);
+ ChangeTo [] (* delete from here. *)
+ end else begin
+ H.add alreadyDefined v ();
+ if H.mem alreadyDeclared v then begin
+ (* Change the earlier declaration to Extern *)
+ let oldS = v.vstorage in
+ ignore (E.log "changing storage of %s from %a\n"
+ v.vname d_storage oldS);
+ v.vstorage <- Extern;
+ let newv = {v with vstorage = oldS} in
+ ChangeDoChildrenPost([GVar(newv, inito, l)], (fun g -> g) )
+ end else
+ DoChildren
+ end
+ | GVar(v, {init=None}, l)
+ | GVarDecl(v, l) when not (isFunctionType v.vtype) -> begin
+ (* A declaration. May have been moved to an earlier position. *)
+ if H.mem alreadyDefined v || H.mem alreadyDeclared v then
+ ChangeTo [] (* delete from here. *)
+ else begin
+ H.add alreadyDeclared v ();
+ DoChildren
+ end
+ end
+ | GFun(f, l) ->
+ currentFunction <- f;
+ DoChildren
+ | _ ->
+ DoChildren
+
+(* #2. rename any identifiers whose names are C++ keywords *)
+ method vvdec v =
+ match v.vname with
+ | "bool"
+ | "catch"
+ | "cdecl"
+ | "class"
+ | "const_cast"
+ | "delete"
+ | "dynamic_cast"
+ | "explicit"
+ | "export"
+ | "false"
+ | "friend"
+ | "mutable"
+ | "namespace"
+ | "new"
+ | "operator"
+ | "pascal"
+ | "private"
+ | "protected"
+ | "public"
+ | "register"
+ | "reinterpret_cast"
+ | "static_cast"
+ | "template"
+ | "this"
+ | "throw"
+ | "true"
+ | "try"
+ | "typeid"
+ | "typename"
+ | "using"
+ | "virtual"
+ | "wchar_t"->
+ v.vname <- v.vname ^ "__cil2cpp";
+ DoChildren
+ | _ -> DoChildren
+
+ method vinst i =
+(* #5. If an assignment or function call uses expressions as enum values,
+ add an explicit cast. *)
+ match i with
+ Set (dest, exp, l) -> begin
+ let typeOfDest = typeOfLval dest in
+ match unrollType typeOfDest with
+ TEnum _ -> (* add an explicit cast *)
+ let newI = Set(dest, mkCast exp typeOfDest, l) in
+ ChangeTo [newI]
+ | _ -> SkipChildren
+ end
+ | Call (dest, f, args, l) -> begin
+ let rt, formals, isva, attrs = splitFunctionType (typeOf f) in
+ if isva then
+ SkipChildren (* ignore vararg functions *)
+ else
+ match formals with
+ Some formals' -> begin
+ let newArgs = try
+ (*Iterate over the arguments, looking for formals that
+ expect enum types, and insert casts where necessary. *)
+ List.map2
+ (fun (actual: exp) (formalName, formalType, _) ->
+ match unrollType formalType with
+ TEnum _ -> mkCast actual formalType
+ | _ -> actual)
+ args
+ formals'
+ with Invalid_argument _ ->
+ E.s (error "Number of arguments to %a doesn't match type.\n"
+ d_exp f)
+ in
+ let newI = Call(dest, f, newArgs, l) in
+ ChangeTo [newI]
+ end
+ | None -> begin
+ (* #4. No arguments were specified for this type. To fix this, infer the
+ type from the arguments that are used n this instruction, and insert
+ a cast to that type.*)
+ match f with
+ Lval(Mem(fp), off) ->
+ let counter: int ref = ref 0 in
+ let newFormals = List.map
+ (fun (actual:exp) ->
+ incr counter;
+ let formalName = "a" ^ (string_of_int !counter) in
+ (formalName, typeOf actual, []))(* (name,type,attrs) *)
+ args in
+ let newFuncPtrType =
+ TPtr((TFun (rt, Some newFormals, false, attrs)), []) in
+ let newFuncPtr = Lval(Mem(mkCast fp newFuncPtrType), off) in
+ ChangeTo [Call(dest, newFuncPtr, args, l)]
+ | _ ->
+ ignore (warn "cppcanon: %a has no specified arguments, but it's not a function pointer." d_exp f);
+ SkipChildren
+ end
+ end
+ | _ -> SkipChildren
+
+ method vinit i =
+(* #5. If an initializer uses expressions as enum values,
+ add an explicit cast. *)
+ match i with
+ SingleInit e -> DoChildren (* we don't handle simple initializers here,
+ because we don't know what type is expected.
+ This should be done in vglob if needed. *)
+ | CompoundInit(t, initList) ->
+ let changed: bool ref = ref false in
+ let initList' = List.map
+ (* iterate over the list, adding casts for any expression that
+ is expected to be an enum type. *)
+ (function
+ (Field(fi, off), SingleInit e) -> begin
+ match unrollType fi.ftype with
+ TEnum _ -> (* add an explicit cast *)
+ let newE = mkCast e fi.ftype in
+ changed := true;
+ (Field(fi, off), SingleInit newE)
+ | _ -> (* not enum, no cast needed *)
+ (Field(fi, off), SingleInit e)
+ end
+ | other ->
+ (* This is a more complicated initializer, and I don't think
+ it can have type enum. It's children might, though. *)
+ other)
+ initList in
+ if !changed then begin
+ (* There may be other casts needed in other parts of the
+ initialization, so do the children too. *)
+ ChangeDoChildrenPost(CompoundInit(t, initList'), (fun x -> x))
+ end else
+ DoChildren
+
+
+(* #5. If a function returns an enum type, add an explicit cast to the
+ return type. *)
+ method vstmt stmt =
+ (match stmt.skind with
+ Return (Some exp, l) -> begin
+ let typeOfDest, _, _, _ =
+ splitFunctionType currentFunction.svar.vtype in
+ match unrollType typeOfDest with
+ TEnum _ ->
+ stmt.skind <- Return (Some (mkCast exp typeOfDest), l)
+ | _ -> ()
+ end
+ | _ -> ());
+ DoChildren
+end (* class canonicalizeVisitor *)
+
+
+
+(* Entry point for this extension *)
+let canonicalize (f:file) =
+ visitCilFile (new canonicalizeVisitor) f;
+
+ (* #3. Finally, add some #defines to change C keywords to their C++
+ equivalents: *)
+ f.globals <-
+ GText( "#ifdef __cplusplus\n"
+ ^" #define __restrict\n" (* "restrict" doesn't work *)
+ ^" #define __inline inline\n"
+ ^"#endif")
+ ::f.globals
+
+
+
+let feature : featureDescr =
+ { fd_name = "canonicalize";
+ fd_enabled = ref false;
+ fd_description = "fixing some C-isms so that the result is C++ compliant.";
+ fd_extraopt = [];
+ fd_doit = canonicalize;
+ fd_post_check = true;
+ }
diff --git a/cil/src/ext/canonicalize.mli b/cil/src/ext/canonicalize.mli
new file mode 100644
index 0000000..37bc0d8
--- /dev/null
+++ b/cil/src/ext/canonicalize.mli
@@ -0,0 +1,48 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(************************************************************************
+ * canonicalize performs several transformations to correct differences
+ * between C and C++, so that the output is (hopefully) valid C++ code.
+ * This is incomplete -- certain fixes which are necessary
+ * for some programs are not yet implemented.
+ *
+ * See canonicalize.ml for a list of changes.
+ *
+ ************************************************************************)
+
+val feature: Cil.featureDescr
diff --git a/cil/src/ext/cfg.ml b/cil/src/ext/cfg.ml
new file mode 100644
index 0000000..8b19c79
--- /dev/null
+++ b/cil/src/ext/cfg.ml
@@ -0,0 +1,289 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Simon Goldsmith <sfg@cs.berkeley.edu>
+ * S.P Rahul, Aman Bhargava
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* Authors: Aman Bhargava, S. P. Rahul *)
+(* sfg: this stuff was stolen from optim.ml - the code to print the cfg as
+ a dot graph is mine *)
+
+open Pretty
+open Cil
+module E=Errormsg
+
+(* entry points: cfgFun, printCfgChannel, printCfgFilename *)
+
+(* known issues:
+ * -sucessors of if somehow end up with two edges each
+ *)
+
+(*------------------------------------------------------------*)
+(* Notes regarding CFG computation:
+ 1) Initially only succs and preds are computed. sid's are filled in
+ later, in whatever order is suitable (e.g. for forward problems, reverse
+ depth-first postorder).
+ 2) If a stmt (return, break or continue) has no successors, then
+ function return must follow.
+ No predecessors means it is the start of the function
+ 3) We use the fact that initially all the succs and preds are assigned []
+*)
+
+(* Fill in the CFG info for the stmts in a block
+ next = succ of the last stmt in this block
+ break = succ of any Break in this block
+ cont = succ of any Continue in this block
+ None means the succ is the function return. It does not mean the break/cont
+ is invalid. We assume the validity has already been checked.
+*)
+(* At the end of CFG computation,
+ - numNodes = total number of CFG nodes
+ - length(nodeList) = numNodes
+*)
+
+let numNodes = ref 0 (* number of nodes in the CFG *)
+let nodeList : stmt list ref = ref [] (* All the nodes in a flat list *) (* ab: Added to change dfs from quadratic to linear *)
+let start_id = ref 0 (* for unique ids across many functions *)
+
+(* entry point *)
+
+(** Compute a control flow graph for fd. Stmts in fd have preds and succs
+ filled in *)
+let rec cfgFun (fd : fundec): int =
+ begin
+ numNodes := !start_id;
+ nodeList := [];
+
+ cfgBlock fd.sbody None None None;
+ !numNodes - !start_id
+ end
+
+
+and cfgStmts (ss: stmt list)
+ (next:stmt option) (break:stmt option) (cont:stmt option) =
+ match ss with
+ [] -> ();
+ | [s] -> cfgStmt s next break cont
+ | hd::tl ->
+ cfgStmt hd (Some (List.hd tl)) break cont;
+ cfgStmts tl next break cont
+
+and cfgBlock (blk: block)
+ (next:stmt option) (break:stmt option) (cont:stmt option) =
+ cfgStmts blk.bstmts next break cont
+
+(* Fill in the CFG info for a stmt
+ Meaning of next, break, cont should be clear from earlier comment
+*)
+and cfgStmt (s: stmt) (next:stmt option) (break:stmt option) (cont:stmt option) =
+ incr numNodes;
+ s.sid <- !numNodes;
+ nodeList := s :: !nodeList; (* Future traversals can be made in linear time. e.g. *)
+ if s.succs <> [] then
+ E.s (bug "CFG must be cleared before being computed!");
+ let addSucc (n: stmt) =
+ if not (List.memq n s.succs) then
+ s.succs <- n::s.succs;
+ if not (List.memq s n.preds) then
+ n.preds <- s::n.preds
+ in
+ let addOptionSucc (n: stmt option) =
+ match n with
+ None -> ()
+ | Some n' -> addSucc n'
+ in
+ let addBlockSucc (b: block) =
+ match b.bstmts with
+ [] -> addOptionSucc next
+ | hd::_ -> addSucc hd
+ in
+ match s.skind with
+ Instr _ -> addOptionSucc next
+ | Return _ -> ()
+ | Goto (p,_) -> addSucc !p
+ | Break _ -> addOptionSucc break
+ | Continue _ -> addOptionSucc cont
+ | If (_, blk1, blk2, _) ->
+ (* The succs of If is [true branch;false branch] *)
+ addBlockSucc blk2;
+ addBlockSucc blk1;
+ cfgBlock blk1 next break cont;
+ cfgBlock blk2 next break cont
+ | Block b ->
+ addBlockSucc b;
+ cfgBlock b next break cont
+ | Switch(_,blk,l,_) ->
+ List.iter addSucc (List.rev l); (* Add successors in order *)
+ (* sfg: if there's no default, need to connect s->next *)
+ if not (List.exists
+ (fun stmt -> List.exists
+ (function Default _ -> true | _ -> false)
+ stmt.labels)
+ l)
+ then
+ addOptionSucc next;
+ cfgBlock blk next next cont
+(*
+ | Loop(blk,_,_,_) ->
+*)
+ | While(_,blk,_)
+ | DoWhile(_,blk,_)
+ | For(_,_,_,blk,_) ->
+ addBlockSucc blk;
+ cfgBlock blk (Some s) next (Some s)
+ (* Since all loops have terminating condition true, we don't put
+ any direct successor to stmt following the loop *)
+ | TryExcept _ | TryFinally _ ->
+ E.s (E.unimp "try/except/finally")
+
+(*------------------------------------------------------------*)
+
+(**************************************************************)
+(* do something for all stmts in a fundec *)
+
+let rec forallStmts (todo) (fd : fundec) =
+ begin
+ fasBlock todo fd.sbody;
+ end
+
+and fasBlock (todo) (b : block) =
+ List.iter (fasStmt todo) b.bstmts
+
+and fasStmt (todo) (s : stmt) =
+ begin
+ ignore(todo s);
+ match s.skind with
+ | Block b -> fasBlock todo b
+ | If (_, tb, fb, _) -> (fasBlock todo tb; fasBlock todo fb)
+ | Switch (_, b, _, _) -> fasBlock todo b
+(*
+ | Loop (b, _, _, _) -> fasBlock todo b
+*)
+ | While (_, b, _) -> fasBlock todo b
+ | DoWhile (_, b, _) -> fasBlock todo b
+ | For (_, _, _, b, _) -> fasBlock todo b
+ | (Return _ | Break _ | Continue _ | Goto _ | Instr _) -> ()
+ | TryExcept _ | TryFinally _ -> E.s (E.unimp "try/except/finally")
+ end
+;;
+
+(**************************************************************)
+(* printing the control flow graph - you have to compute it first *)
+
+let d_cfgnodename () (s : stmt) =
+ dprintf "%d" s.sid
+
+let d_cfgnodelabel () (s : stmt) =
+ let label =
+ begin
+ match s.skind with
+ | If (e, _, _, _) -> "if" (*sprint ~width:999 (dprintf "if %a" d_exp e)*)
+(*
+ | Loop _ -> "loop"
+*)
+ | While _ -> "while"
+ | DoWhile _ -> "dowhile"
+ | For _ -> "for"
+ | Break _ -> "break"
+ | Continue _ -> "continue"
+ | Goto _ -> "goto"
+ | Instr _ -> "instr"
+ | Switch _ -> "switch"
+ | Block _ -> "block"
+ | Return _ -> "return"
+ | TryExcept _ -> "try-except"
+ | TryFinally _ -> "try-finally"
+ end in
+ dprintf "%d: %s" s.sid label
+
+let d_cfgedge (src) () (dest) =
+ dprintf "%a -> %a"
+ d_cfgnodename src
+ d_cfgnodename dest
+
+let d_cfgnode () (s : stmt) =
+ dprintf "%a [label=\"%a\"]\n\t%a"
+ d_cfgnodename s
+ d_cfgnodelabel s
+ (d_list "\n\t" (d_cfgedge s)) s.succs
+
+(**********************************************************************)
+(* entry points *)
+
+(** print control flow graph (in dot form) for fundec to channel *)
+let printCfgChannel (chan : out_channel) (fd : fundec) =
+ let pnode (s:stmt) = fprintf chan "%a\n" d_cfgnode s in
+ begin
+ ignore (fprintf chan "digraph CFG_%s {\n" fd.svar.vname);
+ forallStmts pnode fd;
+ ignore(fprintf chan "}\n");
+ end
+
+(** Print control flow graph (in dot form) for fundec to file *)
+let printCfgFilename (filename : string) (fd : fundec) =
+ let chan = open_out filename in
+ begin
+ printCfgChannel chan fd;
+ close_out chan;
+ end
+
+
+;;
+
+(**********************************************************************)
+
+let clearCFGinfo (fd : fundec) =
+ let clear s =
+ s.sid <- -1;
+ s.succs <- [];
+ s.preds <- [];
+ in
+ forallStmts clear fd
+
+let clearFileCFG (f : file) =
+ iterGlobals f (fun g ->
+ match g with GFun(fd,_) ->
+ clearCFGinfo fd
+ | _ -> ())
+
+let computeFileCFG (f : file) =
+ iterGlobals f (fun g ->
+ match g with GFun(fd,_) ->
+ numNodes := cfgFun fd;
+ start_id := !start_id + !numNodes
+ | _ -> ())
diff --git a/cil/src/ext/cfg.mli b/cil/src/ext/cfg.mli
new file mode 100644
index 0000000..19c5166
--- /dev/null
+++ b/cil/src/ext/cfg.mli
@@ -0,0 +1,36 @@
+(** Code to compute the control-flow graph of a function or file.
+ This will fill in the [preds] and [succs] fields of {!Cil.stmt}
+
+ This is required for several other extensions, such as {!Dataflow}.
+*)
+
+open Cil
+
+
+(** Compute the CFG for an entire file, by calling cfgFun on each function. *)
+val computeFileCFG: Cil.file -> unit
+
+(** clear the sid, succs, and preds fields of each statement. *)
+val clearFileCFG: Cil.file -> unit
+
+(** Compute a control flow graph for fd. Stmts in fd have preds and succs
+ filled in *)
+val cfgFun : fundec -> int
+
+(** clear the sid, succs, and preds fields of each statment in a function *)
+val clearCFGinfo: Cil.fundec -> unit
+
+(** print control flow graph (in dot form) for fundec to channel *)
+val printCfgChannel : out_channel -> fundec -> unit
+
+(** Print control flow graph (in dot form) for fundec to file *)
+val printCfgFilename : string -> fundec -> unit
+
+(** Next statement id that will be assigned. *)
+val start_id: int ref
+
+(** All of the nodes in a file. *)
+val nodeList : stmt list ref
+
+(** number of nodes in the CFG *)
+val numNodes : int ref
diff --git a/cil/src/ext/ciltools.ml b/cil/src/ext/ciltools.ml
new file mode 100755
index 0000000..78f1aaf
--- /dev/null
+++ b/cil/src/ext/ciltools.ml
@@ -0,0 +1,228 @@
+open Cil
+
+(* Contributed by Nathan Cooprider *)
+
+let isOne e =
+ isInteger e = Some Int64.one
+
+
+(* written by Zach *)
+let is_volatile_tp tp =
+ List.exists (function (Attr("volatile",_)) -> true
+ | _ -> false) (typeAttrs tp)
+
+(* written by Zach *)
+let is_volatile_vi vi =
+ let vi_vol =
+ List.exists (function (Attr("volatile",_)) -> true
+ | _ -> false) vi.vattr in
+ let typ_vol = is_volatile_tp vi.vtype in
+ vi_vol || typ_vol
+
+(*****************************************************************************
+ * A collection of useful functions that were not already in CIL as far as I
+ * could tell. However, I have been surprised before . . .
+ ****************************************************************************)
+
+type sign = Signed | Unsigned
+
+exception Not_an_integer
+
+(*****************************************************************************
+ * A bunch of functions for accessing integers. Originally written for
+ * somebody who didn't know CIL and just wanted to mess with it at the
+ * OCaml level.
+ ****************************************************************************)
+
+let unbox_int_type (ye : typ) : (int * sign) =
+ let tp = unrollType ye in
+ let s =
+ match tp with
+ TInt (i, _) ->
+ if (isSigned i) then
+ Signed
+ else
+ Unsigned
+ | _ -> raise Not_an_integer
+ in
+ (bitsSizeOf tp), s
+
+(* depricated. Use isInteger directly instead *)
+let unbox_int_exp (e : exp) : int64 =
+ match isInteger e with
+ None -> raise Not_an_integer
+ | Some (x) -> x
+
+let box_int_to_exp (n : int64) (ye : typ) : exp =
+ let tp = unrollType ye in
+ match tp with
+ TInt (i, _) ->
+ kinteger64 i n
+ | _ -> raise Not_an_integer
+
+let cil_to_ocaml_int (e : exp) : (int64 * int * sign) =
+ let v, s = unbox_int_type (typeOf e) in
+ unbox_int_exp (e), v, s
+
+exception Weird_bitwidth
+
+(* (int64 * int * sign) : exp *)
+let ocaml_int_to_cil v n s =
+ let char_size = bitsSizeOf charType in
+ let int_size = bitsSizeOf intType in
+ let short_size = bitsSizeOf (TInt(IShort,[]))in
+ let long_size = bitsSizeOf longType in
+ let longlong_size = bitsSizeOf (TInt(ILongLong,[])) in
+ let i =
+ match s with
+ Signed ->
+ if (n = char_size) then
+ ISChar
+ else if (n = int_size) then
+ IInt
+ else if (n = short_size) then
+ IShort
+ else if (n = long_size) then
+ ILong
+ else if (n = longlong_size) then
+ ILongLong
+ else
+ raise Weird_bitwidth
+ | Unsigned ->
+ if (n = char_size) then
+ IUChar
+ else if (n = int_size) then
+ IUInt
+ else if (n = short_size) then
+ IUShort
+ else if (n = long_size) then
+ IULong
+ else if (n = longlong_size) then
+ IULongLong
+ else
+ raise Weird_bitwidth
+ in
+ kinteger64 i v
+
+(*****************************************************************************
+ * a couple of type functions that I thought would be useful:
+ ****************************************************************************)
+
+let rec isCompositeType tp =
+ match tp with
+ TComp _ -> true
+ | TPtr(x, _) -> isCompositeType x
+ | TArray(x,_,_) -> isCompositeType x
+ | TFun(x,_,_,_) -> isCompositeType x
+ | TNamed (x,_) -> isCompositeType x.ttype
+ | _ -> false
+
+(** START OF deepHasAttribute ************************************************)
+let visited = ref []
+class attribute_checker target rflag = object (self)
+ inherit nopCilVisitor
+ method vtype t =
+ match t with
+ TComp(cinfo, a) ->
+ if(not (List.exists (fun x -> cinfo.cname = x) !visited )) then begin
+ visited := cinfo.cname :: !visited;
+ List.iter
+ (fun f ->
+ if (hasAttribute target f.fattr) then
+ rflag := true
+ else
+ ignore(visitCilType (new attribute_checker target rflag)
+ f.ftype)) cinfo.cfields;
+ end;
+ DoChildren
+ | TNamed(t1, a) ->
+ if(not (List.exists (fun x -> t1.tname = x) !visited )) then begin
+ visited := t1.tname :: !visited;
+ ignore(visitCilType (new attribute_checker target rflag) t1.ttype);
+ end;
+ DoChildren
+ | _ ->
+ DoChildren
+ method vattr (Attr(name,params)) =
+ if (name = target) then rflag := true;
+ DoChildren
+end
+
+let deepHasAttribute s t =
+ let found = ref false in
+ visited := [];
+ ignore(visitCilType (new attribute_checker s found) t);
+ !found
+(** END OF deepHasAttribute **************************************************)
+
+(** Stuff from ptranal, slightly modified ************************************)
+
+(*****************************************************************************
+ * A transformation to make every instruction be in its own statement.
+ ****************************************************************************)
+
+class callBBVisitor = object
+ inherit nopCilVisitor
+
+ method vstmt s =
+ match s.skind with
+ Instr(il) -> begin
+ if (List.length il > 1) then
+ let list_of_stmts = List.map (fun one_inst ->
+ mkStmtOneInstr one_inst) il in
+ let block = mkBlock list_of_stmts in
+ s.skind <- Block block;
+ ChangeTo(s)
+ else
+ SkipChildren
+ end
+ | _ -> DoChildren
+
+ method vvdec _ = SkipChildren
+ method vexpr _ = SkipChildren
+ method vlval _ = SkipChildren
+ method vtype _ = SkipChildren
+end
+
+let one_instruction_per_statement f =
+ let thisVisitor = new callBBVisitor in
+ visitCilFileSameGlobals thisVisitor f
+
+(*****************************************************************************
+ * A transformation that gives each variable a unique identifier.
+ ****************************************************************************)
+
+class vidVisitor = object
+ inherit nopCilVisitor
+ val count = ref 0
+
+ method vvdec vi =
+ vi.vid <- !count ;
+ incr count ; SkipChildren
+end
+
+let globally_unique_vids f =
+ let thisVisitor = new vidVisitor in
+ visitCilFileSameGlobals thisVisitor f
+
+(** End of stuff from ptranal ************************************************)
+
+class sidVisitor = object
+ inherit nopCilVisitor
+ val count = ref 0
+
+ method vstmt s =
+ s.sid <- !count ;
+ incr count ;
+ DoChildren
+end
+
+let globally_unique_sids f =
+ let thisVisitor = new sidVisitor in
+ visitCilFileSameGlobals thisVisitor f
+
+(** Comparing expressions without a Out_of_memory error **********************)
+
+let compare_exp x y =
+ compare x y
+
diff --git a/cil/src/ext/dataflow.ml b/cil/src/ext/dataflow.ml
new file mode 100755
index 0000000..7f28f84
--- /dev/null
+++ b/cil/src/ext/dataflow.ml
@@ -0,0 +1,466 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+module IH = Inthash
+module E = Errormsg
+
+open Cil
+open Pretty
+
+(** A framework for data flow analysis for CIL code. Before using
+ this framework, you must initialize the Control-flow Graph for your
+ program, e.g using {!Cfg.computeFileCFG} *)
+
+type 't action =
+ Default (** The default action *)
+ | Done of 't (** Do not do the default action. Use this result *)
+ | Post of ('t -> 't) (** The default action, followed by the given
+ * transformer *)
+
+type 't stmtaction =
+ SDefault (** The default action *)
+ | SDone (** Do not visit this statement or its successors *)
+ | SUse of 't (** Visit the instructions and successors of this statement
+ as usual, but use the specified state instead of the
+ one that was passed to doStmt *)
+
+(* For if statements *)
+type 't guardaction =
+ GDefault (** The default state *)
+ | GUse of 't (** Use this data for the branch *)
+ | GUnreachable (** The branch will never be taken. *)
+
+
+(******************************************************************
+ **********
+ ********** FORWARDS
+ **********
+ ********************************************************************)
+
+module type ForwardsTransfer = sig
+ val name: string (** For debugging purposes, the name of the analysis *)
+
+ val debug: bool ref (** Whether to turn on debugging *)
+
+ type t (** The type of the data we compute for each block start. May be
+ * imperative. *)
+
+ val copy: t -> t
+ (** Make a deep copy of the data *)
+
+
+ val stmtStartData: t Inthash.t
+ (** For each statement id, the data at the start. Not found in the hash
+ * table means nothing is known about the state at this point. At the end
+ * of the analysis this means that the block is not reachable. *)
+
+ val pretty: unit -> t -> Pretty.doc
+ (** Pretty-print the state *)
+
+ val computeFirstPredecessor: Cil.stmt -> t -> t
+ (** Give the first value for a predecessors, compute the value to be set
+ * for the block *)
+
+ val combinePredecessors: Cil.stmt -> old:t -> t -> t option
+ (** Take some old data for the start of a statement, and some new data for
+ * the same point. Return None if the combination is identical to the old
+ * data. Otherwise, compute the combination, and return it. *)
+
+ val doInstr: Cil.instr -> t -> t action
+ (** The (forwards) transfer function for an instruction. The
+ * {!Cil.currentLoc} is set before calling this. The default action is to
+ * continue with the state unchanged. *)
+
+ val doStmt: Cil.stmt -> t -> t stmtaction
+ (** The (forwards) transfer function for a statement. The {!Cil.currentLoc}
+ * is set before calling this. The default action is to do the instructions
+ * in this statement, if applicable, and continue with the successors. *)
+
+ val doGuard: Cil.exp -> t -> t guardaction
+ (** Generate the successor to an If statement assuming the given expression
+ * is nonzero. Analyses that don't need guard information can return
+ * GDefault; this is equivalent to returning GUse of the input.
+ * A return value of GUnreachable indicates that this half of the branch
+ * will not be taken and should not be explored. This will be called
+ * twice per If, once for "then" and once for "else".
+ *)
+
+ val filterStmt: Cil.stmt -> bool
+ (** Whether to put this statement in the worklist. This is called when a
+ * block would normally be put in the worklist. *)
+
+end
+
+
+module ForwardsDataFlow =
+ functor (T : ForwardsTransfer) ->
+ struct
+
+ (** Keep a worklist of statements to process. It is best to keep a queue,
+ * because this way it is more likely that we are going to process all
+ * predecessors of a statement before the statement itself. *)
+ let worklist: Cil.stmt Queue.t = Queue.create ()
+
+ (** We call this function when we have encountered a statement, with some
+ * state. *)
+ let reachedStatement (s: stmt) (d: T.t) : unit =
+ (** see if we know about it already *)
+ E.pushContext (fun _ -> dprintf "Reached statement %d with %a"
+ s.sid T.pretty d);
+ let newdata: T.t option =
+ try
+ let old = IH.find T.stmtStartData s.sid in
+ match T.combinePredecessors s ~old:old d with
+ None -> (* We are done here *)
+ if !T.debug then
+ ignore (E.log "FF(%s): reached stmt %d with %a\n implies the old state %a\n"
+ T.name s.sid T.pretty d T.pretty old);
+ None
+ | Some d' -> begin
+ (* We have changed the data *)
+ if !T.debug then
+ ignore (E.log "FF(%s): weaken data for block %d: %a\n"
+ T.name s.sid T.pretty d');
+ Some d'
+ end
+ with Not_found -> (* was bottom before *)
+ let d' = T.computeFirstPredecessor s d in
+ if !T.debug then
+ ignore (E.log "FF(%s): set data for block %d: %a\n"
+ T.name s.sid T.pretty d');
+ Some d'
+ in
+ E.popContext ();
+ match newdata with
+ None -> ()
+ | Some d' ->
+ IH.replace T.stmtStartData s.sid d';
+ if T.filterStmt s &&
+ not (Queue.fold (fun exists s' -> exists || s'.sid = s.sid)
+ false
+ worklist) then
+ Queue.add s worklist
+
+
+ (** Get the two successors of an If statement *)
+ let ifSuccs (s:stmt) : stmt * stmt =
+ let fstStmt blk = match blk.bstmts with
+ [] -> Cil.dummyStmt
+ | fst::_ -> fst
+ in
+ match s.skind with
+ If(e, b1, b2, _) ->
+ let thenSucc = fstStmt b1 in
+ let elseSucc = fstStmt b2 in
+ let oneFallthrough () =
+ let fallthrough =
+ List.filter
+ (fun s' -> thenSucc != s' && elseSucc != s')
+ s.succs
+ in
+ match fallthrough with
+ [] -> E.s (bug "Bad CFG: missing fallthrough for If.")
+ | [s'] -> s'
+ | _ -> E.s (bug "Bad CFG: multiple fallthrough for If.")
+ in
+ (* If thenSucc or elseSucc is Cil.dummyStmt, it's an empty block.
+ So the successor is the statement after the if *)
+ let stmtOrFallthrough s' =
+ if s' == Cil.dummyStmt then
+ oneFallthrough ()
+ else
+ s'
+ in
+ (stmtOrFallthrough thenSucc,
+ stmtOrFallthrough elseSucc)
+
+ | _-> E.s (bug "ifSuccs on a non-If Statement.")
+
+ (** Process a statement *)
+ let processStmt (s: stmt) : unit =
+ currentLoc := get_stmtLoc s.skind;
+ if !T.debug then
+ ignore (E.log "FF(%s).stmt %d at %t\n" T.name s.sid d_thisloc);
+
+ (* It must be the case that the block has some data *)
+ let init: T.t =
+ try T.copy (IH.find T.stmtStartData s.sid)
+ with Not_found ->
+ E.s (E.bug "FF(%s): processing block without data" T.name)
+ in
+
+ (** See what the custom says *)
+ match T.doStmt s init with
+ SDone -> ()
+ | (SDefault | SUse _) as act -> begin
+ let curr = match act with
+ SDefault -> init
+ | SUse d -> d
+ | SDone -> E.s (bug "SDone")
+ in
+ (* Do the instructions in order *)
+ let handleInstruction (s: T.t) (i: instr) : T.t =
+ currentLoc := get_instrLoc i;
+
+ (* Now handle the instruction itself *)
+ let s' =
+ let action = T.doInstr i s in
+ match action with
+ | Done s' -> s'
+ | Default -> s (* do nothing *)
+ | Post f -> f s
+ in
+ s'
+ in
+
+ let after: T.t =
+ match s.skind with
+ Instr il ->
+ (* Handle instructions starting with the first one *)
+ List.fold_left handleInstruction curr il
+
+ | Goto _ | Break _ | Continue _ | If _
+ | TryExcept _ | TryFinally _
+ | Switch _ | (*Loop _*) While _ | DoWhile _ | For _
+ | Return _ | Block _ -> curr
+ in
+ currentLoc := get_stmtLoc s.skind;
+
+ (* Handle If guards *)
+ let succsToReach = match s.skind with
+ If (e, _, _, _) -> begin
+ let not_e = UnOp(LNot, e, intType) in
+ let thenGuard = T.doGuard e after in
+ let elseGuard = T.doGuard not_e after in
+ if thenGuard = GDefault && elseGuard = GDefault then
+ (* this is the common case *)
+ s.succs
+ else begin
+ let doBranch succ guard =
+ match guard with
+ GDefault -> reachedStatement succ after
+ | GUse d -> reachedStatement succ d
+ | GUnreachable ->
+ if !T.debug then
+ ignore (E.log "FF(%s): Not exploring branch to %d\n"
+ T.name succ.sid);
+
+ ()
+ in
+ let thenSucc, elseSucc = ifSuccs s in
+ doBranch thenSucc thenGuard;
+ doBranch elseSucc elseGuard;
+ []
+ end
+ end
+ | _ -> s.succs
+ in
+ (* Reach the successors *)
+ List.iter (fun s' -> reachedStatement s' after) succsToReach;
+
+ end
+
+
+
+
+ (** Compute the data flow. Must have the CFG initialized *)
+ let compute (sources: stmt list) =
+ Queue.clear worklist;
+ List.iter (fun s -> Queue.add s worklist) sources;
+
+ (** All initial stmts must have non-bottom data *)
+ List.iter (fun s ->
+ if not (IH.mem T.stmtStartData s.sid) then
+ E.s (E.error "FF(%s): initial stmt %d does not have data"
+ T.name s.sid))
+ sources;
+ if !T.debug then
+ ignore (E.log "\nFF(%s): processing\n"
+ T.name);
+ let rec fixedpoint () =
+ if !T.debug && not (Queue.is_empty worklist) then
+ ignore (E.log "FF(%s): worklist= %a\n"
+ T.name
+ (docList (fun s -> num s.sid))
+ (List.rev
+ (Queue.fold (fun acc s -> s :: acc) [] worklist)));
+ try
+ let s = Queue.take worklist in
+ processStmt s;
+ fixedpoint ();
+ with Queue.Empty ->
+ if !T.debug then
+ ignore (E.log "FF(%s): done\n\n" T.name)
+ in
+ fixedpoint ()
+
+ end
+
+
+
+(******************************************************************
+ **********
+ ********** BACKWARDS
+ **********
+ ********************************************************************)
+module type BackwardsTransfer = sig
+ val name: string (* For debugging purposes, the name of the analysis *)
+
+ val debug: bool ref (** Whether to turn on debugging *)
+
+ type t (** The type of the data we compute for each block start. In many
+ * presentations of backwards data flow analysis we maintain the
+ * data at the block end. This is not easy to do with JVML because
+ * a block has many exceptional ends. So we maintain the data for
+ * the statement start. *)
+
+ val pretty: unit -> t -> Pretty.doc (** Pretty-print the state *)
+
+ val stmtStartData: t Inthash.t
+ (** For each block id, the data at the start. This data structure must be
+ * initialized with the initial data for each block *)
+
+ val combineStmtStartData: Cil.stmt -> old:t -> t -> t option
+ (** When the analysis reaches the start of a block, combine the old data
+ * with the one we have just computed. Return None if the combination is
+ * the same as the old data, otherwise return the combination. In the
+ * latter case, the predecessors of the statement are put on the working
+ * list. *)
+
+
+ val combineSuccessors: t -> t -> t
+ (** Take the data from two successors and combine it *)
+
+
+ val doStmt: Cil.stmt -> t action
+ (** The (backwards) transfer function for a branch. The {!Cil.currentLoc} is
+ * set before calling this. If it returns None, then we have some default
+ * handling. Otherwise, the returned data is the data before the branch
+ * (not considering the exception handlers) *)
+
+ val doInstr: Cil.instr -> t -> t action
+ (** The (backwards) transfer function for an instruction. The
+ * {!Cil.currentLoc} is set before calling this. If it returns None, then we
+ * have some default handling. Otherwise, the returned data is the data
+ * before the branch (not considering the exception handlers) *)
+
+ val filterStmt: Cil.stmt -> Cil.stmt -> bool
+ (** Whether to put this predecessor block in the worklist. We give the
+ * predecessor and the block whose predecessor we are (and whose data has
+ * changed) *)
+
+end
+
+module BackwardsDataFlow =
+ functor (T : BackwardsTransfer) ->
+ struct
+
+ let getStmtStartData (s: stmt) : T.t =
+ try IH.find T.stmtStartData s.sid
+ with Not_found ->
+ E.s (E.bug "BF(%s): stmtStartData is not initialized for %d"
+ T.name s.sid)
+
+ (** Process a statement and return true if the set of live return
+ * addresses on its entry has changed. *)
+ let processStmt (s: stmt) : bool =
+ if !T.debug then
+ ignore (E.log "FF(%s).stmt %d\n" T.name s.sid);
+
+
+ (* Find the state before the branch *)
+ currentLoc := get_stmtLoc s.skind;
+ let d: T.t =
+ match T.doStmt s with
+ Done d -> d
+ | (Default | Post _) as action -> begin
+ (* Do the default one. Combine the successors *)
+ let res =
+ match s.succs with
+ [] -> E.s (E.bug "You must doStmt for the statements with no successors")
+ | fst :: rest ->
+ List.fold_left (fun acc succ ->
+ T.combineSuccessors acc (getStmtStartData succ))
+ (getStmtStartData fst)
+ rest
+ in
+ (* Now do the instructions *)
+ let res' =
+ match s.skind with
+ Instr il ->
+ (* Now scan the instructions in reverse order. This may
+ * Stack_overflow on very long blocks ! *)
+ let handleInstruction (i: instr) (s: T.t) : T.t =
+ currentLoc := get_instrLoc i;
+ (* First handle the instruction itself *)
+ let action = T.doInstr i s in
+ match action with
+ | Done s' -> s'
+ | Default -> s (* do nothing *)
+ | Post f -> f s
+ in
+ (* Handle instructions starting with the last one *)
+ List.fold_right handleInstruction il res
+
+ | _ -> res
+ in
+ match action with
+ Post f -> f res'
+ | _ -> res'
+ end
+ in
+
+ (* See if the state has changed. The only changes are that it may grow.*)
+ let s0 = getStmtStartData s in
+
+ match T.combineStmtStartData s ~old:s0 d with
+ None -> (* The old data is good enough *)
+ false
+
+ | Some d' ->
+ (* We have changed the data *)
+ if !T.debug then
+ ignore (E.log "BF(%s): set data for block %d: %a\n"
+ T.name s.sid T.pretty d');
+ IH.replace T.stmtStartData s.sid d';
+ true
+
+
+ (** Compute the data flow. Must have the CFG initialized *)
+ let compute (sinks: stmt list) =
+ let worklist: Cil.stmt Queue.t = Queue.create () in
+ List.iter (fun s -> Queue.add s worklist) sinks;
+ if !T.debug && not (Queue.is_empty worklist) then
+ ignore (E.log "\nBF(%s): processing\n"
+ T.name);
+ let rec fixedpoint () =
+ if !T.debug && not (Queue.is_empty worklist) then
+ ignore (E.log "BF(%s): worklist= %a\n"
+ T.name
+ (docList (fun s -> num s.sid))
+ (List.rev
+ (Queue.fold (fun acc s -> s :: acc) [] worklist)));
+ try
+ let s = Queue.take worklist in
+ let changes = processStmt s in
+ if changes then begin
+ (* We must add all predecessors of block b, only if not already
+ * in and if the filter accepts them. *)
+ List.iter
+ (fun p ->
+ if not (Queue.fold (fun exists s' -> exists || p.sid = s'.sid)
+ false worklist) &&
+ T.filterStmt p s then
+ Queue.add p worklist)
+ s.preds;
+ end;
+ fixedpoint ();
+
+ with Queue.Empty ->
+ if !T.debug then
+ ignore (E.log "BF(%s): done\n\n" T.name)
+ in
+ fixedpoint ();
+
+ end
+
+
diff --git a/cil/src/ext/dataflow.mli b/cil/src/ext/dataflow.mli
new file mode 100755
index 0000000..e72c5db
--- /dev/null
+++ b/cil/src/ext/dataflow.mli
@@ -0,0 +1,151 @@
+(** A framework for data flow analysis for CIL code. Before using
+ this framework, you must initialize the Control-flow Graph for your
+ program, e.g using {!Cfg.computeFileCFG} *)
+
+type 't action =
+ Default (** The default action *)
+ | Done of 't (** Do not do the default action. Use this result *)
+ | Post of ('t -> 't) (** The default action, followed by the given
+ * transformer *)
+
+type 't stmtaction =
+ SDefault (** The default action *)
+ | SDone (** Do not visit this statement or its successors *)
+ | SUse of 't (** Visit the instructions and successors of this statement
+ as usual, but use the specified state instead of the
+ one that was passed to doStmt *)
+
+(* For if statements *)
+type 't guardaction =
+ GDefault (** The default state *)
+ | GUse of 't (** Use this data for the branch *)
+ | GUnreachable (** The branch will never be taken. *)
+
+
+(******************************************************************
+ **********
+ ********** FORWARDS
+ **********
+ ********************************************************************)
+
+module type ForwardsTransfer = sig
+ val name: string (** For debugging purposes, the name of the analysis *)
+
+ val debug: bool ref (** Whether to turn on debugging *)
+
+ type t (** The type of the data we compute for each block start. May be
+ * imperative. *)
+
+ val copy: t -> t
+ (** Make a deep copy of the data *)
+
+
+ val stmtStartData: t Inthash.t
+ (** For each statement id, the data at the start. Not found in the hash
+ * table means nothing is known about the state at this point. At the end
+ * of the analysis this means that the block is not reachable. *)
+
+ val pretty: unit -> t -> Pretty.doc
+ (** Pretty-print the state *)
+
+ val computeFirstPredecessor: Cil.stmt -> t -> t
+ (** Give the first value for a predecessors, compute the value to be set
+ * for the block *)
+
+ val combinePredecessors: Cil.stmt -> old:t -> t -> t option
+ (** Take some old data for the start of a statement, and some new data for
+ * the same point. Return None if the combination is identical to the old
+ * data. Otherwise, compute the combination, and return it. *)
+
+ val doInstr: Cil.instr -> t -> t action
+ (** The (forwards) transfer function for an instruction. The
+ * {!Cil.currentLoc} is set before calling this. The default action is to
+ * continue with the state unchanged. *)
+
+ val doStmt: Cil.stmt -> t -> t stmtaction
+ (** The (forwards) transfer function for a statement. The {!Cil.currentLoc}
+ * is set before calling this. The default action is to do the instructions
+ * in this statement, if applicable, and continue with the successors. *)
+
+ val doGuard: Cil.exp -> t -> t guardaction
+ (** Generate the successor to an If statement assuming the given expression
+ * is nonzero. Analyses that don't need guard information can return
+ * GDefault; this is equivalent to returning GUse of the input.
+ * A return value of GUnreachable indicates that this half of the branch
+ * will not be taken and should not be explored. This will be called
+ * twice per If, once for "then" and once for "else".
+ *)
+
+ val filterStmt: Cil.stmt -> bool
+ (** Whether to put this statement in the worklist. This is called when a
+ * block would normally be put in the worklist. *)
+
+end
+
+module ForwardsDataFlow (T : ForwardsTransfer) : sig
+ val compute: Cil.stmt list -> unit
+ (** Fill in the T.stmtStartData, given a number of initial statements to
+ * start from. All of the initial statements must have some entry in
+ * T.stmtStartData (i.e., the initial data should not be bottom) *)
+end
+
+(******************************************************************
+ **********
+ ********** BACKWARDS
+ **********
+ ********************************************************************)
+module type BackwardsTransfer = sig
+ val name: string (** For debugging purposes, the name of the analysis *)
+
+ val debug: bool ref (** Whether to turn on debugging *)
+
+ type t (** The type of the data we compute for each block start. In many
+ * presentations of backwards data flow analysis we maintain the
+ * data at the block end. This is not easy to do with JVML because
+ * a block has many exceptional ends. So we maintain the data for
+ * the statement start. *)
+
+ val pretty: unit -> t -> Pretty.doc (** Pretty-print the state *)
+
+ val stmtStartData: t Inthash.t
+ (** For each block id, the data at the start. This data structure must be
+ * initialized with the initial data for each block *)
+
+ val combineStmtStartData: Cil.stmt -> old:t -> t -> t option
+ (** When the analysis reaches the start of a block, combine the old data
+ * with the one we have just computed. Return None if the combination is
+ * the same as the old data, otherwise return the combination. In the
+ * latter case, the predecessors of the statement are put on the working
+ * list. *)
+
+
+ val combineSuccessors: t -> t -> t
+ (** Take the data from two successors and combine it *)
+
+
+ val doStmt: Cil.stmt -> t action
+ (** The (backwards) transfer function for a branch. The {!Cil.currentLoc} is
+ * set before calling this. If it returns None, then we have some default
+ * handling. Otherwise, the returned data is the data before the branch
+ * (not considering the exception handlers) *)
+
+ val doInstr: Cil.instr -> t -> t action
+ (** The (backwards) transfer function for an instruction. The
+ * {!Cil.currentLoc} is set before calling this. If it returns None, then we
+ * have some default handling. Otherwise, the returned data is the data
+ * before the branch (not considering the exception handlers) *)
+
+ val filterStmt: Cil.stmt -> Cil.stmt -> bool
+ (** Whether to put this predecessor block in the worklist. We give the
+ * predecessor and the block whose predecessor we are (and whose data has
+ * changed) *)
+
+end
+
+module BackwardsDataFlow (T : BackwardsTransfer) : sig
+ val compute: Cil.stmt list -> unit
+ (** Fill in the T.stmtStartData, given a number of initial statements to
+ * start from (the sinks for the backwards data flow). All of the statements
+ * (not just the initial ones!) must have some entry in T.stmtStartData
+ * (i.e., the initial data should not be bottom) *)
+end
diff --git a/cil/src/ext/dataslicing.ml b/cil/src/ext/dataslicing.ml
new file mode 100644
index 0000000..35390b4
--- /dev/null
+++ b/cil/src/ext/dataslicing.ml
@@ -0,0 +1,462 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2004,
+ * Jeremy Condit <jcondit@cs.berkeley.edu>
+ * George C. Necula <necula@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+open Cil
+open Pretty
+module E = Errormsg
+
+let debug = false
+
+let numRegions : int = 2
+
+let newGlobals : global list ref = ref []
+
+let curFundec : fundec ref = ref dummyFunDec
+let curLocation : location ref = ref locUnknown
+
+let applyOption (fn : 'a -> 'b) (ao : 'a option) : 'b option =
+ match ao with
+ | Some a -> Some (fn a)
+ | None -> None
+
+let getRegion (attrs : attributes) : int =
+ try
+ match List.hd (filterAttributes "region" attrs) with
+ | Attr (_, [AInt i]) -> i
+ | _ -> E.s (bug "bad region attribute")
+ with Failure _ ->
+ 1
+
+let checkRegion (i : int) (attrs : attributes) : bool =
+ (getRegion attrs) = i
+
+let regionField (i : int) : string =
+ "r" ^ (string_of_int i)
+
+let regionStruct (i : int) (name : string) : string =
+ name ^ "_r" ^ (string_of_int i)
+
+let foldRegions (fn : int -> 'a -> 'a) (base : 'a) : 'a =
+ let rec helper (i : int) : 'a =
+ if i <= numRegions then
+ fn i (helper (i + 1))
+ else
+ base
+ in
+ helper 1
+
+let rec getTypeName (t : typ) : string =
+ match t with
+ | TVoid _ -> "void"
+ | TInt _ -> "int"
+ | TFloat _ -> "float"
+ | TComp (cinfo, _) -> "comp_" ^ cinfo.cname
+ | TNamed (tinfo, _) -> "td_" ^ tinfo.tname
+ | TPtr (bt, _) -> "ptr_" ^ (getTypeName bt)
+ | TArray (bt, _, _) -> "array_" ^ (getTypeName bt)
+ | TFun _ -> "fn"
+ | _ -> E.s (unimp "typename")
+
+let isAllocFunction (fn : exp) : bool =
+ match fn with
+ | Lval (Var vinfo, NoOffset) when vinfo.vname = "malloc" -> true
+ | _ -> false
+
+let isExternalFunction (fn : exp) : bool =
+ match fn with
+ | Lval (Var vinfo, NoOffset) when vinfo.vstorage = Extern -> true
+ | _ -> false
+
+let types : (int * typsig, typ) Hashtbl.t = Hashtbl.create 113
+let typeInfos : (int * string, typeinfo) Hashtbl.t = Hashtbl.create 113
+let compInfos : (int * int, compinfo) Hashtbl.t = Hashtbl.create 113
+let varTypes : (typsig, typ) Hashtbl.t = Hashtbl.create 113
+let varCompInfos : (typsig, compinfo) Hashtbl.t = Hashtbl.create 113
+
+let rec sliceCompInfo (i : int) (cinfo : compinfo) : compinfo =
+ try
+ Hashtbl.find compInfos (i, cinfo.ckey)
+ with Not_found ->
+ mkCompInfo cinfo.cstruct (regionStruct i cinfo.cname)
+ (fun cinfo' ->
+ Hashtbl.add compInfos (i, cinfo.ckey) cinfo';
+ List.fold_right
+ (fun finfo rest ->
+ let t = sliceType i finfo.ftype in
+ if not (isVoidType t) then
+ (finfo.fname, t, finfo.fbitfield,
+ finfo.fattr, finfo.floc) :: rest
+ else
+ rest)
+ cinfo.cfields [])
+ cinfo.cattr
+
+and sliceTypeInfo (i : int) (tinfo : typeinfo) : typeinfo =
+ try
+ Hashtbl.find typeInfos (i, tinfo.tname)
+ with Not_found ->
+ let result =
+ { tinfo with tname = regionStruct i tinfo.tname;
+ ttype = sliceType i tinfo.ttype; }
+ in
+ Hashtbl.add typeInfos (i, tinfo.tname) result;
+ result
+
+and sliceType (i : int) (t : typ) : typ =
+ let ts = typeSig t in
+ try
+ Hashtbl.find types (i, ts)
+ with Not_found ->
+ let result =
+ match t with
+ | TVoid _ -> t
+ | TInt (_, attrs) -> if checkRegion i attrs then t else TVoid []
+ | TFloat (_, attrs) -> if checkRegion i attrs then t else TVoid []
+ | TComp (cinfo, attrs) -> TComp (sliceCompInfo i cinfo, attrs)
+ | TNamed (tinfo, attrs) -> TNamed (sliceTypeInfo i tinfo, attrs)
+ | TPtr (TVoid _, _) -> t (* Avoid discarding void*. *)
+ | TPtr (bt, attrs) ->
+ let bt' = sliceType i bt in
+ if not (isVoidType bt') then TPtr (bt', attrs) else TVoid []
+ | TArray (bt, eo, attrs) ->
+ TArray (sliceType i bt, applyOption (sliceExp 1) eo, attrs)
+ | TFun (ret, args, va, attrs) ->
+ if checkRegion i attrs then
+ TFun (sliceTypeAll ret,
+ applyOption
+ (List.map (fun (aname, atype, aattrs) ->
+ (aname, sliceTypeAll atype, aattrs)))
+ args,
+ va, attrs)
+ else
+ TVoid []
+ | TBuiltin_va_list _ -> t
+ | _ -> E.s (unimp "type %a" d_type t)
+ in
+ Hashtbl.add types (i, ts) result;
+ result
+
+and sliceTypeAll (t : typ) : typ =
+ begin
+ match t with
+ | TComp (cinfo, _) when hasAttribute "var_type_sliced" cinfo.cattr ->
+ E.s (bug "tried to slice twice")
+ | _ -> ()
+ end;
+ let ts = typeSig t in
+ try
+ Hashtbl.find varTypes ts
+ with Not_found ->
+ let cinfo =
+ let name = ("var_" ^ (getTypeName t)) in
+ if debug then ignore (E.log "creating %s\n" name);
+ try
+ Hashtbl.find varCompInfos ts
+ with Not_found ->
+ mkCompInfo true name
+ (fun cinfo ->
+ Hashtbl.add varCompInfos ts cinfo;
+ foldRegions
+ (fun i rest ->
+ let t' = sliceType i t in
+ if not (isVoidType t') then
+ (regionField i, t', None, [], !curLocation) :: rest
+ else
+ rest)
+ [])
+ [Attr ("var_type_sliced", [])]
+ in
+ let t' =
+ if List.length cinfo.cfields > 1 then
+ begin
+ newGlobals := GCompTag (cinfo, !curLocation) :: !newGlobals;
+ TComp (cinfo, [])
+ end
+ else
+ t
+ in
+ Hashtbl.add varTypes ts t';
+ t'
+
+and sliceLval (i : int) (lv : lval) : lval =
+ if debug then ignore (E.log "lval %a\n" d_lval lv);
+ let lh, offset = lv in
+ match lh with
+ | Var vinfo ->
+ let t = sliceTypeAll vinfo.vtype in
+ let offset' =
+ match t with
+ | TComp (cinfo, _) when hasAttribute "var_type_sliced" cinfo.cattr ->
+ Field (getCompField cinfo (regionField i), offset)
+ | _ -> offset
+ in
+ Var vinfo, offset'
+ | Mem e ->
+ Mem (sliceExp i e), offset
+
+and sliceExp (i : int) (e : exp) : exp =
+ if debug then ignore (E.log "exp %a\n" d_exp e);
+ match e with
+ | Const c -> Const c
+ | Lval lv -> Lval (sliceLval i lv)
+ | UnOp (op, e1, t) -> UnOp (op, sliceExp i e1, sliceType i t)
+ | BinOp (op, e1, e2, t) -> BinOp (op, sliceExp i e1, sliceExp i e2,
+ sliceType i t)
+ | CastE (t, e) -> sliceCast i t e
+ | AddrOf lv -> AddrOf (sliceLval i lv)
+ | StartOf lv -> StartOf (sliceLval i lv)
+ | SizeOf t -> SizeOf (sliceTypeAll t)
+ | _ -> E.s (unimp "exp %a" d_exp e)
+
+and sliceCast (i : int) (t : typ) (e : exp) : exp =
+ let te = typeOf e in
+ match t, te with
+ | TInt (k1, _), TInt (k2, attrs2) when k1 = k2 ->
+ (* Note: We strip off integer cast operations. *)
+ sliceExp (getRegion attrs2) e
+ | TInt (k1, _), TPtr _ ->
+ (* Note: We strip off integer cast operations. *)
+ sliceExp i e
+ | TPtr _, _ when isZero e ->
+ CastE (sliceType i t, sliceExp i e)
+ | TPtr (bt1, _), TPtr (bt2, _) when (typeSig bt1) = (typeSig bt2) ->
+ CastE (sliceType i t, sliceExp i e)
+ | _ ->
+ E.s (unimp "sketchy cast (%a) -> (%a)\n" d_type te d_type t)
+
+and sliceExpAll (e : exp) (l : location) : instr list * exp =
+ let t = typeOf e in
+ let t' = sliceTypeAll t in
+ match t' with
+ | TComp (cinfo, _) when hasAttribute "var_type_sliced" cinfo.cattr ->
+ let vinfo = makeTempVar !curFundec t in
+ let instrs =
+ foldRegions
+ (fun i rest ->
+ try
+ let finfo = getCompField cinfo (regionField i) in
+ if not (isVoidType finfo.ftype) then
+ Set ((Var vinfo, Field (finfo, NoOffset)),
+ sliceExp i e, l) :: rest
+ else
+ rest
+ with Not_found ->
+ rest)
+ []
+ in
+ instrs, Lval (var vinfo)
+ | _ -> [], sliceExp 1 e
+
+let sliceVar (vinfo : varinfo) : unit =
+ if hasAttribute "var_sliced" vinfo.vattr then
+ E.s (bug "tried to slice a var twice");
+ let t = sliceTypeAll vinfo.vtype in
+ if debug then ignore (E.log "setting %s type to %a\n" vinfo.vname d_type t);
+ vinfo.vattr <- addAttribute (Attr ("var_sliced", [])) vinfo.vattr;
+ vinfo.vtype <- t
+
+let sliceInstr (inst : instr) : instr list =
+ match inst with
+ | Set (lv, e, loc) ->
+ if debug then ignore (E.log "set %a %a\n" d_lval lv d_exp e);
+ let t = typeOfLval lv in
+ foldRegions
+ (fun i rest ->
+ if not (isVoidType (sliceType i t)) then
+ Set (sliceLval i lv, sliceExp i e, loc) :: rest
+ else
+ rest)
+ []
+ | Call (ret, fn, args, l) when isAllocFunction fn ->
+ let lv =
+ match ret with
+ | Some lv -> lv
+ | None -> E.s (bug "malloc call has no return lval")
+ in
+ let t = typeOfLval lv in
+ foldRegions
+ (fun i rest ->
+ if not (isVoidType (sliceType i t)) then
+ Call (Some (sliceLval i lv), sliceExp 1 fn,
+ List.map (sliceExp i) args, l) :: rest
+ else
+ rest)
+ []
+ | Call (ret, fn, args, l) when isExternalFunction fn ->
+ [Call (applyOption (sliceLval 1) ret, sliceExp 1 fn,
+ List.map (sliceExp 1) args, l)]
+ | Call (ret, fn, args, l) ->
+ let ret', set =
+ match ret with
+ | Some lv ->
+ let vinfo = makeTempVar !curFundec (typeOfLval lv) in
+ Some (var vinfo), [Set (lv, Lval (var vinfo), l)]
+ | None ->
+ None, []
+ in
+ let instrs, args' =
+ List.fold_right
+ (fun arg (restInstrs, restArgs) ->
+ let instrs, arg' = sliceExpAll arg l in
+ instrs @ restInstrs, (arg' :: restArgs))
+ args ([], [])
+ in
+ instrs @ (Call (ret', sliceExp 1 fn, args', l) :: set)
+ | _ -> E.s (unimp "inst %a" d_instr inst)
+
+let sliceReturnExp (eo : exp option) (l : location) : stmtkind =
+ match eo with
+ | Some e ->
+ begin
+ match sliceExpAll e l with
+ | [], e' -> Return (Some e', l)
+ | instrs, e' -> Block (mkBlock [mkStmt (Instr instrs);
+ mkStmt (Return (Some e', l))])
+ end
+ | None -> Return (None, l)
+
+let rec sliceStmtKind (sk : stmtkind) : stmtkind =
+ match sk with
+ | Instr instrs -> Instr (List.flatten (List.map sliceInstr instrs))
+ | Block b -> Block (sliceBlock b)
+ | If (e, b1, b2, l) -> If (sliceExp 1 e, sliceBlock b1, sliceBlock b2, l)
+ | Break l -> Break l
+ | Continue l -> Continue l
+ | Return (eo, l) -> sliceReturnExp eo l
+ | Switch (e, b, sl, l) -> Switch (sliceExp 1 e, sliceBlock b,
+ List.map sliceStmt sl, l)
+(*
+ | Loop (b, l, so1, so2) -> Loop (sliceBlock b, l,
+ applyOption sliceStmt so1,
+ applyOption sliceStmt so2)
+*)
+ | While (e, b, l) -> While (sliceExp 1 e, sliceBlock b, l)
+ | DoWhile (e, b, l) -> DoWhile (sliceExp 1 e, sliceBlock b, l)
+ | For (bInit, e, bIter, b, l) ->
+ For (sliceBlock bInit, sliceExp 1e, sliceBlock bIter, sliceBlock b, l)
+ | Goto _ -> sk
+ | _ -> E.s (unimp "statement")
+
+and sliceStmt (s : stmt) : stmt =
+ (* Note: We update statements destructively so that goto/switch work. *)
+ s.skind <- sliceStmtKind s.skind;
+ s
+
+and sliceBlock (b : block) : block =
+ ignore (List.map sliceStmt b.bstmts);
+ b
+
+let sliceFundec (fd : fundec) (l : location) : unit =
+ curFundec := fd;
+ curLocation := l;
+ ignore (sliceBlock fd.sbody);
+ curFundec := dummyFunDec;
+ curLocation := locUnknown
+
+let sliceGlobal (g : global) : unit =
+ match g with
+ | GType (tinfo, l) ->
+ newGlobals :=
+ foldRegions (fun i rest -> GType (sliceTypeInfo i tinfo, l) :: rest)
+ !newGlobals
+ | GCompTag (cinfo, l) ->
+ newGlobals :=
+ foldRegions (fun i rest -> GCompTag (sliceCompInfo i cinfo, l) :: rest)
+ !newGlobals
+ | GCompTagDecl (cinfo, l) ->
+ newGlobals :=
+ foldRegions (fun i rest -> GCompTagDecl (sliceCompInfo i cinfo, l) ::
+ rest)
+ !newGlobals
+ | GFun (fd, l) ->
+ sliceFundec fd l;
+ newGlobals := GFun (fd, l) :: !newGlobals
+ | GVarDecl _
+ | GVar _ ->
+ (* Defer processing of vars until end. *)
+ newGlobals := g :: !newGlobals
+ | _ ->
+ E.s (unimp "global %a\n" d_global g)
+
+let sliceGlobalVars (g : global) : unit =
+ match g with
+ | GFun (fd, l) ->
+ curFundec := fd;
+ curLocation := l;
+ List.iter sliceVar fd.slocals;
+ List.iter sliceVar fd.sformals;
+ setFunctionType fd (sliceType 1 fd.svar.vtype);
+ curFundec := dummyFunDec;
+ curLocation := locUnknown;
+ | GVar (vinfo, _, l) ->
+ curLocation := l;
+ sliceVar vinfo;
+ curLocation := locUnknown
+ | _ -> ()
+
+class dropAttrsVisitor = object
+ inherit nopCilVisitor
+
+ method vvrbl (vinfo : varinfo) =
+ vinfo.vattr <- dropAttribute "var_sliced" vinfo.vattr;
+ DoChildren
+
+ method vglob (g : global) =
+ begin
+ match g with
+ | GCompTag (cinfo, _) ->
+ cinfo.cattr <- dropAttribute "var_type_sliced" cinfo.cattr;
+ | _ -> ()
+ end;
+ DoChildren
+end
+
+let sliceFile (f : file) : unit =
+ newGlobals := [];
+ List.iter sliceGlobal f.globals;
+ List.iter sliceGlobalVars f.globals;
+ f.globals <- List.rev !newGlobals;
+ visitCilFile (new dropAttrsVisitor) f
+
+let feature : featureDescr =
+ { fd_name = "DataSlicing";
+ fd_enabled = ref false;
+ fd_description = "data slicing";
+ fd_extraopt = [];
+ fd_doit = sliceFile;
+ fd_post_check = true;
+ }
diff --git a/cil/src/ext/dataslicing.mli b/cil/src/ext/dataslicing.mli
new file mode 100644
index 0000000..0060648
--- /dev/null
+++ b/cil/src/ext/dataslicing.mli
@@ -0,0 +1,41 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * Jeremy Condit <jcondit@cs.berkeley.edu>
+ * George C. Necula <necula@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* This feature implements data slicing. The user annotates base types
+ * and function types with region(i) annotations, and this transformation
+ * will separate the fields into parallel data structures accordingly. *)
+
+val feature: Cil.featureDescr
diff --git a/cil/src/ext/deadcodeelim.ml b/cil/src/ext/deadcodeelim.ml
new file mode 100644
index 0000000..e560e01
--- /dev/null
+++ b/cil/src/ext/deadcodeelim.ml
@@ -0,0 +1,173 @@
+(* Eliminate assignment instructions whose results are not
+ used *)
+
+open Cil
+open Pretty
+
+module E = Errormsg
+module RD = Reachingdefs
+module UD = Usedef
+module IH = Inthash
+module S = Stats
+
+module IS = Set.Make(
+ struct
+ type t = int
+ let compare = compare
+ end)
+
+let debug = RD.debug
+
+
+let usedDefsSet = ref IS.empty
+(* put used def ids into usedDefsSet *)
+(* assumes reaching definitions have already been computed *)
+class usedDefsCollectorClass = object(self)
+ inherit RD.rdVisitorClass
+
+ method add_defids iosh e u =
+ UD.VS.iter (fun vi ->
+ if IH.mem iosh vi.vid then
+ let ios = IH.find iosh vi.vid in
+ if !debug then ignore(E.log "DCE: IOS size for vname=%s at stmt=%d: %d\n"
+ vi.vname sid (RD.IOS.cardinal ios));
+ RD.IOS.iter (function
+ Some(i) ->
+ if !debug then ignore(E.log "DCE: def %d used: %a\n" i d_plainexp e);
+ usedDefsSet := IS.add i (!usedDefsSet)
+ | None -> ()) ios
+ else if !debug then ignore(E.log "DCE: vid %d:%s not in stm:%d iosh at %a\n"
+ vi.vid vi.vname sid d_plainexp e)) u
+
+ method vexpr e =
+ let u = UD.computeUseExp e in
+ match self#get_cur_iosh() with
+ Some(iosh) -> self#add_defids iosh e u; DoChildren
+ | None ->
+ if !debug then ignore(E.log "DCE: use but no rd data: %a\n" d_plainexp e);
+ DoChildren
+
+ method vinst i =
+ let handle_inst iosh i = match i with
+ | Asm(_,_,slvl,_,_,_) -> List.iter (fun (s,lv) ->
+ match lv with (Var v, off) ->
+ if s.[0] = '+' then
+ self#add_defids iosh (Lval(Var v, off)) (UD.VS.singleton v)
+ | _ -> ()) slvl
+ | _ -> ()
+ in
+ begin try
+ cur_rd_dat <- Some(List.hd rd_dat_lst);
+ rd_dat_lst <- List.tl rd_dat_lst
+ with Failure "hd" -> ()
+ end;
+ match self#get_cur_iosh() with
+ Some iosh -> handle_inst iosh i; DoChildren
+ | None -> DoChildren
+
+end
+
+(***************************************************
+ * Also need to find reads from volatiles
+ * uses two functions I've put in ciltools which
+ * are basically what Zach wrote, except one is for
+ * types and one is for vars. Another difference is
+ * they filter out pointers to volatiles. This
+ * handles DMA
+ ***************************************************)
+class hasVolatile flag = object (self)
+ inherit nopCilVisitor
+ method vlval l =
+ let tp = typeOfLval l in
+ if (Ciltools.is_volatile_tp tp) then flag := true;
+ DoChildren
+ method vexpr e =
+ DoChildren
+end
+
+let exp_has_volatile e =
+ let flag = ref false in
+ ignore (visitCilExpr (new hasVolatile flag) e);
+ !flag
+ (***************************************************)
+
+let removedCount = ref 0
+(* Filter out instructions whose definition ids are not
+ in usedDefsSet *)
+class uselessInstrElim : cilVisitor = object(self)
+ inherit nopCilVisitor
+
+ method vstmt stm =
+
+ let test (i,(_,s,iosh)) =
+ match i with
+ Call _ -> true
+ | Set((Var vi,NoOffset),e,_) ->
+ if vi.vglob || (Ciltools.is_volatile_vi vi) || (exp_has_volatile e) then true else
+ let _, defd = UD.computeUseDefInstr i in
+ let rec loop n =
+ if n < 0 then false else
+ if IS.mem (n+s) (!usedDefsSet)
+ then true
+ else loop (n-1)
+ in
+ if loop (UD.VS.cardinal defd - 1)
+ then true
+ else (incr removedCount; false)
+ | _ -> true
+ in
+
+ let filter il stmdat =
+ let rd_dat_lst = RD.instrRDs il stm.sid stmdat false in
+ let ildatlst = List.combine il rd_dat_lst in
+ let ildatlst' = List.filter test ildatlst in
+ let (newil,_) = List.split ildatlst' in
+ newil
+ in
+
+ match RD.getRDs stm.sid with
+ None -> DoChildren
+ | Some(_,s,iosh) ->
+ match stm.skind with
+ Instr il ->
+ stm.skind <- Instr(filter il ((),s,iosh));
+ SkipChildren
+ | _ -> DoChildren
+
+end
+
+(* until fixed point is reached *)
+let elim_dead_code_fp (fd : fundec) : fundec =
+ (* fundec -> fundec *)
+ let rec loop fd =
+ usedDefsSet := IS.empty;
+ removedCount := 0;
+ S.time "reaching definitions" RD.computeRDs fd;
+ ignore(visitCilFunction (new usedDefsCollectorClass :> cilVisitor) fd);
+ let fd' = visitCilFunction (new uselessInstrElim) fd in
+ if !removedCount = 0 then fd' else loop fd'
+ in
+ loop fd
+
+(* just once *)
+let elim_dead_code (fd : fundec) : fundec =
+ (* fundec -> fundec *)
+ usedDefsSet := IS.empty;
+ removedCount := 0;
+ S.time "reaching definitions" RD.computeRDs fd;
+ ignore(visitCilFunction (new usedDefsCollectorClass :> cilVisitor) fd);
+ let fd' = visitCilFunction (new uselessInstrElim) fd in
+ fd'
+
+class deadCodeElimClass : cilVisitor = object(self)
+ inherit nopCilVisitor
+
+ method vfunc fd =
+ let fd' = elim_dead_code fd in
+ ChangeTo(fd')
+
+end
+
+let dce f =
+ if !debug then ignore(E.log "DCE: starting dead code elimination\n");
+ visitCilFile (new deadCodeElimClass) f
diff --git a/cil/src/ext/dominators.ml b/cil/src/ext/dominators.ml
new file mode 100755
index 0000000..d838d23
--- /dev/null
+++ b/cil/src/ext/dominators.ml
@@ -0,0 +1,241 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** Compute dominator information for the statements in a function *)
+open Cil
+open Pretty
+module E = Errormsg
+module H = Hashtbl
+module U = Util
+module IH = Inthash
+
+module DF = Dataflow
+
+let debug = false
+
+(* For each statement we maintain a set of statements that dominate it *)
+module BS = Set.Make(struct
+ type t = Cil.stmt
+ let compare v1 v2 = Pervasives.compare v1.sid v2.sid
+ end)
+
+
+
+
+(** Customization module for dominators *)
+module DT = struct
+ let name = "dom"
+
+ let debug = ref debug
+
+ type t = BS.t
+
+ (** For each statement in a function we keep the set of dominator blocks.
+ * Indexed by statement id *)
+ let stmtStartData: t IH.t = IH.create 17
+
+ let copy (d: t) = d
+
+ let pretty () (d: t) =
+ dprintf "{%a}"
+ (docList (fun s -> dprintf "%d" s.sid))
+ (BS.elements d)
+
+ let computeFirstPredecessor (s: stmt) (d: BS.t) : BS.t =
+ (* Make sure we add this block to the set *)
+ BS.add s d
+
+ let combinePredecessors (s: stmt) ~(old: BS.t) (d: BS.t) : BS.t option =
+ (* First, add this block to the data from the predecessor *)
+ let d' = BS.add s d in
+ if BS.subset old d' then
+ None
+ else
+ Some (BS.inter old d')
+
+ let doInstr (i: instr) (d: t) = DF.Default
+
+ let doStmt (s: stmt) (d: t) = DF.SDefault
+
+ let doGuard condition _ = DF.GDefault
+
+
+ let filterStmt _ = true
+end
+
+
+
+module Dom = DF.ForwardsDataFlow(DT)
+
+let getStmtDominators (data: BS.t IH.t) (s: stmt) : BS.t =
+ try IH.find data s.sid
+ with Not_found -> BS.empty (* Not reachable *)
+
+
+let getIdom (idomInfo: stmt option IH.t) (s: stmt) =
+ try IH.find idomInfo s.sid
+ with Not_found ->
+ E.s (E.bug "Immediate dominator information not set for statement %d"
+ s.sid)
+
+(** Check whether one block dominates another. This assumes that the "idom"
+ * field has been computed. *)
+let rec dominates (idomInfo: stmt option IH.t) (s1: stmt) (s2: stmt) =
+ s1 == s2 ||
+ (let s2idom = getIdom idomInfo s2 in
+ match s2idom with
+ None -> false
+ | Some s2idom -> dominates idomInfo s1 s2idom)
+
+
+
+
+let computeIDom (f: fundec) : stmt option IH.t =
+ (* We must prepare the CFG info first *)
+ prepareCFG f;
+ computeCFGInfo f false;
+
+ IH.clear DT.stmtStartData;
+ let idomData: stmt option IH.t = IH.create 13 in
+
+ let _ =
+ match f.sbody.bstmts with
+ [] -> () (* function has no body *)
+ | start :: _ -> begin
+ (* We start with only the start block *)
+ IH.add DT.stmtStartData start.sid (BS.singleton start);
+
+ Dom.compute [start];
+
+ (* Dump the dominators information *)
+ if debug then
+ List.iter
+ (fun s ->
+ let sdoms = getStmtDominators DT.stmtStartData s in
+ if not (BS.mem s sdoms) then begin
+ (* It can be that the block is not reachable *)
+ if s.preds <> [] then
+ E.s (E.bug "Statement %d is not in its list of dominators"
+ s.sid);
+ end;
+ ignore (E.log "Dominators for %d: %a\n" s.sid
+ DT.pretty (BS.remove s sdoms)))
+ f.sallstmts;
+
+ (* Now fill the immediate dominators for all nodes *)
+ let rec fillOneIdom (s: stmt) =
+ try
+ ignore (IH.find idomData s.sid)
+ (* Already set *)
+ with Not_found -> begin
+ (* Get the dominators *)
+ let sdoms = getStmtDominators DT.stmtStartData s in
+ (* Fill the idom for the dominators first *)
+ let idom =
+ BS.fold
+ (fun d (sofar: stmt option) ->
+ if d.sid = s.sid then
+ sofar (* Ignore the block itself *)
+ else begin
+ (* fill the idom information recursively *)
+ fillOneIdom d;
+ match sofar with
+ None -> Some d
+ | Some sofar' ->
+ (* See if d is dominated by sofar. We know that the
+ * idom information has been computed for both sofar
+ * and for d*)
+ if dominates idomData sofar' d then
+ Some d
+ else
+ sofar
+ end)
+ sdoms
+ None
+ in
+ IH.replace idomData s.sid idom
+ end
+ in
+ (* Scan all blocks and compute the idom *)
+ List.iter fillOneIdom f.sallstmts
+ end
+ in
+ idomData
+
+
+
+(** Compute the start of the natural loops. For each start, keep a list of
+ * origin of a back edge. The loop consists of the loop start and all
+ * predecessors of the origins of back edges, up to and including the loop
+ * start *)
+let findNaturalLoops (f: fundec)
+ (idomData: stmt option IH.t) : (stmt * stmt list) list =
+ let loops =
+ List.fold_left
+ (fun acc b ->
+ (* Iterate over all successors, and see if they are among the
+ * dominators for this block *)
+ List.fold_left
+ (fun acc s ->
+ if dominates idomData s b then
+ (* s is the start of a natural loop *)
+ let rec addNaturalLoop = function
+ [] -> [(s, [b])]
+ | (s', backs) :: rest when s'.sid = s.sid ->
+ (s', b :: backs) :: rest
+ | l :: rest -> l :: addNaturalLoop rest
+ in
+ addNaturalLoop acc
+ else
+ acc)
+ acc
+ b.succs)
+ []
+ f.sallstmts
+ in
+
+ if debug then
+ ignore (E.log "Natural loops:\n%a\n"
+ (docList ~sep:line
+ (fun (s, backs) ->
+ dprintf " Start: %d, backs:%a"
+ s.sid
+ (docList (fun b -> num b.sid))
+ backs))
+ loops);
+
+ loops
diff --git a/cil/src/ext/dominators.mli b/cil/src/ext/dominators.mli
new file mode 100755
index 0000000..0abf82e
--- /dev/null
+++ b/cil/src/ext/dominators.mli
@@ -0,0 +1,29 @@
+
+
+(** Compute dominators using data flow analysis *)
+(** Author: George Necula
+ 5/28/2004
+ **)
+
+(** Invoke on a code after filling in the CFG info and it computes the
+ * immediate dominator information. We map each statement to its immediate
+ * dominator (None for the start statement, and for the unreachable
+ * statements). *)
+val computeIDom: Cil.fundec -> Cil.stmt option Inthash.t
+
+
+(** This is like Inthash.find but gives an error if the information is
+ * Not_found *)
+val getIdom: Cil.stmt option Inthash.t -> Cil.stmt -> Cil.stmt option
+
+(** Check whether one statement dominates another. *)
+val dominates: Cil.stmt option Inthash.t -> Cil.stmt -> Cil.stmt -> bool
+
+
+(** Compute the start of the natural loops. This assumes that the "idom"
+ * field has been computed. For each start, keep a list of origin of a back
+ * edge. The loop consists of the loop start and all predecessors of the
+ * origins of back edges, up to and including the loop start *)
+val findNaturalLoops: Cil.fundec ->
+ Cil.stmt option Inthash.t ->
+ (Cil.stmt * Cil.stmt list) list
diff --git a/cil/src/ext/epicenter.ml b/cil/src/ext/epicenter.ml
new file mode 100644
index 0000000..a8045e8
--- /dev/null
+++ b/cil/src/ext/epicenter.ml
@@ -0,0 +1,114 @@
+(* epicenter.ml *)
+(* code for epicenter.mli *)
+
+(* module maintainer: scott *)
+(* see copyright at end of this file *)
+
+open Callgraph
+open Cil
+open Trace
+open Pretty
+module H = Hashtbl
+module IH = Inthash
+
+let sliceFile (f:file) (epicenter:string) (maxHops:int) : unit =
+ (* compute the static call graph *)
+ let graph:callgraph = (computeGraph f) in
+
+ (* will accumulate here the set of names of functions already seen *)
+ let seen: (string, unit) H.t = (H.create 117) in
+
+ (* when removing "unused" symbols, keep all seen functions *)
+ let isRoot : global -> bool = function
+ | GFun ({svar = {vname = vname}}, _) ->
+ H.mem seen vname
+ | _ ->
+ false
+ in
+
+ (* recursive depth-first search through the call graph, finding
+ * all nodes within 'hops' hops of 'node' and marking them to
+ * to be retained *)
+ let rec dfs (node:callnode) (hops:int) : unit =
+ (* only recurse if we haven't already marked this node *)
+ if not (H.mem seen (nodeName node.cnInfo)) then
+ begin
+ (* add this node *)
+ H.add seen (nodeName node.cnInfo) ();
+ trace "epicenter" (dprintf "will keep %s\n" (nodeName node.cnInfo));
+
+ (* if we cannot do any more hops, stop *)
+ if (hops > 0) then
+
+ (* recurse on all the node's callers and callees *)
+ let recurse _ (adjacent:callnode) : unit =
+ (dfs adjacent (hops - 1))
+ in
+ IH.iter recurse node.cnCallees;
+ IH.iter recurse node.cnCallers
+ end
+ in
+ dfs (Hashtbl.find graph epicenter) maxHops;
+
+ (* finally, throw away anything we haven't decided to keep *)
+ Cilutil.sliceGlobal := true;
+ Rmtmps.removeUnusedTemps ~isRoot:isRoot f
+
+let doEpicenter = ref false
+let epicenterName = ref ""
+let epicenterHops = ref 0
+
+let feature : featureDescr =
+ { fd_name = "epicenter";
+ fd_enabled = doEpicenter;
+ fd_description = "remove all functions except those within some number " ^
+ "of hops (in the call graph) from a given function";
+ fd_extraopt =
+ [
+ ("--epicenter-name",
+ Arg.String (fun s -> epicenterName := s),
+ "<name>: do an epicenter slice starting from function <name>");
+ ("--epicenter-hops", Arg.Int (fun n -> epicenterHops := n),
+ "<n>: specify max # of hops for epicenter slice");
+ ];
+
+ fd_doit =
+ (fun f ->
+ sliceFile f !epicenterName !epicenterHops);
+
+ fd_post_check = true;
+ }
+
+
+(*
+ *
+ * Copyright (c) 2001-2002 by
+ * George C. Necula necula@cs.berkeley.edu
+ * Scott McPeak smcpeak@cs.berkeley.edu
+ * Wes Weimer weimer@cs.berkeley.edu
+ * Ben Liblit liblit@cs.berkeley.edu
+ *
+ * All rights reserved. Permission to use, copy, modify and distribute
+ * this software for research purposes only is hereby granted,
+ * provided that the following conditions are met:
+ * 1. XSRedistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the authors may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * DISCLAIMER:
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+ * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
diff --git a/cil/src/ext/heap.ml b/cil/src/ext/heap.ml
new file mode 100644
index 0000000..10f48a0
--- /dev/null
+++ b/cil/src/ext/heap.ml
@@ -0,0 +1,112 @@
+(* See copyright notice at the end of the file *)
+
+(* The type of a heap (priority queue): keys are integers, data values
+ * are whatever you like *)
+type ('a) t = {
+ elements : (int * ('a option)) array ;
+ mutable size : int ; (* current number of elements *)
+ capacity : int ; (* max number of elements *)
+}
+
+let create size = {
+ elements = Array.create (size+1) (max_int,None) ;
+ size = 0 ;
+ capacity = size ;
+}
+
+let clear heap = heap.size <- 0
+
+let is_full heap = (heap.size = heap.capacity)
+
+let is_empty heap = (heap.size = 0)
+
+let insert heap prio elt = begin
+ if is_full heap then begin
+ raise (Invalid_argument "Heap.insert")
+ end ;
+ heap.size <- heap.size + 1 ;
+ let i = ref heap.size in
+ while ( fst heap.elements.(!i / 2) < prio ) do
+ heap.elements.(!i) <- heap.elements.(!i / 2) ;
+ i := (!i / 2)
+ done ;
+ heap.elements.(!i) <- (prio,Some(elt))
+ end
+
+let examine_max heap =
+ if is_empty heap then begin
+ raise (Invalid_argument "Heap.examine_max")
+ end ;
+ match heap.elements.(1) with
+ p,Some(elt) -> p,elt
+ | p,None -> failwith "Heap.examine_max"
+
+let extract_max heap = begin
+ if is_empty heap then begin
+ raise (Invalid_argument "Heap.extract_max")
+ end ;
+ let max = heap.elements.(1) in
+ let last = heap.elements.(heap.size) in
+ heap.size <- heap.size - 1 ;
+ let i = ref 1 in
+ let break = ref false in
+ while (!i * 2 <= heap.size) && not !break do
+ let child = ref (!i * 2) in
+
+ (* find smaller child *)
+ if (!child <> heap.size &&
+ fst heap.elements.(!child+1) > fst heap.elements.(!child)) then begin
+ incr child
+ end ;
+
+ (* percolate one level *)
+ if (fst last < fst heap.elements.(!child)) then begin
+ heap.elements.(!i) <- heap.elements.(!child) ;
+ i := !child
+ end else begin
+ break := true
+ end
+ done ;
+ heap.elements.(!i) <- last ;
+ match max with
+ p,Some(elt) -> p,elt
+ | p,None -> failwith "Heap.examine_min"
+ end
+
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
diff --git a/cil/src/ext/heapify.ml b/cil/src/ext/heapify.ml
new file mode 100644
index 0000000..a583181
--- /dev/null
+++ b/cil/src/ext/heapify.ml
@@ -0,0 +1,250 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(*
+ * Heapify: a program transform that looks over functions, finds those
+ * that have local (stack) variables that contain arrays, puts all such
+ * local variables into a single heap allocated structure, changes all
+ * accesses to such variables into accesses to fields of that structure
+ * and frees the structure on return.
+ *)
+open Cil
+
+(* utilities that should be in Cil.ml *)
+(* sfg: this function appears to never be called *)
+let mkSimpleField ci fn ft fl =
+ { fcomp = ci ; fname = fn ; ftype = ft ; fbitfield = None ; fattr = [];
+ floc = fl }
+
+
+(* actual Heapify begins *)
+
+let heapifyNonArrays = ref false
+
+(* Does this local var contain an array? *)
+let rec containsArray (t:typ) : bool = (* does this type contain an array? *)
+ match unrollType t with
+ TArray _ -> true
+ | TComp(ci, _) -> (* look at the types of the fields *)
+ List.exists (fun fi -> containsArray fi.ftype) ci.cfields
+ | _ ->
+ (* Ignore other types, including TInt and TPtr. We don't care whether
+ there are arrays in the base types of pointers; only about whether
+ this local variable itself needs to be moved to the heap. *)
+ false
+
+
+class heapifyModifyVisitor big_struct big_struct_fields varlist free
+ (currentFunction: fundec) = object(self)
+ inherit nopCilVisitor (* visit lvalues and statements *)
+ method vlval l = match l with (* should we change this one? *)
+ Var(vi),vi_offset when List.mem_assoc vi varlist -> (* check list *)
+ let i = List.assoc vi varlist in (* find field offset *)
+ let big_struct_field = List.nth big_struct_fields i in
+ let new_lval = Mem(Lval(big_struct, NoOffset)),
+ Field(big_struct_field,vi_offset) in (* rewrite the lvalue *)
+ ChangeDoChildrenPost(new_lval, (fun l -> l))
+ | _ -> DoChildren (* ignore other lvalues *)
+ method vstmt s = match s.skind with (* also rewrite the return *)
+ Return(None,loc) ->
+ let free_instr = Call(None,free,[Lval(big_struct,NoOffset)],loc) in
+ self#queueInstr [free_instr]; (* insert free_instr before the return *)
+ DoChildren
+ | Return(Some exp ,loc) ->
+ (* exp may depend on big_struct, so evaluate it before calling free.
+ * This becomes: tmp = exp; free(big_struct); return tmp; *)
+ let exp_new = visitCilExpr (self :> cilVisitor) exp in
+ let ret_tmp = makeTempVar currentFunction (typeOf exp_new) in
+ let eval_ret_instr = Set(var ret_tmp, exp_new, loc) in
+ let free_instr = Call(None,free,[Lval(big_struct,NoOffset)],loc) in
+ (* insert the instructions before the return *)
+ self#queueInstr [eval_ret_instr; free_instr];
+ s.skind <- (Return(Some(Lval(var ret_tmp)), loc));
+ DoChildren
+ | _ -> DoChildren (* ignore other statements *)
+end
+
+class heapifyAnalyzeVisitor f alloc free = object
+ inherit nopCilVisitor (* only look at function bodies *)
+ method vglob gl = match gl with
+ GFun(fundec,funloc) ->
+ let counter = ref 0 in (* the number of local vars containing arrays *)
+ let varlist = ref [] in (* a list of (var,id) pairs, in reverse order *)
+ List.iter (fun vi ->
+ (* find all local vars with arrays. If the user requests it,
+ we also look for non-array vars whose address is taken. *)
+ if (containsArray vi.vtype) || (vi.vaddrof && !heapifyNonArrays)
+ then begin
+ varlist := (vi,!counter) :: !varlist ; (* add it to the list *)
+ incr counter (* put the next such var in the next slot *)
+ end
+ ) fundec.slocals ;
+ if (!varlist <> []) then begin (* some local vars contain arrays *)
+ let name = (fundec.svar.vname ^ "_heapify") in
+ let ci = mkCompInfo true name (* make a big structure *)
+ (fun _ -> List.rev_map (* reverse the list to fix the order *)
+ (* each local var becomes a field *)
+ (fun (vi,i) -> vi.vname,vi.vtype,None,[],vi.vdecl) !varlist) [] in
+ let vi = makeLocalVar fundec name (TPtr(TComp(ci,[]),[])) in
+ let modify = new heapifyModifyVisitor (Var(vi)) ci.cfields
+ !varlist free fundec in (* rewrite accesses to local vars *)
+ fundec.sbody <- visitCilBlock modify fundec.sbody ;
+ let alloc_stmt = mkStmt (* allocate the big struct on the heap *)
+ (Instr [Call(Some(Var(vi),NoOffset), alloc,
+ [SizeOf(TComp(ci,[]))],funloc)]) in
+ fundec.sbody.bstmts <- alloc_stmt :: fundec.sbody.bstmts ;
+ fundec.slocals <- List.filter (fun vi -> (* remove local vars *)
+ not (List.mem_assoc vi !varlist)) fundec.slocals ;
+ let typedec = (GCompTag(ci,funloc)) in (* declare the big struct *)
+ ChangeTo([typedec ; GFun(fundec,funloc)]) (* done! *)
+ end else
+ DoChildren (* ignore everything else *)
+ | _ -> DoChildren
+end
+
+let heapify (f : file) (alloc : exp) (free : exp) =
+ visitCilFile (new heapifyAnalyzeVisitor f alloc free) f;
+ f
+
+(* heapify code ends here *)
+
+let default_heapify (f : file) =
+ let alloc_fun = emptyFunction "malloc" in
+ let free_fun = emptyFunction "free" in
+ let alloc_exp = (Lval((Var(alloc_fun.svar)),NoOffset)) in
+ let free_exp = (Lval((Var(free_fun.svar)),NoOffset)) in
+ ignore (heapify f alloc_exp free_exp)
+
+(* StackGuard clone *)
+
+class sgModifyVisitor restore_ra_stmt = object
+ inherit nopCilVisitor
+ method vstmt s = match s.skind with (* also rewrite the return *)
+ Return(_,loc) -> let new_block = mkBlock [restore_ra_stmt ; s] in
+ ChangeTo(mkStmt (Block(new_block)))
+ | _ -> DoChildren (* ignore other statements *)
+end
+
+class sgAnalyzeVisitor f push pop get_ra set_ra = object
+ inherit nopCilVisitor
+ method vfunc fundec =
+ let needs_guarding = List.fold_left
+ (fun acc vi -> acc || containsArray vi.vtype)
+ false fundec.slocals in
+ if needs_guarding then begin
+ let ra_tmp = makeLocalVar fundec "return_address" voidPtrType in
+ let ra_exp = Lval(Var(ra_tmp),NoOffset) in
+ let save_ra_stmt = mkStmt (* save the current return address *)
+ (Instr [Call(Some(Var(ra_tmp),NoOffset), get_ra, [], locUnknown) ;
+ Call(None, push, [ra_exp], locUnknown)]) in
+ let restore_ra_stmt = mkStmt (* restore the old return address *)
+ (Instr [Call(Some(Var(ra_tmp),NoOffset), pop, [], locUnknown) ;
+ Call(None, set_ra, [ra_exp], locUnknown)]) in
+ let modify = new sgModifyVisitor restore_ra_stmt in
+ fundec.sbody <- visitCilBlock modify fundec.sbody ;
+ fundec.sbody.bstmts <- save_ra_stmt :: fundec.sbody.bstmts ;
+ ChangeTo(fundec) (* done! *)
+ end else DoChildren
+end
+
+let stackguard (f : file) (push : exp) (pop : exp)
+ (get_ra : exp) (set_ra : exp) =
+ visitCilFileSameGlobals (new sgAnalyzeVisitor f push pop get_ra set_ra) f;
+ f
+ (* stackguard code ends *)
+
+let default_stackguard (f : file) =
+ let expify fundec = Lval(Var(fundec.svar),NoOffset) in
+ let push = expify (emptyFunction "stackguard_push") in
+ let pop = expify (emptyFunction "stackguard_pop") in
+ let get_ra = expify (emptyFunction "stackguard_get_ra") in
+ let set_ra = expify (emptyFunction "stackguard_set_ra") in
+ let global_decl =
+"extern void * stackguard_get_ra();
+extern void stackguard_set_ra(void *new_ra);
+/* You must provide an implementation for functions that get and set the
+ * return address. Such code is unfortunately architecture specific.
+ */
+struct stackguard_stack {
+ void * data;
+ struct stackguard_stack * next;
+} * stackguard_stack;
+
+void stackguard_push(void *ra) {
+ void * old = stackguard_stack;
+ stackguard_stack = (struct stackguard_stack *)
+ malloc(sizeof(stackguard_stack));
+ stackguard_stack->data = ra;
+ stackguard_stack->next = old;
+}
+
+void * stackguard_pop() {
+ void * ret = stackguard_stack->data;
+ void * next = stackguard_stack->next;
+ free(stackguard_stack);
+ stackguard_stack->next = next;
+ return ret;
+}" in
+ f.globals <- GText(global_decl) :: f.globals ;
+ ignore (stackguard f push pop get_ra set_ra )
+
+
+let feature1 : featureDescr =
+ { fd_name = "stackGuard";
+ fd_enabled = Cilutil.doStackGuard;
+ fd_description = "instrument function calls and returns to maintain a separate stack for return addresses" ;
+ fd_extraopt = [];
+ fd_doit = (function (f: file) -> default_stackguard f);
+ fd_post_check = true;
+ }
+let feature2 : featureDescr =
+ { fd_name = "heapify";
+ fd_enabled = Cilutil.doHeapify;
+ fd_description = "move stack-allocated arrays to the heap" ;
+ fd_extraopt = [
+ "--heapifyAll", Arg.Set heapifyNonArrays,
+ "When using heapify, move all local vars whose address is taken, not just arrays.";
+ ];
+ fd_doit = (function (f: file) -> default_heapify f);
+ fd_post_check = true;
+ }
+
+
+
+
+
+
diff --git a/cil/src/ext/liveness.ml b/cil/src/ext/liveness.ml
new file mode 100644
index 0000000..72cd607
--- /dev/null
+++ b/cil/src/ext/liveness.ml
@@ -0,0 +1,190 @@
+
+(* Calculate which variables are live at
+ * each statememnt.
+ *
+ *
+ *
+ *)
+
+open Cil
+open Pretty
+
+module DF = Dataflow
+module UD = Usedef
+module IH = Inthash
+module E = Errormsg
+
+let debug = ref false
+
+let live_label = ref ""
+let live_func = ref ""
+
+module VS = UD.VS
+
+let debug_print () vs = (VS.fold
+ (fun vi d ->
+ d ++ text "name: " ++ text vi.vname
+ ++ text " id: " ++ num vi.vid ++ text " ")
+ vs nil) ++ line
+
+let min_print () vs = (VS.fold
+ (fun vi d ->
+ d ++ text vi.vname
+ ++ text "(" ++ d_type () vi.vtype ++ text ")"
+ ++ text ",")
+ vs nil) ++ line
+
+let printer = ref debug_print
+
+module LiveFlow = struct
+ let name = "Liveness"
+ let debug = debug
+ type t = VS.t
+
+ let pretty () vs =
+ let fn = !printer in
+ fn () vs
+
+ let stmtStartData = IH.create 32
+
+ let combineStmtStartData (stm:stmt) ~(old:t) (now:t) =
+ if not(VS.compare old now = 0)
+ then Some(VS.union old now)
+ else None
+
+ let combineSuccessors = VS.union
+
+ let doStmt stmt =
+ if !debug then ignore(E.log "looking at: %a\n" d_stmt stmt);
+ match stmt.succs with
+ [] -> let u,d = UD.computeUseDefStmtKind stmt.skind in
+ if !debug then ignore(E.log "doStmt: no succs %d\n" stmt.sid);
+ DF.Done u
+ | _ ->
+ let handle_stm vs = match stmt.skind with
+ Instr _ -> vs
+ | s -> let u, d = UD.computeUseDefStmtKind s in
+ VS.union u (VS.diff vs d)
+ in
+ DF.Post handle_stm
+
+ let doInstr i vs =
+ let transform vs' =
+ let u,d = UD.computeUseDefInstr i in
+ VS.union u (VS.diff vs' d)
+ in
+ DF.Post transform
+
+ let filterStmt stm1 stm2 = true
+
+end
+
+module L = DF.BackwardsDataFlow(LiveFlow)
+
+let sink_stmts = ref []
+class sinkFinderClass = object(self)
+ inherit nopCilVisitor
+
+ method vstmt s = match s.succs with
+ [] -> (sink_stmts := s :: (!sink_stmts);
+ DoChildren)
+ | _ -> DoChildren
+
+end
+
+(* gives list of return statements from a function *)
+(* fundec -> stm list *)
+let find_sinks fdec =
+ sink_stmts := [];
+ ignore(visitCilFunction (new sinkFinderClass) fdec);
+ !sink_stmts
+
+(* XXX: This does not compute the best ordering to
+ * give to the work-list algorithm.
+ *)
+let all_stmts = ref []
+class nullAdderClass = object(self)
+ inherit nopCilVisitor
+
+ method vstmt s =
+ all_stmts := s :: (!all_stmts);
+ IH.add LiveFlow.stmtStartData s.sid VS.empty;
+ DoChildren
+
+end
+
+let null_adder fdec =
+ ignore(visitCilFunction (new nullAdderClass) fdec);
+ !all_stmts
+
+let computeLiveness fdec =
+ IH.clear LiveFlow.stmtStartData;
+ UD.onlyNoOffsetsAreDefs := false;
+ all_stmts := [];
+ let a = null_adder fdec in
+ L.compute a
+
+let print_everything () =
+ let d = IH.fold (fun i vs d ->
+ d ++ num i ++ text ": " ++ LiveFlow.pretty () vs)
+ LiveFlow.stmtStartData nil in
+ ignore(printf "%t" (fun () -> d))
+
+let match_label lbl = match lbl with
+ Label(str,_,b) ->
+ if !debug then ignore(E.log "Liveness: label seen: %s\n" str);
+ (*b && *)(String.compare str (!live_label) = 0)
+| _ -> false
+
+class doFeatureClass = object(self)
+ inherit nopCilVisitor
+
+ method vfunc fd =
+ if String.compare fd.svar.vname (!live_func) = 0 then
+ (Cfg.clearCFGinfo fd;
+ ignore(Cfg.cfgFun fd);
+ computeLiveness fd;
+ if String.compare (!live_label) "" = 0 then
+ (printer := min_print;
+ print_everything();
+ SkipChildren)
+ else DoChildren)
+ else SkipChildren
+
+ method vstmt s =
+ if List.exists match_label s.labels then try
+ let vs = IH.find LiveFlow.stmtStartData s.sid in
+ (printer := min_print;
+ ignore(printf "%a" LiveFlow.pretty vs);
+ SkipChildren)
+ with Not_found ->
+ if !debug then ignore(E.log "Liveness: stmt: %d not found\n" s.sid);
+ DoChildren
+ else
+ (if List.length s.labels = 0 then
+ if !debug then ignore(E.log "Liveness: no label at sid=%d\n" s.sid);
+ DoChildren)
+
+end
+
+let do_live_feature (f:file) =
+ visitCilFile (new doFeatureClass) f
+
+let feature =
+ {
+ fd_name = "Liveness";
+ fd_enabled = ref false;
+ fd_description = "Spit out live variables at a label";
+ fd_extraopt = [
+ "--live_label",
+ Arg.String (fun s -> live_label := s),
+ "Output the variables live at this label";
+ "--live_func",
+ Arg.String (fun s -> live_func := s),
+ "Output the variables live at each statement in this function.";
+ "--live_debug",
+ Arg.Unit (fun n -> debug := true),
+ "Print lots of debugging info";];
+ fd_doit = do_live_feature;
+ fd_post_check = false
+ }
diff --git a/cil/src/ext/logcalls.ml b/cil/src/ext/logcalls.ml
new file mode 100644
index 0000000..0cdbc15
--- /dev/null
+++ b/cil/src/ext/logcalls.ml
@@ -0,0 +1,268 @@
+(** See copyright notice at the end of this file *)
+
+(** Add printf before each function call *)
+
+open Pretty
+open Cil
+open Trace
+module E = Errormsg
+module H = Hashtbl
+
+let i = ref 0
+let name = ref ""
+
+(* Switches *)
+let printFunctionName = ref "printf"
+
+let addProto = ref false
+
+let printf: varinfo option ref = ref None
+let makePrintfFunction () : varinfo =
+ match !printf with
+ Some v -> v
+ | None -> begin
+ let v = makeGlobalVar !printFunctionName
+ (TFun(voidType, Some [("format", charPtrType, [])],
+ true, [])) in
+ printf := Some v;
+ addProto := true;
+ v
+ end
+
+let mkPrint (format: string) (args: exp list) : instr =
+ let p: varinfo = makePrintfFunction () in
+ Call(None, Lval(var p), (mkString format) :: args, !currentLoc)
+
+
+let d_string (fmt : ('a,unit,doc,string) format4) : 'a =
+ let f (d: doc) : string =
+ Pretty.sprint 200 d
+ in
+ Pretty.gprintf f fmt
+
+let currentFunc: string ref = ref ""
+
+class logCallsVisitorClass = object
+ inherit nopCilVisitor
+
+ (* Watch for a declaration for our printer *)
+
+ method vinst i = begin
+ match i with
+ | Call(lo,e,al,l) ->
+ let pre = mkPrint (d_string "call %a\n" d_exp e) [] in
+ let post = mkPrint (d_string "return from %a\n" d_exp e) [] in
+(*
+ let str1 = prefix ^
+ (Pretty.sprint 800 ( Pretty.dprintf "Calling %a(%a)\n"
+ d_exp e
+ (docList ~sep:(chr ',' ++ break ) (fun arg ->
+ try
+ match unrollType (typeOf arg) with
+ TInt _ | TEnum _ -> dprintf "%a = %%d" d_exp arg
+ | TFloat _ -> dprintf "%a = %%g" d_exp arg
+ | TVoid _ -> text "void"
+ | TComp _ -> text "comp"
+ | _ -> dprintf "%a = %%p" d_exp arg
+ with _ -> dprintf "%a = %%p" d_exp arg)) al)) in
+ let log_args = List.filter (fun arg ->
+ match unrollType (typeOf arg) with
+ TVoid _ | TComp _ -> false
+ | _ -> true) al in
+ let str2 = prefix ^ (Pretty.sprint 800
+ ( Pretty.dprintf "Returned from %a\n" d_exp e)) in
+ let newinst str args = ((Call (None, Lval(var printfFun.svar),
+ ( [ (* one ; *) mkString str ] @ args),
+ locUnknown)) : instr )in
+ let ilist = ([ (newinst str1 log_args) ; i ; (newinst str2 []) ] : instr list) in
+ *)
+ ChangeTo [ pre; i; post ]
+
+ | _ -> DoChildren
+ end
+ method vstmt (s : stmt) = begin
+ match s.skind with
+ Return _ ->
+ let pre = mkPrint (d_string "exit %s\n" !currentFunc) [] in
+ ChangeTo (mkStmt (Block (mkBlock [ mkStmtOneInstr pre; s ])))
+ | _ -> DoChildren
+
+(*
+(Some(e),l) ->
+ let str = prefix ^ Pretty.sprint 800 ( Pretty.dprintf
+ "Return(%%p) from %s\n" funstr ) in
+ let newinst = ((Call (None, Lval(var printfFun.svar),
+ ( [ (* one ; *) mkString str ; e ]),
+ locUnknown)) : instr )in
+ let new_stmt = mkStmtOneInstr newinst in
+ let slist = [ new_stmt ; s ] in
+ (ChangeTo(mkStmt(Block(mkBlock slist))))
+ | Return(None,l) ->
+ let str = prefix ^ (Pretty.sprint 800 ( Pretty.dprintf
+ "Return void from %s\n" funstr)) in
+ let newinst = ((Call (None, Lval(var printfFun.svar),
+ ( [ (* one ; *) mkString str ]),
+ locUnknown)) : instr )in
+ let new_stmt = mkStmtOneInstr newinst in
+ let slist = [ new_stmt ; s ] in
+ (ChangeTo(mkStmt(Block(mkBlock slist))))
+ | _ -> DoChildren
+*)
+ end
+end
+
+let logCallsVisitor = new logCallsVisitorClass
+
+
+let logCalls (f: file) : unit =
+
+ let doGlobal = function
+ | GVarDecl (v, _) when v.vname = !printFunctionName ->
+ if !printf = None then
+ printf := Some v
+
+ | GFun (fdec, loc) ->
+ currentFunc := fdec.svar.vname;
+ (* do the body *)
+ ignore (visitCilFunction logCallsVisitor fdec);
+ (* Now add the entry instruction *)
+ let pre = mkPrint (d_string "enter %s\n" !currentFunc) [] in
+ fdec.sbody <-
+ mkBlock [ mkStmtOneInstr pre;
+ mkStmt (Block fdec.sbody) ]
+(*
+ (* debugging 'anagram', it's really nice to be able to see the strings *)
+ (* inside fat pointers, even if it's a bit of a hassle and a hack here *)
+ let isFatCharPtr (cinfo:compinfo) =
+ cinfo.cname="wildp_char" ||
+ cinfo.cname="fseqp_char" ||
+ cinfo.cname="seqp_char" in
+
+ (* Collect expressions that denote the actual arguments *)
+ let actargs =
+ (* make lvals out of args which pass test below *)
+ (List.map
+ (fun vi -> match unrollType vi.vtype with
+ | TComp(cinfo, _) when isFatCharPtr(cinfo) ->
+ (* access the _p field for these *)
+ (* luckily it's called "_p" in all three fat pointer variants *)
+ Lval(Var(vi), Field(getCompField cinfo "_p", NoOffset))
+ | _ ->
+ Lval(var vi))
+
+ (* decide which args to pass *)
+ (List.filter
+ (fun vi -> match unrollType vi.vtype with
+ | TPtr(TInt(k, _), _) when isCharType(k) ->
+ !printPtrs || !printStrings
+ | TComp(cinfo, _) when isFatCharPtr(cinfo) ->
+ !printStrings
+ | TVoid _ | TComp _ -> false
+ | TPtr _ | TArray _ | TFun _ -> !printPtrs
+ | _ -> true)
+ fdec.sformals)
+ ) in
+
+ (* make a format string for printing them *)
+ (* sm: expanded width to 200 because I want one per line *)
+ let formatstr = prefix ^ (Pretty.sprint 200
+ (dprintf "entering %s(%a)\n" fdec.svar.vname
+ (docList ~sep:(chr ',' ++ break)
+ (fun vi -> match unrollType vi.vtype with
+ | TInt _ | TEnum _ -> dprintf "%s = %%d" vi.vname
+ | TFloat _ -> dprintf "%s = %%g" vi.vname
+ | TVoid _ -> dprintf "%s = (void)" vi.vname
+ | TComp(cinfo, _) -> (
+ if !printStrings && isFatCharPtr(cinfo) then
+ dprintf "%s = \"%%s\"" vi.vname
+ else
+ dprintf "%s = (comp)" vi.vname
+ )
+ | TPtr(TInt(k, _), _) when isCharType(k) -> (
+ if (!printStrings) then
+ dprintf "%s = \"%%s\"" vi.vname
+ else if (!printPtrs) then
+ dprintf "%s = %%p" vi.vname
+ else
+ dprintf "%s = (str)" vi.vname
+ )
+ | TPtr _ | TArray _ | TFun _ -> (
+ if (!printPtrs) then
+ dprintf "%s = %%p" vi.vname
+ else
+ dprintf "%s = (ptr)" vi.vname
+ )
+ | _ -> dprintf "%s = (?type?)" vi.vname))
+ fdec.sformals)) in
+
+ i := 0 ;
+ name := fdec.svar.vname ;
+ if !allInsts then (
+ let thisVisitor = new verboseLogVisitor printfFun !name prefix in
+ fdec.sbody <- visitCilBlock thisVisitor fdec.sbody
+ );
+ fdec.sbody.bstmts <-
+ mkStmt (Instr [Call (None, Lval(var printfFun.svar),
+ ( (* one :: *) mkString formatstr
+ :: actargs),
+ loc)]) :: fdec.sbody.bstmts
+ *)
+ | _ -> ()
+ in
+ Stats.time "logCalls" (iterGlobals f) doGlobal;
+ if !addProto then begin
+ let p = makePrintfFunction () in
+ E.log "Adding prototype for call logging function %s\n" p.vname;
+ f.globals <- GVarDecl (p, locUnknown) :: f.globals
+ end
+
+let feature : featureDescr =
+ { fd_name = "logcalls";
+ fd_enabled = Cilutil.logCalls;
+ fd_description = "generation of code to log function calls";
+ fd_extraopt = [
+ ("--logcallprintf", Arg.String (fun s -> printFunctionName := s),
+ "the name of the printf function to use");
+ ("--logcalladdproto", Arg.Unit (fun s -> addProto := true),
+ "whether to add the prototype for the printf function")
+ ];
+ fd_doit = logCalls;
+ fd_post_check = true
+ }
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
diff --git a/cil/src/ext/logcalls.mli b/cil/src/ext/logcalls.mli
new file mode 100644
index 0000000..22a1e96
--- /dev/null
+++ b/cil/src/ext/logcalls.mli
@@ -0,0 +1,41 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(* A simple CIL transformer that inserts calls to a runtime function to log
+ * the call in each function *)
+val feature: Cil.featureDescr
diff --git a/cil/src/ext/logwrites.ml b/cil/src/ext/logwrites.ml
new file mode 100644
index 0000000..3afd067
--- /dev/null
+++ b/cil/src/ext/logwrites.ml
@@ -0,0 +1,139 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+open Pretty
+open Cil
+module E = Errormsg
+module H = Hashtbl
+
+(* David Park at Stanford points out that you cannot take the address of a
+ * bitfield in GCC. *)
+
+(* Returns true if the given lvalue offset ends in a bitfield access. *)
+let rec is_bitfield lo = match lo with
+ | NoOffset -> false
+ | Field(fi,NoOffset) -> not (fi.fbitfield = None)
+ | Field(_,lo) -> is_bitfield lo
+ | Index(_,lo) -> is_bitfield lo
+
+(* Return an expression that evaluates to the address of the given lvalue.
+ * For most lvalues, this is merely AddrOf(lv). However, for bitfields
+ * we do some offset gymnastics.
+ *)
+let addr_of_lv (lh,lo) =
+ if is_bitfield lo then begin
+ (* we figure out what the address would be without the final bitfield
+ * access, and then we add in the offset of the bitfield from the
+ * beginning of its enclosing comp *)
+ let rec split_offset_and_bitfield lo = match lo with
+ | NoOffset -> failwith "logwrites: impossible"
+ | Field(fi,NoOffset) -> (NoOffset,fi)
+ | Field(e,lo) -> let a,b = split_offset_and_bitfield lo in
+ ((Field(e,a)),b)
+ | Index(e,lo) -> let a,b = split_offset_and_bitfield lo in
+ ((Index(e,a)),b)
+ in
+ let new_lv_offset, bf = split_offset_and_bitfield lo in
+ let new_lv = (lh, new_lv_offset) in
+ let enclosing_type = TComp(bf.fcomp, []) in
+ let bits_offset, bits_width =
+ bitsOffset enclosing_type (Field(bf,NoOffset)) in
+ let bytes_offset = bits_offset / 8 in
+ let lvPtr = mkCast ~e:(mkAddrOf (new_lv)) ~newt:(charPtrType) in
+ (BinOp(PlusPI, lvPtr, (integer bytes_offset), ulongType))
+ end else (AddrOf (lh,lo))
+
+class logWriteVisitor = object
+ inherit nopCilVisitor
+ (* Create a prototype for the logging function, but don't put it in the
+ * file *)
+ val printfFun =
+ let fdec = emptyFunction "syslog" in
+ fdec.svar.vtype <- TFun(intType,
+ Some [ ("prio", intType, []);
+ ("format", charConstPtrType, []) ],
+ true, []);
+ fdec
+
+ method vinst (i: instr) : instr list visitAction =
+ match i with
+ Set(lv, e, l) -> begin
+ (* Check if we need to log *)
+ match lv with
+ (Var(v), off) when not v.vglob -> SkipChildren
+ | _ -> let str = Pretty.sprint 80
+ (Pretty.dprintf "Write %%p to 0x%%08x at %%s:%%d (%a)\n" d_lval lv)
+ in
+ ChangeTo
+ [ Call((None), (Lval(Var(printfFun.svar),NoOffset)),
+ [ one ;
+ mkString str ; e ; addr_of_lv lv;
+ mkString l.file;
+ integer l.line], locUnknown);
+ i]
+ end
+ | Call(Some lv, f, args, l) -> begin
+ (* Check if we need to log *)
+ match lv with
+ (Var(v), off) when not v.vglob -> SkipChildren
+ | _ -> let str = Pretty.sprint 80
+ (Pretty.dprintf "Write retval to 0x%%08x at %%s:%%d (%a)\n" d_lval lv)
+ in
+ ChangeTo
+ [ Call((None), (Lval(Var(printfFun.svar),NoOffset)),
+ [ one ;
+ mkString str ; AddrOf lv;
+ mkString l.file;
+ integer l.line], locUnknown);
+ i]
+ end
+ | _ -> SkipChildren
+
+end
+
+let feature : featureDescr =
+ { fd_name = "logwrites";
+ fd_enabled = Cilutil.logWrites;
+ fd_description = "generation of code to log memory writes";
+ fd_extraopt = [];
+ fd_doit =
+ (function (f: file) ->
+ let lwVisitor = new logWriteVisitor in
+ visitCilFileSameGlobals lwVisitor f);
+ fd_post_check = true;
+ }
+
diff --git a/cil/src/ext/oneret.ml b/cil/src/ext/oneret.ml
new file mode 100644
index 0000000..b3ce4a1
--- /dev/null
+++ b/cil/src/ext/oneret.ml
@@ -0,0 +1,187 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* Make sure that there is exactly one Return statement in the whole body.
+ * Replace all the other returns with Goto. This is convenient if you later
+ * want to insert some finalizer code, since you have a precise place where
+ * to put it *)
+open Cil
+open Pretty
+
+module E = Errormsg
+
+let dummyVisitor = new nopCilVisitor
+
+let oneret (f: Cil.fundec) : unit =
+ let fname = f.svar.vname in
+ (* Get the return type *)
+ let retTyp =
+ match f.svar.vtype with
+ TFun(rt, _, _, _) -> rt
+ | _ -> E.s (E.bug "Function %s does not have a function type\n"
+ f.svar.vname)
+ in
+ (* Does it return anything ? *)
+ let hasRet = match unrollType retTyp with TVoid _ -> false | _ -> true in
+
+ (* Memoize the return result variable. Use only if hasRet *)
+ let lastloc = ref locUnknown in
+ let retVar : varinfo option ref = ref None in
+ let getRetVar (x: unit) : varinfo =
+ match !retVar with
+ Some rv -> rv
+ | None -> begin
+ let rv = makeLocalVar f "__retres" retTyp in (* don't collide *)
+ retVar := Some rv;
+ rv
+ end
+ in
+ (* Remember if we have introduced goto's *)
+ let haveGoto = ref false in
+ (* Memoize the return statement *)
+ let retStmt : stmt ref = ref dummyStmt in
+ let getRetStmt (x: unit) : stmt =
+ if !retStmt == dummyStmt then begin
+ (* Must create a statement *)
+ let rv =
+ if hasRet then Some (Lval(Var (getRetVar ()), NoOffset)) else None
+ in
+ let sr = mkStmt (Return (rv, !lastloc)) in
+ retStmt := sr;
+ sr
+ end else
+ !retStmt
+ in
+ (* Now scan all the statements. Know if you are the main body of the
+ * function and be prepared to add new statements at the end *)
+ let rec scanStmts (mainbody: bool) = function
+ | [] when mainbody -> (* We are at the end of the function. Now it is
+ * time to add the return statement *)
+ let rs = getRetStmt () in
+ if !haveGoto then
+ rs.labels <- (Label("return_label", !lastloc, false)) :: rs.labels;
+ [rs]
+
+ | [] -> []
+
+ | ({skind=Return (retval, l)} as s) :: rests ->
+ currentLoc := l;
+(*
+ ignore (E.log "Fixing return(%a) at %a\n"
+ insert
+ (match retval with None -> text "None"
+ | Some e -> d_exp () e)
+ d_loc l);
+*)
+ if hasRet && retval = None then
+ E.s (error "Found return without value in function %s\n" fname);
+ if not hasRet && retval <> None then
+ E.s (error "Found return in subroutine %s\n" fname);
+ (* Keep this statement because it might have labels. But change it to
+ * an instruction that sets the return value (if any). *)
+ s.skind <- begin
+ match retval with
+ Some rval -> Instr [Set((Var (getRetVar ()), NoOffset), rval, l)]
+ | None -> Instr []
+ end;
+ (* See if this is the last statement in function *)
+ if mainbody && rests == [] then
+ s :: scanStmts mainbody rests
+ else begin
+ (* Add a Goto *)
+ let sgref = ref (getRetStmt ()) in
+ let sg = mkStmt (Goto (sgref, l)) in
+ haveGoto := true;
+ s :: sg :: (scanStmts mainbody rests)
+ end
+
+ | ({skind=If(eb,t,e,l)} as s) :: rests ->
+ currentLoc := l;
+ s.skind <- If(eb, scanBlock false t, scanBlock false e, l);
+ s :: scanStmts mainbody rests
+(*
+ | ({skind=Loop(b,l,lb1,lb2)} as s) :: rests ->
+ currentLoc := l;
+ s.skind <- Loop(scanBlock false b, l,lb1,lb2);
+ s :: scanStmts mainbody rests
+*)
+ | ({skind=While(e,b,l)} as s) :: rests ->
+ currentLoc := l;
+ s.skind <- While(e, scanBlock false b, l);
+ s :: scanStmts mainbody rests
+ | ({skind=DoWhile(e,b,l)} as s) :: rests ->
+ currentLoc := l;
+ s.skind <- DoWhile(e, scanBlock false b, l);
+ s :: scanStmts mainbody rests
+ | ({skind=For(bInit,e,bIter,b,l)} as s) :: rests ->
+ currentLoc := l;
+ s.skind <- For(scanBlock false bInit, e, scanBlock false bIter,
+ scanBlock false b, l);
+ s :: scanStmts mainbody rests
+ | ({skind=Switch(e, b, cases, l)} as s) :: rests ->
+ currentLoc := l;
+ s.skind <- Switch(e, scanBlock false b, cases, l);
+ s :: scanStmts mainbody rests
+ | ({skind=Block b} as s) :: rests ->
+ s.skind <- Block (scanBlock false b);
+ s :: scanStmts mainbody rests
+ | ({skind=(Goto _ | Instr _ | Continue _ | Break _
+ | TryExcept _ | TryFinally _)} as s)
+ :: rests -> s :: scanStmts mainbody rests
+
+ and scanBlock (mainbody: bool) (b: block) =
+ { bstmts = scanStmts mainbody b.bstmts; battrs = b.battrs; }
+
+ in
+ ignore (visitCilBlock dummyVisitor f.sbody) ; (* sets CurrentLoc *)
+ lastloc := !currentLoc ; (* last location in the function *)
+ f.sbody <- scanBlock true f.sbody
+
+
+let feature : featureDescr =
+ { fd_name = "oneRet";
+ fd_enabled = Cilutil.doOneRet;
+ fd_description = "make each function have at most one 'return'" ;
+ fd_extraopt = [];
+ fd_doit = (function (f: file) ->
+ Cil.iterGlobals f (fun glob -> match glob with
+ Cil.GFun(fd,_) -> oneret fd;
+ | _ -> ()));
+ fd_post_check = true;
+ }
diff --git a/cil/src/ext/oneret.mli b/cil/src/ext/oneret.mli
new file mode 100644
index 0000000..f98ab4d
--- /dev/null
+++ b/cil/src/ext/oneret.mli
@@ -0,0 +1,44 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(* Make sure that there is only one Return statement in the whole body.
+ * Replace all the other returns with Goto. Make sure that there is a return
+ * if the function is supposed to return something, and it is not declared to
+ * not return. *)
+val oneret: Cil.fundec -> unit
+val feature : Cil.featureDescr
diff --git a/cil/src/ext/partial.ml b/cil/src/ext/partial.ml
new file mode 100644
index 0000000..4beca3f
--- /dev/null
+++ b/cil/src/ext/partial.ml
@@ -0,0 +1,851 @@
+(* See copyright notice at the end of the file *)
+(*****************************************************************************
+ * Partial Evaluation & Constant Folding
+ *
+ * Soundness Assumptions:
+ * (1) Whole program analysis. You may call functions that are not defined
+ * (e.g., library functions) but they may not call back.
+ * (2) An undefined function may not return the address of a function whose
+ * address is not already taken in the code I can see.
+ * (3) A function pointer call may only call a function that has its
+ * address visibly taken in the code I can see.
+ *
+ * (More assumptions in the comments below)
+ *****************************************************************************)
+open Cil
+open Pretty
+
+(*****************************************************************************
+ * A generic signature for Alias Analysis information. Used to compute the
+ * call graph and do symbolic execution.
+ ****************************************************************************)
+module type AliasInfo =
+ sig
+ val can_have_the_same_value : Cil.exp -> Cil.exp -> bool
+ val resolve_function_pointer : Cil.exp -> (Cil.fundec list)
+ end
+
+(*****************************************************************************
+ * A generic signature for Symbolic Execution execution algorithms. Such
+ * algorithms are used below to perform constant folding and dead-code
+ * elimination. You write a "basic-block" symex algorithm, we'll make it
+ * a whole-program CFG-pruner.
+ ****************************************************************************)
+module type Symex =
+ sig
+ type t (* the type of a symex algorithm state object *)
+ val empty : t (* all values unknown *)
+ val equal : t -> t -> bool (* are these the same? *)
+ val assign : t -> Cil.lval -> Cil.exp -> (Cil.exp * t)
+ (* incorporate an assignment, return the RHS *)
+ val unassign : t -> Cil.lval -> t
+ (* lose all information about the given lvalue: assume an
+ * unknown external value has been assigned to it *)
+ val assembly : t -> Cil.instr -> t (* handle ASM *)
+ val assume : t -> Cil.exp -> t (* incorporate an assumption *)
+ val evaluate : t -> Cil.exp -> Cil.exp (* symbolic evaluation *)
+ val join : (t list) -> t (* join a bunch of states *)
+ val call : t -> Cil.fundec -> (Cil.exp list) -> (Cil.exp list * t)
+ (* we are calling the given function with the given actuals *)
+ val return : t -> Cil.fundec -> t
+ (* we are returning from the given function *)
+ val call_to_unknown_function : t -> t
+ (* throw away information that may have been changed *)
+ val debug : t -> unit
+ end
+
+(*****************************************************************************
+ * A generic signature for whole-progam call graphs.
+ ****************************************************************************)
+module type CallGraph =
+ sig
+ type t (* the type of a call graph *)
+ val compute : Cil.file -> t (* file for which we compute the graph *)
+ val can_call : t -> Cil.fundec -> (Cil.fundec list)
+ val can_be_called_by : t -> Cil.fundec -> (Cil.fundec list)
+ val fundec_of_varinfo : t -> Cil.varinfo -> Cil.fundec
+ end
+
+(*****************************************************************************
+ * My cheap-o Alias Analysis. Assume all expressions can have the same
+ * value and any function with its address taken can be the target of
+ * any function pointer.
+ *
+ * Soundness Assumptions:
+ * (1) Someone must call "find_all_functions_With_address_taken" before the
+ * results are valid. This is already done in the code below.
+ ****************************************************************************)
+let all_functions_with_address_taken = ref []
+let find_all_functions_with_address_taken (f : Cil.file) =
+ iterGlobals f (fun g -> match g with
+ GFun(fd,_) -> if fd.svar.vaddrof then
+ all_functions_with_address_taken := fd ::
+ !all_functions_with_address_taken
+ | _ -> ())
+
+module EasyAlias =
+ struct
+ let can_have_the_same_value e1 e2 = true
+ let resolve_function_pointer e1 = !all_functions_with_address_taken
+ end
+
+(*****************************************************************************
+ * My particular method for computing the Call Graph.
+ ****************************************************************************)
+module EasyCallGraph = functor (A : AliasInfo) ->
+ struct
+ type callGraphNode = {
+ fd : Cil.fundec ;
+ mutable calledBy : Cil.fundec list ;
+ mutable calls : Cil.fundec list ;
+ }
+ type t = (Cil.varinfo, callGraphNode) Hashtbl.t
+
+ let cgCreateNode cg fundec =
+ let newnode = { fd = fundec ; calledBy = [] ; calls = [] } in
+ Hashtbl.add cg fundec.svar newnode
+
+ let cgFindNode cg svar = Hashtbl.find cg svar
+
+ let cgAddEdge cg caller callee =
+ try
+ let n1 = cgFindNode cg caller in
+ let n2 = cgFindNode cg callee in
+ n1.calls <- n2.fd :: n1.calls ;
+ n1.calledBy <- n1.fd :: n1.calledBy
+ with _ -> ()
+
+ class callGraphVisitor cg = object
+ inherit nopCilVisitor
+ val the_fun = ref None
+
+ method vinst i =
+ let _ = match i with
+ Call(_,Lval(Var(callee),NoOffset),_,_) -> begin
+ (* known function call *)
+ match !the_fun with
+ None -> failwith "callGraphVisitor: call outside of any function"
+ | Some(enclosing) -> cgAddEdge cg enclosing callee
+ end
+ | Call(_,e,_,_) -> begin
+ (* unknown function call *)
+ match !the_fun with
+ None -> failwith "callGraphVisitor: call outside of any function"
+ | Some(enclosing) -> let lst = A.resolve_function_pointer e in
+ List.iter (fun possible_target_fd ->
+ cgAddEdge cg enclosing possible_target_fd.svar) lst
+ end
+ | _ -> ()
+ in SkipChildren
+
+ method vfunc f = the_fun := Some(f.svar) ; DoChildren
+ end
+
+ let compute (f : Cil.file) =
+ let cg = Hashtbl.create 511 in
+ iterGlobals f (fun g -> match g with
+ GFun(fd,_) -> cgCreateNode cg fd
+ | _ -> ()
+ ) ;
+ visitCilFileSameGlobals (new callGraphVisitor cg) f ;
+ cg
+
+ let can_call cg fd =
+ let n = cgFindNode cg fd.svar in n.calls
+ let can_be_called_by cg fd =
+ let n = cgFindNode cg fd.svar in n.calledBy
+ let fundec_of_varinfo cg vi =
+ let n = cgFindNode cg vi in n.fd
+ end (* END OF: module EasyCallGraph *)
+
+(*****************************************************************************
+ * Necula's Constant Folding Strategem (re-written to be applicative)
+ *
+ * Soundness Assumptions:
+ * (1) Inline assembly does not affect constant folding.
+ ****************************************************************************)
+module OrderedInt =
+ struct
+ type t = int
+ let compare = compare
+ end
+module IntMap = Map.Make(OrderedInt)
+
+module NeculaFolding = functor (A : AliasInfo) ->
+ struct
+ (* Register file. Maps identifiers of local variables to expressions.
+ * We also remember if the expression depends on memory or depends on
+ * variables that depend on memory *)
+ type reg = {
+ rvi : varinfo ;
+ rval : exp ;
+ rmem : bool
+ }
+ type t = reg IntMap.t
+ let empty = IntMap.empty
+ let equal t1 t2 = (compare t1 t2 = 0) (* use OCAML here *)
+ let dependsOnMem = ref false
+ (* Rewrite an expression based on the current register file *)
+ class rewriteExpClass (regFile : t) = object
+ inherit nopCilVisitor
+ method vexpr = function
+ | Lval (Var v, NoOffset) -> begin
+ try
+ let defined = (IntMap.find v.vid regFile) in
+ if (defined.rmem) then dependsOnMem := true;
+ (match defined.rval with
+ | Const(x) -> ChangeTo (defined.rval)
+ | _ -> DoChildren)
+ with Not_found -> DoChildren
+ end
+ | Lval (Mem _, _) -> dependsOnMem := true; DoChildren
+ | _ -> DoChildren
+ end
+ (* Rewrite an expression and return the new expression along with an
+ * indication of whether it depends on memory *)
+ let rewriteExp r (e: exp) : exp * bool =
+ dependsOnMem := false;
+ let e' = constFold true (visitCilExpr (new rewriteExpClass r) e) in
+ e', !dependsOnMem
+ let eval r e =
+ let new_e, depends = rewriteExp r e in
+ new_e
+
+ let setMemory regFile =
+ (* Get a list of all mappings that depend on memory *)
+ let depids = ref [] in
+ IntMap.iter (fun id v -> if v.rmem then depids := id :: !depids) regFile;
+ (* And remove them from the register file *)
+ List.fold_left (fun acc id -> IntMap.remove id acc) regFile !depids
+
+ let setRegister regFile (v: varinfo) ((e,b): exp * bool) =
+ IntMap.add v.vid { rvi = v ; rval = e ; rmem = b; } regFile
+
+ let resetRegister regFile (id: int) =
+ IntMap.remove id regFile
+
+ class findLval lv contains = object
+ inherit nopCilVisitor
+ method vlval l =
+ if l = lv then
+ (contains := true ; SkipChildren)
+ else
+ DoChildren
+ end
+
+ let removeMappingsThatDependOn regFile l =
+ (* Get a list of all mappings that depend on l *)
+ let depids = ref [] in
+ IntMap.iter (fun id reg ->
+ let found = ref false in
+ ignore (visitCilExpr (new findLval l found) reg.rval) ;
+ if !found then
+ depids := id :: !depids
+ ) regFile ;
+ (* And remove them from the register file *)
+ List.fold_left (fun acc id -> IntMap.remove id acc) regFile !depids
+
+ let assign r l e =
+ let (newe,b) = rewriteExp r e in
+ let r' = match l with
+ (Var v, NoOffset) ->
+ let r'' = setRegister r v (newe,b) in
+ removeMappingsThatDependOn r'' l
+ | (Mem _, _) -> setMemory r
+ | _ -> r
+ in newe, r'
+
+ let unassign r l =
+ let r' = match l with
+ (Var v, NoOffset) ->
+ let r'' = resetRegister r v.vid in
+ removeMappingsThatDependOn r'' l
+ | (Mem _, _) -> setMemory r
+ | _ -> r
+ in r'
+
+ let assembly r i = r (* no-op in Necula-world *)
+ let assume r e = r (* no-op in Necula-world *)
+
+ let evaluate r e =
+ let (newe,_) = rewriteExp r e in
+ newe
+
+ (* Join two symex states *)
+ let join2 (r1 : t) (r2 : t) =
+ let keep = ref [] in
+ IntMap.iter (fun id reg ->
+ try
+ let reg' = IntMap.find id r2 in
+ if reg'.rval = reg.rval && reg'.rmem = reg.rmem then
+ keep := (id,reg) :: !keep
+ with _ -> ()
+ ) r1 ;
+ List.fold_left (fun acc (id,v) ->
+ IntMap.add id v acc) (IntMap.empty) !keep
+
+ let join (lst : t list) = match lst with
+ [] -> failwith "empty list"
+ | r :: tl -> List.fold_left
+ (fun (acc : t) (elt : t) -> join2 acc elt) r tl
+
+ let call r fd el =
+ let new_arg_list = ref [] in
+ let final_r = List.fold_left2 (fun r vi e ->
+ let newe, r' = assign r ((Var(vi),NoOffset)) e in
+ new_arg_list := newe :: !new_arg_list ;
+ r'
+ ) r fd.sformals el in
+ (List.rev !new_arg_list), final_r
+
+ let return r fd =
+ let regFile =
+ List.fold_left (fun r vi -> IntMap.remove vi.vid r) r fd.sformals
+ in
+ (* Get a list of all globals *)
+ let depids = ref [] in
+ IntMap.iter (fun vid reg ->
+ if reg.rvi.vglob || reg.rvi.vaddrof then depids := vid :: !depids
+ ) regFile ;
+ (* And remove them from the register file *)
+ List.fold_left (fun acc id -> IntMap.remove id acc) regFile !depids
+
+
+ let call_to_unknown_function r =
+ setMemory r
+
+ let debug r =
+ IntMap.iter (fun key reg ->
+ ignore (Pretty.printf "%s <- %a (%b)@!" reg.rvi.vname d_exp reg.rval reg.rmem)
+ ) r
+ end (* END OF: NeculaFolding *)
+
+(*****************************************************************************
+ * A transformation to make every function call end its statement. So
+ * { x=1; Foo(); y=1; }
+ * becomes at least:
+ * { { x=1; Foo(); }
+ * { y=1; } }
+ * But probably more like:
+ * { { x=1; } { Foo(); } { y=1; } }
+ ****************************************************************************)
+let rec contains_call il = match il with
+ [] -> false
+ | Call(_) :: tl -> true
+ | _ :: tl -> contains_call tl
+
+class callBBVisitor = object
+ inherit nopCilVisitor
+
+ method vstmt s =
+ match s.skind with
+ Instr(il) when contains_call il -> begin
+ let list_of_stmts = List.map (fun one_inst ->
+ mkStmtOneInstr one_inst) il in
+ let block = mkBlock list_of_stmts in
+ ChangeDoChildrenPost(s, (fun _ ->
+ s.skind <- Block(block) ;
+ s))
+ end
+ | _ -> DoChildren
+
+ method vvdec _ = SkipChildren
+ method vexpr _ = SkipChildren
+ method vlval _ = SkipChildren
+ method vtype _ = SkipChildren
+end
+
+let calls_end_basic_blocks f =
+ let thisVisitor = new callBBVisitor in
+ visitCilFileSameGlobals thisVisitor f
+
+(*****************************************************************************
+ * A transformation that gives each variable a unique identifier.
+ ****************************************************************************)
+class vidVisitor = object
+ inherit nopCilVisitor
+ val count = ref 0
+
+ method vvdec vi =
+ vi.vid <- !count ;
+ incr count ; SkipChildren
+end
+
+let globally_unique_vids f =
+ let thisVisitor = new vidVisitor in
+ visitCilFileSameGlobals thisVisitor f
+
+(*****************************************************************************
+ * The Weimeric Partial Evaluation Data-Flow Engine
+ *
+ * This functor performs flow-sensitive, context-insensitive whole-program
+ * data-flow analysis with an eye toward partial evaluation and constant
+ * folding.
+ *
+ * Toposort the whole-program inter-procedural CFG to compute
+ * (1) the number of actual predecessors for each statement
+ * (2) the global toposort ordering
+ *
+ * Perform standard data-flow analysis (joins, etc) on the ICFG until you
+ * hit a fixed point. If this changed the structure of the ICFG (by
+ * removing an IF-branch or an empty function call), redo the whole thing.
+ *
+ * Soundness Assumptions:
+ * (1) A "call instruction" is the last thing in its statement.
+ * Use "calls_end_basic_blocks" to get this. cil/src/main.ml does
+ * this when you pass --makeCFG.
+ * (2) All variables have globally unique identifiers.
+ * Use "globally_unique_vids" to get this. cil/src/main.ml does
+ * this when you pass --makeCFG.
+ * (3) This may not be a strict soundness requirement, but I wrote this
+ * assuming that the input file has all switch/break/continue
+ * statements removed.
+ ****************************************************************************)
+module MakePartial =
+ functor (S : Symex) ->
+ functor (C : CallGraph) ->
+ functor (A : AliasInfo) ->
+ struct
+
+ let debug = false
+
+ (* We keep this information about every statement. Ideally this should
+ * be put in the stmt itself, but CIL doesn't give us space. *)
+ type sinfo = { (* statement info *)
+ incoming_state : (int, S.t) Hashtbl.t ;
+ (* mapping from stmt.sid to Symex.state *)
+ reachable_preds : (int, bool) Hashtbl.t ;
+ (* basically a set of all of the stmt.sids that can really
+ * reach this statement *)
+ mutable last_used_state : S.t option ;
+ (* When we last did the Post() of this statement, what
+ * incoming state did we use? If our new incoming state is
+ * the same, we don't have to do it again. *)
+ mutable priority : int ;
+ (* Whole-program toposort priority. High means "do me first".
+ * The first stmt in "main()" will have the highest priority.
+ *)
+ }
+ let sinfo_ht = Hashtbl.create 511
+ let clear_sinfo () = Hashtbl.clear sinfo_ht
+
+ (* We construct sinfo nodes lazily: if you ask for one that isn't
+ * there, we build it. *)
+ let get_sinfo stmt =
+ try
+ Hashtbl.find sinfo_ht stmt.sid
+ with _ ->
+ let new_sinfo = { incoming_state = Hashtbl.create 3 ;
+ reachable_preds = Hashtbl.create 3 ;
+ last_used_state = None ;
+ priority = (-1) ; } in
+ Hashtbl.add sinfo_ht stmt.sid new_sinfo ;
+ new_sinfo
+
+ (* Topological Sort is a DFS in which you assign a priority right as
+ * you finished visiting the children. While we're there we compute
+ * the actual number of unique predecessors for each statement. The CIL
+ * information may be out of date because we keep changing the CFG by
+ * removing IFs and whatnot. *)
+ let toposort_counter = ref 1
+ let add_edge s1 s2 =
+ let si2 = get_sinfo s2 in
+ Hashtbl.replace si2.reachable_preds s1.sid true
+
+ let rec toposort c stmt =
+ let si = get_sinfo stmt in
+ if si.priority >= 0 then
+ () (* already visited! *)
+ else begin
+ si.priority <- 0 ; (* currently visiting *)
+ (* handle function calls in this basic block *)
+ (match stmt.skind with
+ (Instr(il)) ->
+ List.iter (fun i ->
+ let fd_list = match i with
+ Call(_,Lval(Var(vi),NoOffset),_,_) ->
+ begin
+ try
+ let fd = C.fundec_of_varinfo c vi in
+ [fd]
+ with e -> [] (* calling external function *)
+ end
+ | Call(_,e,_,_) ->
+ A.resolve_function_pointer e
+ | _ -> []
+ in
+ List.iter (fun fd ->
+ if List.length fd.sbody.bstmts > 0 then
+ let fun_stmt = List.hd fd.sbody.bstmts in
+ add_edge stmt fun_stmt ;
+ toposort c fun_stmt
+ ) fd_list
+ ) il
+ | _ -> ());
+ List.iter (fun succ ->
+ add_edge stmt succ ; toposort c succ) stmt.succs ;
+ si.priority <- !toposort_counter ;
+ incr toposort_counter
+ end
+
+ (* we set this to true whenever we eliminate an IF or otherwise
+ * change the CFG *)
+ let changed_cfg = ref false
+
+ (* Partially evaluate / constant fold a statement. Basically this just
+ * asks the Symex algorithm to evaluate the RHS in the current state
+ * and then compute a new state that incorporates the assignment.
+ *
+ * However, we have special handling for ifs and calls. If we can
+ * evaluate an if predicate to a constant, we remove the if.
+ *
+ * If we are going to make a call to a function with an empty body, we
+ * remove the function call. *)
+ let partial_stmt c state stmt handle_funcall =
+ let result = match stmt.skind with
+ Instr(il) ->
+ let state = ref state in
+ let new_il = List.map (fun i ->
+ if debug then begin
+ ignore (Pretty.printf "Instr %a@!" d_instr i )
+ end ;
+ match i with
+ | Set(l,e,loc) ->
+ let e', state' = S.assign !state l e in
+ state := state' ;
+ [Set(l,e',loc)]
+ | Call(lo,(Lval(Var(vi),NoOffset)),al,loc) ->
+ let result = begin
+ try
+ let fd = C.fundec_of_varinfo c vi in
+ begin
+ match fd.sbody.bstmts with
+ [] -> [] (* no point in making this call *)
+ | hd :: tl ->
+ let al', state' = S.call !state fd al in
+ handle_funcall stmt hd state' ;
+ let state'' = S.return state' fd in
+ state := state'' ;
+ [Call(lo,(Lval(Var(vi),NoOffset)),al',loc)]
+ end
+ with e ->
+ let state'' = S.call_to_unknown_function !state in
+ let al' = List.map (S.evaluate !state) al in
+ state := state'' ;
+ [Call(lo,(Lval(Var(vi),NoOffset)),al',loc)]
+ end in
+ (* handle return value *)
+ begin
+ match lo with
+ Some(lv) -> state := S.unassign !state lv
+ | _ -> ()
+ end ;
+ result
+ | Call(lo,f,al,loc) ->
+ let al' = List.map (S.evaluate !state) al in
+ state := S.call_to_unknown_function !state ;
+ (match lo with
+ Some(lv) -> state := S.unassign !state lv
+ | None -> ()) ;
+ [Call(lo,f,al',loc)]
+ | Asm(_) -> state := S.assembly !state i ; [i]
+ ) il in
+ stmt.skind <- Instr(List.flatten new_il) ;
+ if debug then begin
+ ignore (Pretty.printf "New Stmt is %a@!" d_stmt stmt) ;
+ end ;
+ !state
+
+ | If(e,b1,b2,loc) ->
+ let e' = S.evaluate state e in
+ (* Pretty.printf "%a evals to %a\n" d_exp e d_exp e' ; *)
+
+ (* helper function to remove an IF branch *)
+ let remove b remains = begin
+ changed_cfg := true ;
+ (match b.bstmts with
+ | [] -> ()
+ | hd :: tl ->
+ stmt.succs <- List.filter (fun succ -> succ.sid <> hd.sid)
+ stmt.succs
+ )
+ end in
+
+ if (e' = one) then begin
+ if b2.bstmts = [] && b2.battrs = [] then begin
+ stmt.skind <- Block(b1) ;
+ match b1.bstmts with
+ [] -> failwith "partial: completely empty if"
+ | hd :: tl -> stmt.succs <- [hd]
+ end else
+ stmt.skind <- Block(
+ { bstmts =
+ [ mkStmt (Block(b1)) ;
+ mkStmt (If(zero,b2,{bstmts=[];battrs=[];},loc)) ] ;
+ battrs = [] } ) ;
+ remove b2 b1 ;
+ state
+ end else if (e' = zero) then begin
+ if b1.bstmts = [] && b1.battrs = [] then begin
+ stmt.skind <- Block(b2) ;
+ match b2.bstmts with
+ [] -> failwith "partial: completely empty if"
+ | hd :: tl -> stmt.succs <- [hd]
+ end else
+ stmt.skind <- Block(
+ { bstmts =
+ [ mkStmt (Block(b2)) ;
+ mkStmt (If(zero,b1,{bstmts=[];battrs=[];},loc)) ] ;
+ battrs = [] } ) ;
+ remove b1 b2 ;
+ state
+ end else begin
+ stmt.skind <- If(e',b1,b2,loc) ;
+ state
+ end
+
+ | Return(Some(e),loc) ->
+ let e' = S.evaluate state e in
+ stmt.skind <- Return(Some(e'),loc) ;
+ state
+
+ | Block(b) ->
+ if debug && List.length stmt.succs > 1 then begin
+ ignore (Pretty.printf "(%a) has successors [%a]@!"
+ d_stmt stmt
+ (docList ~sep:(chr '@') (d_stmt ()))
+ stmt.succs)
+ end ;
+ state
+
+ | _ -> state
+ in result
+
+ (*
+ * This is the main conceptual entry-point for the partial evaluation
+ * data-flow functor.
+ *)
+ let dataflow (file : Cil.file) (* whole program *)
+ (c : C.t) (* control-flow graph *)
+ (initial_state : S.t) (* any assumptions? *)
+ (initial_stmt : Cil.stmt) (* entry point *)
+ = begin
+ (* count the total number of statements in the program *)
+ let num_stmts = ref 1 in
+ iterGlobals file (fun g -> match g with
+ GFun(fd,_) -> begin
+ match fd.smaxstmtid with
+ Some(i) -> if i > !num_stmts then num_stmts := i
+ | None -> ()
+ end
+ | _ -> ()
+ ) ;
+ (if debug then
+ Printf.printf "Dataflow: at most %d statements in program\n" !num_stmts);
+
+ (* create a priority queue in which to store statements *)
+ let worklist = Heap.create !num_stmts in
+
+ let finished = ref false in
+ let passes = ref 0 in
+
+ (* add something to the work queue *)
+ let enqueue caller callee state = begin
+ let si = get_sinfo callee in
+ Hashtbl.replace si.incoming_state caller.sid state ;
+ Heap.insert worklist si.priority callee
+ end in
+
+ (* we will be finished when we complete a round of data-flow that
+ * does not change the ICFG *)
+ while not !finished do
+ clear_sinfo () ;
+ incr passes ;
+
+ (* we must recompute the ordering and the predecessor information
+ * because we may have changed it by removing IFs *)
+ (if debug then Printf.printf "Dataflow: Topological Sorting & Reachability\n" );
+ toposort c initial_stmt ;
+
+ let initial_si = get_sinfo initial_stmt in
+ Heap.insert worklist initial_si.priority initial_stmt ;
+
+ while not (Heap.is_empty worklist) do
+ let (p,s) = Heap.extract_max worklist in
+ if debug then begin
+ ignore (Pretty.printf "Working on stmt %d (%a) %a@!"
+ s.sid
+ (docList ~sep:(chr ',' ++ break) (fun s -> dprintf "%d" s.sid))
+ s.succs
+ d_stmt s) ;
+ flush stdout ;
+ end ;
+ let si = get_sinfo s in
+
+ (* Even though this stmt is on the worklist, we may not have
+ * to do anything with it if the join of all of the incoming
+ * states is the same as the last state we used here. *)
+ let must_recompute, incoming_state =
+ begin
+ let list_of_incoming_states = ref [] in
+ Hashtbl.iter (fun true_pred_sid b ->
+ let this_pred_state =
+ try
+ Hashtbl.find si.incoming_state true_pred_sid
+ with _ ->
+ (* this occurs when we're evaluating a statement and we
+ * have not yet evaluated all of its predecessors (the
+ * first time we look at a loop head, say). We must be
+ * conservative. We'll come back later with better
+ * information (as we work toward the fix-point). *)
+ S.empty
+ in
+ if debug then begin
+ Printf.printf " Incoming State from %d\n" true_pred_sid ;
+ S.debug this_pred_state ;
+ flush stdout ;
+ end ;
+ list_of_incoming_states := this_pred_state ::
+ !list_of_incoming_states
+ ) si.reachable_preds ;
+ let merged_incoming_state =
+ if !list_of_incoming_states = [] then
+ (* this occurs when we're looking at the first statement
+ * in "main" -- it has no preds *)
+ initial_state
+ else
+ S.join !list_of_incoming_states
+ in
+ if debug then begin
+ Printf.printf " Merged State:\n" ;
+ S.debug merged_incoming_state ;
+ flush stdout ;
+ end ;
+ let must_recompute = match si.last_used_state with
+ None -> true
+ | Some(last) -> not (S.equal merged_incoming_state last)
+ in must_recompute, merged_incoming_state
+ end
+ in
+ if must_recompute then begin
+ si.last_used_state <- Some(incoming_state) ;
+ let outgoing_state =
+ (* partially evaluate and optimize the statement *)
+ partial_stmt c incoming_state s enqueue in
+ let fresh_succs = s.succs in
+ (* touch every successor so that we will reconsider it *)
+ List.iter (fun succ ->
+ enqueue s succ outgoing_state
+ ) fresh_succs ;
+ end else begin
+ if debug then begin
+ Printf.printf "No need to recompute.\n"
+ end
+ end
+ done ;
+ (if debug then Printf.printf "Dataflow: Pass %d Complete\n" !passes) ;
+ if !changed_cfg then begin
+ (if debug then Printf.printf "Dataflow: Restarting (CFG Changed)\n") ;
+ changed_cfg := false
+ end else
+ finished := true
+ done ;
+ (if debug then Printf.printf "Dataflow: Completed (%d passes)\n" !passes)
+
+ end
+
+ let simplify file c fd (assumptions : (Cil.lval * Cil.exp) list) =
+ let starting_state = List.fold_left (fun s (l,e) ->
+ let e',s' = S.assign s l e in
+ s'
+ ) S.empty assumptions in
+ dataflow file c starting_state (List.hd fd.sbody.bstmts)
+
+ end
+
+
+(*
+ * Currently our partial-eval optimizer is built out of basically nothing.
+ * The alias analysis is fake, the call grpah is cheap, and we're using
+ * George's old basic-block symex. Still, it works.
+ *)
+(* Don't you love Functor application? *)
+module BasicCallGraph = EasyCallGraph(EasyAlias)
+module BasicSymex = NeculaFolding(EasyAlias)
+module BasicPartial = MakePartial(BasicSymex)(BasicCallGraph)(EasyAlias)
+
+(*
+ * A very easy entry-point to partial evaluation/symbolic execution.
+ * You pass the Cil file and a list of assumptions (lvalue, exp pairs that
+ * should be treated as assignments that occur before the program starts).
+ *
+ * We partially evaluate and optimize starting from "main". The Cil.file
+ * is modified in place.
+ *)
+let partial (f : Cil.file) (assumptions : (Cil.lval * Cil.exp) list) =
+ try
+ find_all_functions_with_address_taken f ;
+ let c = BasicCallGraph.compute f in
+ try
+ iterGlobals f (fun g -> match g with
+ GFun(fd,_) when fd.svar.vname = "main" ->
+ BasicPartial.simplify f c fd assumptions
+ | _ -> ()) ;
+ with e -> begin
+ Printf.printf "Error in DataFlow: %s\n" (Printexc.to_string e) ;
+ raise e
+ end
+ with e -> begin
+ Printf.printf "Error in Partial: %s\n" (Printexc.to_string e) ;
+ raise e
+ end
+
+let feature : featureDescr =
+ { fd_name = "partial";
+ fd_enabled = Cilutil.doPartial;
+ fd_description = "interprocedural partial evaluation and constant folding" ;
+ fd_extraopt = [];
+ fd_doit = (function (f: file) ->
+ if not !Cilutil.makeCFG then begin
+ Errormsg.s (Errormsg.error "--dopartial: you must also specify --domakeCFG\n")
+ end ;
+ partial f [] ) ;
+ fd_post_check = false;
+ }
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
diff --git a/cil/src/ext/pta/golf.ml b/cil/src/ext/pta/golf.ml
new file mode 100644
index 0000000..5ea47ff
--- /dev/null
+++ b/cil/src/ext/pta/golf.ml
@@ -0,0 +1,1657 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(***********************************************************************)
+(* *)
+(* Exceptions *)
+(* *)
+(***********************************************************************)
+
+exception Inconsistent (* raised if constraint system is inconsistent *)
+exception WellFormed (* raised if types are not well-formed *)
+exception NoContents
+exception APFound (* raised if an alias pair is found, a control
+ flow exception *)
+
+
+module U = Uref
+module S = Setp
+module H = Hashtbl
+module Q = Queue
+
+
+(** Subtyping kinds *)
+type polarity =
+ Pos
+ | Neg
+ | Sub
+
+(** Path kinds, for CFL reachability *)
+type pkind =
+ Positive
+ | Negative
+ | Match
+ | Seed
+
+(** Context kinds -- open or closed *)
+type context =
+ Open
+ | Closed
+
+(* A configuration is a context (open or closed) coupled with a pair
+ of stamps representing a state in the cartesian product DFA. *)
+type configuration = context * int * int
+
+module ConfigHash =
+struct
+ type t = configuration
+ let equal t t' = t = t'
+ let hash t = Hashtbl.hash t
+end
+
+module CH = H.Make (ConfigHash)
+
+type config_map = unit CH.t
+
+(** Generic bounds *)
+type 'a bound = {index : int; info : 'a U.uref}
+
+(** For label paths. *)
+type 'a path = {
+ kind : pkind;
+ reached_global : bool;
+ head : 'a U.uref;
+ tail : 'a U.uref
+}
+
+module Bound =
+struct
+ type 'a t = 'a bound
+ let compare (x : 'a t) (y : 'a t) =
+ if U.equal (x.info, y.info) then x.index - y.index
+ else Pervasives.compare (U.deref x.info) (U.deref y.info)
+end
+
+module Path =
+struct
+ type 'a t = 'a path
+ let compare (x : 'a t) (y : 'a t) =
+ if U.equal (x.head, y.head) then
+ begin
+ if U.equal (x.tail, y.tail) then
+ begin
+ if x.reached_global = y.reached_global then
+ Pervasives.compare x.kind y.kind
+ else Pervasives.compare x.reached_global y.reached_global
+ end
+ else Pervasives.compare (U.deref x.tail) (U.deref y.tail)
+ end
+ else Pervasives.compare (U.deref x.head) (U.deref y.head)
+end
+
+module B = S.Make (Bound)
+
+module P = S.Make (Path)
+
+type 'a boundset = 'a B.t
+
+type 'a pathset = 'a P.t
+
+(** Constants, which identify elements in points-to sets *)
+(** jk : I'd prefer to make this an 'a constant and specialize it to varinfo
+ for use with the Cil frontend, but for now, this will do *)
+type constant = int * string * Cil.varinfo
+
+module Constant =
+struct
+ type t = constant
+ let compare (xid, _, _) (yid, _, _) = xid - yid
+end
+module C = Set.Make (Constant)
+
+(** Sets of constants. Set union is used when two labels containing
+ constant sets are unified *)
+type constantset = C.t
+
+type lblinfo = {
+ mutable l_name: string;
+ (** either empty or a singleton, the initial location for this label *)
+ loc : constantset;
+ (** Name of this label *)
+ l_stamp : int;
+ (** Unique integer for this label *)
+ mutable l_global : bool;
+ (** True if this location is globally accessible *)
+ mutable aliases: constantset;
+ (** Set of constants (tags) for checking aliases *)
+ mutable p_lbounds: lblinfo boundset;
+ (** Set of umatched (p) lower bounds *)
+ mutable n_lbounds: lblinfo boundset;
+ (** Set of unmatched (n) lower bounds *)
+ mutable p_ubounds: lblinfo boundset;
+ (** Set of umatched (p) upper bounds *)
+ mutable n_ubounds: lblinfo boundset;
+ (** Set of unmatched (n) upper bounds *)
+ mutable m_lbounds: lblinfo boundset;
+ (** Set of matched (m) lower bounds *)
+ mutable m_ubounds: lblinfo boundset;
+ (** Set of matched (m) upper bounds *)
+
+ mutable m_upath: lblinfo pathset;
+ mutable m_lpath: lblinfo pathset;
+ mutable n_upath: lblinfo pathset;
+ mutable n_lpath: lblinfo pathset;
+ mutable p_upath: lblinfo pathset;
+ mutable p_lpath: lblinfo pathset;
+
+ mutable l_seeded : bool;
+ mutable l_ret : bool;
+ mutable l_param : bool;
+}
+
+(** Constructor labels *)
+and label = lblinfo U.uref
+
+(** The type of lvalues. *)
+type lvalue = {
+ l: label;
+ contents: tau
+}
+
+and vinfo = {
+ v_stamp : int;
+ v_name : string;
+
+ mutable v_hole : (int,unit) H.t;
+ mutable v_global : bool;
+ mutable v_mlbs : tinfo boundset;
+ mutable v_mubs : tinfo boundset;
+ mutable v_plbs : tinfo boundset;
+ mutable v_pubs : tinfo boundset;
+ mutable v_nlbs : tinfo boundset;
+ mutable v_nubs : tinfo boundset
+}
+
+and rinfo = {
+ r_stamp : int;
+ rl : label;
+ points_to : tau;
+ mutable r_global: bool;
+}
+
+and finfo = {
+ f_stamp : int;
+ fl : label;
+ ret : tau;
+ mutable args : tau list;
+ mutable f_global : bool;
+}
+
+and pinfo = {
+ p_stamp : int;
+ ptr : tau;
+ lam : tau;
+ mutable p_global : bool;
+}
+
+and tinfo = Var of vinfo
+ | Ref of rinfo
+ | Fun of finfo
+ | Pair of pinfo
+
+and tau = tinfo U.uref
+
+type tconstraint = Unification of tau * tau
+ | Leq of tau * (int * polarity) * tau
+
+
+(** Association lists, used for printing recursive types. The first element
+ is a type that has been visited. The second element is the string
+ representation of that type (so far). If the string option is set, then
+ this type occurs within itself, and is associated with the recursive var
+ name stored in the option. When walking a type, add it to an association
+ list.
+
+ Example : suppose we have the constraint 'a = ref('a). The type is unified
+ via cyclic unification, and would loop infinitely if we attempted to print
+ it. What we want to do is print the type u rv. ref(rv). This is accomplished
+ in the following manner:
+
+ -- ref('a) is visited. It is not in the association list, so it is added
+ and the string "ref(" is stored in the second element. We recurse to print
+ the first argument of the constructor.
+
+ -- In the recursive call, we see that 'a (or ref('a)) is already in the
+ association list, so the type is recursive. We check the string option,
+ which is None, meaning that this is the first recurrence of the type. We
+ create a new recursive variable, rv and set the string option to 'rv. Next,
+ we prepend u rv. to the string representation we have seen before, "ref(",
+ and return "rv" as the string representation of this type.
+
+ -- The string so far is "u rv.ref(". The recursive call returns, and we
+ complete the type by printing the result of the call, "rv", and ")"
+
+ In a type where the recursive variable appears twice, e.g. 'a = pair('a,'a),
+ the second time we hit 'a, the string option will be set, so we know to
+ reuse the same recursive variable name.
+*)
+type association = tau * string ref * string option ref
+
+module PathHash =
+struct
+ type t = int list
+ let equal t t' = t = t'
+ let hash t = Hashtbl.hash t
+end
+
+module PH = H.Make (PathHash)
+
+(***********************************************************************)
+(* *)
+(* Global Variables *)
+(* *)
+(***********************************************************************)
+
+(** Print the instantiations constraints. *)
+let print_constraints : bool ref = ref false
+
+(** If true, print all constraints (including induced) and show
+ additional debug output. *)
+let debug = ref false
+
+(** Just debug all the constraints (including induced) *)
+let debug_constraints = ref false
+
+(** Debug smart alias queries *)
+let debug_aliases = ref false
+
+let smart_aliases = ref false
+
+(** If true, make the flow step a no-op *)
+let no_flow = ref false
+
+(** If true, disable subtyping (unification at all levels) *)
+let no_sub = ref false
+
+(** If true, treat indexed edges as regular subtyping *)
+let analyze_mono = ref true
+
+(** A list of equality constraints. *)
+let eq_worklist : tconstraint Q.t = Q.create ()
+
+(** A list of leq constraints. *)
+let leq_worklist : tconstraint Q.t = Q.create ()
+
+let path_worklist : (lblinfo path) Q.t = Q.create ()
+
+let path_hash : (lblinfo path) PH.t = PH.create 32
+
+(** A count of the constraints introduced from the AST. Used for debugging. *)
+let toplev_count = ref 0
+
+(** A hashtable containing stamp pairs of labels that must be aliased. *)
+let cached_aliases : (int * int,unit) H.t = H.create 64
+
+(** A hashtable mapping pairs of tau's to their join node. *)
+let join_cache : (int * int, tau) H.t = H.create 64
+
+(***********************************************************************)
+(* *)
+(* Utility Functions *)
+(* *)
+(***********************************************************************)
+
+let find = U.deref
+
+let die s =
+ Printf.printf "*******\nAssertion failed: %s\n*******\n" s;
+ assert false
+
+let fresh_appsite : (unit -> int) =
+ let appsite_index = ref 0 in
+ fun () ->
+ incr appsite_index;
+ !appsite_index
+
+(** Generate a unique integer. *)
+let fresh_index : (unit -> int) =
+ let counter = ref 0 in
+ fun () ->
+ incr counter;
+ !counter
+
+let fresh_stamp : (unit -> int) =
+ let stamp = ref 0 in
+ fun () ->
+ incr stamp;
+ !stamp
+
+(** Return a unique integer representation of a tau *)
+let get_stamp (t : tau) : int =
+ match find t with
+ Var v -> v.v_stamp
+ | Ref r -> r.r_stamp
+ | Pair p -> p.p_stamp
+ | Fun f -> f.f_stamp
+
+(** Negate a polarity. *)
+let negate (p : polarity) : polarity =
+ match p with
+ Pos -> Neg
+ | Neg -> Pos
+ | Sub -> die "negate"
+
+(** Consistency checks for inferred types *)
+let pair_or_var (t : tau) =
+ match find t with
+ Pair _ -> true
+ | Var _ -> true
+ | _ -> false
+
+let ref_or_var (t : tau) =
+ match find t with
+ Ref _ -> true
+ | Var _ -> true
+ | _ -> false
+
+let fun_or_var (t : tau) =
+ match find t with
+ Fun _ -> true
+ | Var _ -> true
+ | _ -> false
+
+
+
+(** Apply [f] structurally down [t]. Guaranteed to terminate, even if [t]
+ is recursive *)
+let iter_tau f t =
+ let visited : (int,tau) H.t = H.create 4 in
+ let rec iter_tau' t =
+ if H.mem visited (get_stamp t) then () else
+ begin
+ f t;
+ H.add visited (get_stamp t) t;
+ match U.deref t with
+ Pair p ->
+ iter_tau' p.ptr;
+ iter_tau' p.lam
+ | Fun f ->
+ List.iter iter_tau' (f.args);
+ iter_tau' f.ret
+ | Ref r -> iter_tau' r.points_to
+ | _ -> ()
+ end
+ in
+ iter_tau' t
+
+(* Extract a label's bounds according to [positive] and [upper]. *)
+let get_bounds (p :polarity ) (upper : bool) (l : label) : lblinfo boundset =
+ let li = find l in
+ match p with
+ Pos -> if upper then li.p_ubounds else li.p_lbounds
+ | Neg -> if upper then li.n_ubounds else li.n_lbounds
+ | Sub -> if upper then li.m_ubounds else li.m_lbounds
+
+let equal_tau (t : tau) (t' : tau) =
+ get_stamp t = get_stamp t'
+
+let get_label_stamp (l : label) : int =
+ (find l).l_stamp
+
+(** Return true if [t] is global (treated monomorphically) *)
+let get_global (t : tau) : bool =
+ match find t with
+ Var v -> v.v_global
+ | Ref r -> r.r_global
+ | Pair p -> p.p_global
+ | Fun f -> f.f_global
+
+let is_ret_label l = (find l).l_ret || (find l).l_global (* todo - check *)
+
+let is_param_label l = (find l).l_param || (find l).l_global
+
+let is_global_label l = (find l).l_global
+
+let is_seeded_label l = (find l).l_seeded
+
+let set_global_label (l : label) (b : bool) : unit =
+ assert ((not (is_global_label l)) || b);
+ (U.deref l).l_global <- b
+
+(** Aliases for set_global *)
+let global_tau = get_global
+
+
+(** Get_global for lvalues *)
+let global_lvalue lv = get_global lv.contents
+
+
+
+(***********************************************************************)
+(* *)
+(* Printing Functions *)
+(* *)
+(***********************************************************************)
+
+let string_of_configuration (c, i, i') =
+ let context = match c with
+ Open -> "O"
+ | Closed -> "C"
+ in
+ Printf.sprintf "(%s,%d,%d)" context i i'
+
+let string_of_polarity p =
+ match p with
+ Pos -> "+"
+ | Neg -> "-"
+ | Sub -> "M"
+
+(** Convert a label to a string, short representation *)
+let string_of_label (l : label) : string =
+ "\"" ^ (find l).l_name ^ "\""
+
+(** Return true if the element [e] is present in the association list,
+ according to uref equality *)
+let rec assoc_list_mem (e : tau) (l : association list) =
+ match l with
+ | [] -> None
+ | (h, s, so) :: t ->
+ if U.equal (h,e) then Some (s, so) else assoc_list_mem e t
+
+(** Given a tau, create a unique recursive variable name. This should always
+ return the same name for a given tau *)
+let fresh_recvar_name (t : tau) : string =
+ match find t with
+ Pair p -> "rvp" ^ string_of_int p.p_stamp
+ | Ref r -> "rvr" ^ string_of_int r.r_stamp
+ | Fun f -> "rvf" ^ string_of_int f.f_stamp
+ | _ -> die "fresh_recvar_name"
+
+
+(** Return a string representation of a tau, using association lists. *)
+let string_of_tau (t : tau) : string =
+ let tau_map : association list ref = ref [] in
+ let rec string_of_tau' t =
+ match assoc_list_mem t !tau_map with
+ Some (s, so) -> (* recursive type. see if a var name has been set *)
+ begin
+ match !so with
+ None ->
+ let rv = fresh_recvar_name t in
+ s := "u " ^ rv ^ "." ^ !s;
+ so := Some rv;
+ rv
+ | Some rv -> rv
+ end
+ | None -> (* type's not recursive. Add it to the assoc list and cont. *)
+ let s = ref ""
+ and so : string option ref = ref None in
+ tau_map := (t, s, so) :: !tau_map;
+ begin
+ match find t with
+ Var v -> s := v.v_name;
+ | Pair p ->
+ assert (ref_or_var p.ptr);
+ assert (fun_or_var p.lam);
+ s := "{";
+ s := !s ^ string_of_tau' p.ptr;
+ s := !s ^ ",";
+ s := !s ^ string_of_tau' p.lam;
+ s := !s ^"}"
+ | Ref r ->
+ assert (pair_or_var r.points_to);
+ s := "ref(|";
+ s := !s ^ string_of_label r.rl;
+ s := !s ^ "|,";
+ s := !s ^ string_of_tau' r.points_to;
+ s := !s ^ ")"
+ | Fun f ->
+ assert (pair_or_var f.ret);
+ let rec string_of_args = function
+ h :: [] ->
+ assert (pair_or_var h);
+ s := !s ^ string_of_tau' h
+ | h :: t ->
+ assert (pair_or_var h);
+ s := !s ^ string_of_tau' h ^ ",";
+ string_of_args t
+ | [] -> ()
+ in
+ s := "fun(|";
+ s := !s ^ string_of_label f.fl;
+ s := !s ^ "|,";
+ s := !s ^ "<";
+ if List.length f.args > 0 then string_of_args f.args
+ else s := !s ^ "void";
+ s := !s ^">,";
+ s := !s ^ string_of_tau' f.ret;
+ s := !s ^ ")"
+ end;
+ tau_map := List.tl !tau_map;
+ !s
+ in
+ string_of_tau' t
+
+(** Convert an lvalue to a string *)
+let rec string_of_lvalue (lv : lvalue) : string =
+ let contents = string_of_tau lv.contents
+ and l = string_of_label lv.l in
+ assert (pair_or_var lv.contents); (* do a consistency check *)
+ Printf.sprintf "[%s]^(%s)" contents l
+
+let print_path (p : lblinfo path) : unit =
+ let string_of_pkind = function
+ Positive -> "p"
+ | Negative -> "n"
+ | Match -> "m"
+ | Seed -> "s"
+ in
+ Printf.printf
+ "%s --%s--> %s (%d) : "
+ (string_of_label p.head)
+ (string_of_pkind p.kind)
+ (string_of_label p.tail)
+ (PathHash.hash p)
+
+(** Print a list of tau elements, comma separated *)
+let rec print_tau_list (l : tau list) : unit =
+ let rec print_t_strings = function
+ h :: [] -> print_endline h
+ | h :: t ->
+ print_string h;
+ print_string ", ";
+ print_t_strings t
+ | [] -> ()
+ in
+ print_t_strings (List.map string_of_tau l)
+
+let print_constraint (c : tconstraint) =
+ match c with
+ Unification (t, t') ->
+ let lhs = string_of_tau t
+ and rhs = string_of_tau t' in
+ Printf.printf "%s == %s\n" lhs rhs
+ | Leq (t, (i, p), t') ->
+ let lhs = string_of_tau t
+ and rhs = string_of_tau t' in
+ Printf.printf "%s <={%d,%s} %s\n" lhs i (string_of_polarity p) rhs
+
+(***********************************************************************)
+(* *)
+(* Type Operations -- these do not create any constraints *)
+(* *)
+(***********************************************************************)
+
+(** Create an lvalue with label [lbl] and tau contents [t]. *)
+let make_lval (lbl, t : label * tau) : lvalue =
+ {l = lbl; contents = t}
+
+let make_label_int (is_global : bool) (name :string) (vio : Cil.varinfo option) : label =
+ let locc =
+ match vio with
+ Some vi -> C.add (fresh_index (), name, vi) C.empty
+ | None -> C.empty
+ in
+ U.uref {
+ l_name = name;
+ l_global = is_global;
+ l_stamp = fresh_stamp ();
+ loc = locc;
+ aliases = locc;
+ p_ubounds = B.empty;
+ p_lbounds = B.empty;
+ n_ubounds = B.empty;
+ n_lbounds = B.empty;
+ m_ubounds = B.empty;
+ m_lbounds = B.empty;
+ m_upath = P.empty;
+ m_lpath = P.empty;
+ n_upath = P.empty;
+ n_lpath = P.empty;
+ p_upath = P.empty;
+ p_lpath = P.empty;
+ l_seeded = false;
+ l_ret = false;
+ l_param = false
+ }
+
+(** Create a new label with name [name]. Also adds a fresh constant
+ with name [name] to this label's aliases set. *)
+let make_label (is_global : bool) (name : string) (vio : Cil.varinfo option) : label =
+ make_label_int is_global name vio
+
+(** Create a new label with an unspecified name and an empty alias set. *)
+let fresh_label (is_global : bool) : label =
+ let index = fresh_index () in
+ make_label_int is_global ("l_" ^ string_of_int index) None
+
+(** Create a fresh bound (edge in the constraint graph). *)
+let make_bound (i, a : int * label) : lblinfo bound =
+ {index = i; info = a}
+
+let make_tau_bound (i, a : int * tau) : tinfo bound =
+ {index = i; info = a}
+
+(** Create a fresh named variable with name '[name]. *)
+let make_var (b: bool) (name : string) : tau =
+ U.uref (Var {v_name = ("'" ^ name);
+ v_hole = H.create 8;
+ v_stamp = fresh_index ();
+ v_global = b;
+ v_mlbs = B.empty;
+ v_mubs = B.empty;
+ v_plbs = B.empty;
+ v_pubs = B.empty;
+ v_nlbs = B.empty;
+ v_nubs = B.empty})
+
+(** Create a fresh unnamed variable (name will be 'fv). *)
+let fresh_var (is_global : bool) : tau =
+ make_var is_global ("fv" ^ string_of_int (fresh_index ()))
+
+(** Create a fresh unnamed variable (name will be 'fi). *)
+let fresh_var_i (is_global : bool) : tau =
+ make_var is_global ("fi" ^ string_of_int (fresh_index()))
+
+(** Create a Fun constructor. *)
+let make_fun (lbl, a, r : label * (tau list) * tau) : tau =
+ U.uref (Fun {fl = lbl;
+ f_stamp = fresh_index ();
+ f_global = false;
+ args = a;
+ ret = r })
+
+(** Create a Ref constructor. *)
+let make_ref (lbl,pt : label * tau) : tau =
+ U.uref (Ref {rl = lbl;
+ r_stamp = fresh_index ();
+ r_global = false;
+ points_to = pt})
+
+(** Create a Pair constructor. *)
+let make_pair (p,f : tau * tau) : tau =
+ U.uref (Pair {ptr = p;
+ p_stamp = fresh_index ();
+ p_global = false;
+ lam = f})
+
+(** Copy the toplevel constructor of [t], putting fresh variables in each
+ argement of the constructor. *)
+let copy_toplevel (t : tau) : tau =
+ match find t with
+ Pair _ -> make_pair (fresh_var_i false, fresh_var_i false)
+ | Ref _ -> make_ref (fresh_label false, fresh_var_i false)
+ | Fun f ->
+ let fresh_fn = fun _ -> fresh_var_i false in
+ make_fun (fresh_label false,
+ List.map fresh_fn f.args, fresh_var_i false)
+ | _ -> die "copy_toplevel"
+
+
+let has_same_structure (t : tau) (t' : tau) =
+ match find t, find t' with
+ Pair _, Pair _ -> true
+ | Ref _, Ref _ -> true
+ | Fun _, Fun _ -> true
+ | Var _, Var _ -> true
+ | _ -> false
+
+
+let pad_args (f, f' : finfo * finfo) : unit =
+ let padding = ref ((List.length f.args) - (List.length f'.args))
+ in
+ if !padding == 0 then ()
+ else
+ let to_pad =
+ if !padding > 0 then f' else (padding := -(!padding); f)
+ in
+ for i = 1 to !padding do
+ to_pad.args <- to_pad.args @ [fresh_var false]
+ done
+
+
+let pad_args2 (fi, tlr : finfo * tau list ref) : unit =
+ let padding = ref (List.length fi.args - List.length !tlr)
+ in
+ if !padding == 0 then ()
+ else
+ if !padding > 0 then
+ for i = 1 to !padding do
+ tlr := !tlr @ [fresh_var false]
+ done
+ else
+ begin
+ padding := -(!padding);
+ for i = 1 to !padding do
+ fi.args <- fi.args @ [fresh_var false]
+ done
+ end
+
+(***********************************************************************)
+(* *)
+(* Constraint Generation/ Resolution *)
+(* *)
+(***********************************************************************)
+
+
+(** Make the type a global type *)
+let set_global (t : tau) (b : bool) : unit =
+ let set_global_down t =
+ match find t with
+ Var v -> v.v_global <- true
+ | Ref r -> set_global_label r.rl true
+ | Fun f -> set_global_label f.fl true
+ | _ -> ()
+ in
+ if !debug && b then Printf.printf "Set global: %s\n" (string_of_tau t);
+ assert ((not (get_global t)) || b);
+ if b then iter_tau set_global_down t;
+ match find t with
+ Var v -> v.v_global <- b
+ | Ref r -> r.r_global <- b
+ | Pair p -> p.p_global <- b
+ | Fun f -> f.f_global <- b
+
+
+let rec unify_int (t, t' : tau * tau) : unit =
+ if equal_tau t t' then ()
+ else
+ let ti, ti' = find t, find t' in
+ U.unify combine (t, t');
+ match ti, ti' with
+ Var v, Var v' ->
+ set_global t' (v.v_global || get_global t');
+ merge_vholes (v, v');
+ merge_vlbs (v, v');
+ merge_vubs (v, v')
+ | Var v, _ ->
+ set_global t' (v.v_global || get_global t');
+ trigger_vhole v t';
+ notify_vlbs t v;
+ notify_vubs t v
+ | _, Var v ->
+ set_global t (v.v_global || get_global t);
+ trigger_vhole v t;
+ notify_vlbs t' v;
+ notify_vubs t' v
+ | Ref r, Ref r' ->
+ set_global t (r.r_global || r'.r_global);
+ unify_ref (r, r')
+ | Fun f, Fun f' ->
+ set_global t (f.f_global || f'.f_global);
+ unify_fun (f, f')
+ | Pair p, Pair p' -> ()
+ | _ -> raise Inconsistent
+and notify_vlbs (t : tau) (vi : vinfo) : unit =
+ let notify p bounds =
+ List.iter
+ (fun b ->
+ add_constraint (Unification (b.info,copy_toplevel t));
+ add_constraint (Leq (b.info, (b.index, p), t)))
+ bounds
+ in
+ notify Sub (B.elements vi.v_mlbs);
+ notify Pos (B.elements vi.v_plbs);
+ notify Neg (B.elements vi.v_nlbs)
+and notify_vubs (t : tau) (vi : vinfo) : unit =
+ let notify p bounds =
+ List.iter
+ (fun b ->
+ add_constraint (Unification (b.info,copy_toplevel t));
+ add_constraint (Leq (t, (b.index, p), b.info)))
+ bounds
+ in
+ notify Sub (B.elements vi.v_mubs);
+ notify Pos (B.elements vi.v_pubs);
+ notify Neg (B.elements vi.v_nubs)
+and unify_ref (ri,ri' : rinfo * rinfo) : unit =
+ add_constraint (Unification (ri.points_to, ri'.points_to))
+and unify_fun (fi, fi' : finfo * finfo) : unit =
+ let rec union_args = function
+ _, [] -> false
+ | [], _ -> true
+ | h :: t, h' :: t' ->
+ add_constraint (Unification (h, h'));
+ union_args(t, t')
+ in
+ unify_label(fi.fl, fi'.fl);
+ add_constraint (Unification (fi.ret, fi'.ret));
+ if union_args (fi.args, fi'.args) then fi.args <- fi'.args;
+and unify_label (l, l' : label * label) : unit =
+ let pick_name (li, li' : lblinfo * lblinfo) =
+ if String.length li.l_name > 1 && String.sub (li.l_name) 0 2 = "l_" then
+ li.l_name <- li'.l_name
+ else ()
+ in
+ let combine_label (li, li' : lblinfo *lblinfo) : lblinfo =
+ let rm_self b = not (li.l_stamp = get_label_stamp b.info)
+ in
+ pick_name (li, li');
+ li.l_global <- li.l_global || li'.l_global;
+ li.aliases <- C.union li.aliases li'.aliases;
+ li.p_ubounds <- B.union li.p_ubounds li'.p_ubounds;
+ li.p_lbounds <- B.union li.p_lbounds li'.p_lbounds;
+ li.n_ubounds <- B.union li.n_ubounds li'.n_ubounds;
+ li.n_lbounds <- B.union li.n_lbounds li'.n_lbounds;
+ li.m_ubounds <- B.union li.m_ubounds (B.filter rm_self li'.m_ubounds);
+ li.m_lbounds <- B.union li.m_lbounds (B.filter rm_self li'.m_lbounds);
+ li.m_upath <- P.union li.m_upath li'.m_upath;
+ li.m_lpath<- P.union li.m_lpath li'.m_lpath;
+ li.n_upath <- P.union li.n_upath li'.n_upath;
+ li.n_lpath <- P.union li.n_lpath li'.n_lpath;
+ li.p_upath <- P.union li.p_upath li'.p_upath;
+ li.p_lpath <- P.union li.p_lpath li'.p_lpath;
+ li.l_seeded <- li.l_seeded || li'.l_seeded;
+ li.l_ret <- li.l_ret || li'.l_ret;
+ li.l_param <- li.l_param || li'.l_param;
+ li
+ in
+ if !debug_constraints then
+ Printf.printf "%s == %s\n" (string_of_label l) (string_of_label l');
+ U.unify combine_label (l, l')
+and merge_vholes (vi, vi' : vinfo * vinfo) : unit =
+ H.iter
+ (fun i -> fun _ -> H.replace vi'.v_hole i ())
+ vi.v_hole
+and merge_vlbs (vi, vi' : vinfo * vinfo) : unit =
+ vi'.v_mlbs <- B.union vi.v_mlbs vi'.v_mlbs;
+ vi'.v_plbs <- B.union vi.v_plbs vi'.v_plbs;
+ vi'.v_nlbs <- B.union vi.v_nlbs vi'.v_nlbs
+and merge_vubs (vi, vi' : vinfo * vinfo) : unit =
+ vi'.v_mubs <- B.union vi.v_mubs vi'.v_mubs;
+ vi'.v_pubs <- B.union vi.v_pubs vi'.v_pubs;
+ vi'.v_nubs <- B.union vi.v_nubs vi'.v_nubs
+and trigger_vhole (vi : vinfo) (t : tau) =
+ let add_self_loops (t : tau) : unit =
+ match find t with
+ Var v ->
+ H.iter
+ (fun i -> fun _ -> H.replace v.v_hole i ())
+ vi.v_hole
+ | Ref r ->
+ H.iter
+ (fun i -> fun _ ->
+ leq_label (r.rl, (i, Pos), r.rl);
+ leq_label (r.rl, (i, Neg), r.rl))
+ vi.v_hole
+ | Fun f ->
+ H.iter
+ (fun i -> fun _ ->
+ leq_label (f.fl, (i, Pos), f.fl);
+ leq_label (f.fl, (i, Neg), f.fl))
+ vi.v_hole
+ | _ -> ()
+ in
+ iter_tau add_self_loops t
+(** Pick the representative info for two tinfo's. This function prefers the
+ first argument when both arguments are the same structure, but when
+ one type is a structure and the other is a var, it picks the structure.
+ All other actions (e.g., updating the info) is done in unify_int *)
+and combine (ti, ti' : tinfo * tinfo) : tinfo =
+ match ti, ti' with
+ Var _, _ -> ti'
+ | _, _ -> ti
+and leq_int (t, (i, p), t') : unit =
+ if equal_tau t t' then ()
+ else
+ let ti, ti' = find t, find t' in
+ match ti, ti' with
+ Var v, Var v' ->
+ begin
+ match p with
+ Pos ->
+ v.v_pubs <- B.add (make_tau_bound (i, t')) v.v_pubs;
+ v'.v_plbs <- B.add (make_tau_bound (i, t)) v'.v_plbs
+ | Neg ->
+ v.v_nubs <- B.add (make_tau_bound (i, t')) v.v_nubs;
+ v'.v_nlbs <- B.add (make_tau_bound (i, t)) v'.v_nlbs
+ | Sub ->
+ v.v_mubs <- B.add (make_tau_bound (i, t')) v.v_mubs;
+ v'.v_mlbs <- B.add (make_tau_bound (i, t)) v'.v_mlbs
+ end
+ | Var v, _ ->
+ add_constraint (Unification (t, copy_toplevel t'));
+ add_constraint (Leq (t, (i, p), t'))
+ | _, Var v ->
+ add_constraint (Unification (t', copy_toplevel t));
+ add_constraint (Leq (t, (i, p), t'))
+ | Ref r, Ref r' -> leq_ref (r, (i, p), r')
+ | Fun f, Fun f' -> add_constraint (Unification (t, t'))
+ | Pair pr, Pair pr' ->
+ add_constraint (Leq (pr.ptr, (i, p), pr'.ptr));
+ add_constraint (Leq (pr.lam, (i, p), pr'.lam))
+ | _ -> raise Inconsistent
+and leq_ref (ri, (i, p), ri') : unit =
+ let add_self_loops (t : tau) : unit =
+ match find t with
+ Var v -> H.replace v.v_hole i ()
+ | Ref r ->
+ leq_label (r.rl, (i, Pos), r.rl);
+ leq_label (r.rl, (i, Neg), r.rl)
+ | Fun f ->
+ leq_label (f.fl, (i, Pos), f.fl);
+ leq_label (f.fl, (i, Neg), f.fl)
+ | _ -> ()
+ in
+ iter_tau add_self_loops ri.points_to;
+ add_constraint (Unification (ri.points_to, ri'.points_to));
+ leq_label(ri.rl, (i, p), ri'.rl)
+and leq_label (l,(i, p), l') : unit =
+ if !debug_constraints then
+ Printf.printf
+ "%s <={%d,%s} %s\n"
+ (string_of_label l) i (string_of_polarity p) (string_of_label l');
+ let li, li' = find l, find l' in
+ match p with
+ Pos ->
+ li.l_ret <- true;
+ li.p_ubounds <- B.add (make_bound (i, l')) li.p_ubounds;
+ li'.p_lbounds <- B.add (make_bound (i, l)) li'.p_lbounds
+ | Neg ->
+ li'.l_param <- true;
+ li.n_ubounds <- B.add (make_bound (i, l')) li.n_ubounds;
+ li'.n_lbounds <- B.add (make_bound (i, l)) li'.n_lbounds
+ | Sub ->
+ if U.equal (l, l') then ()
+ else
+ begin
+ li.m_ubounds <- B.add (make_bound(0, l')) li.m_ubounds;
+ li'.m_lbounds <- B.add (make_bound(0, l)) li'.m_lbounds
+ end
+and add_constraint_int (c : tconstraint) (toplev : bool) =
+ if !debug_constraints && toplev then
+ begin
+ Printf.printf "%d:>" !toplev_count;
+ print_constraint c;
+ incr toplev_count
+ end
+ else
+ if !debug_constraints then print_constraint c else ();
+ begin
+ match c with
+ Unification _ -> Q.add c eq_worklist
+ | Leq _ -> Q.add c leq_worklist
+ end;
+ solve_constraints ()
+and add_constraint (c : tconstraint) =
+ add_constraint_int c false
+and add_toplev_constraint (c : tconstraint) =
+ if !print_constraints && not !debug_constraints then
+ begin
+ Printf.printf "%d:>" !toplev_count;
+ incr toplev_count;
+ print_constraint c
+ end
+ else ();
+ add_constraint_int c true
+and fetch_constraint () : tconstraint option =
+ try Some (Q.take eq_worklist)
+ with Q.Empty -> (try Some (Q.take leq_worklist)
+ with Q.Empty -> None)
+(** The main solver loop. *)
+and solve_constraints () : unit =
+ match fetch_constraint () with
+ Some c ->
+ begin
+ match c with
+ Unification (t, t') -> unify_int (t, t')
+ | Leq (t, (i, p), t') ->
+ if !no_sub then unify_int (t, t')
+ else
+ if !analyze_mono then leq_int (t, (0, Sub), t')
+ else leq_int (t, (i, p), t')
+ end;
+ solve_constraints ()
+ | None -> ()
+
+
+(***********************************************************************)
+(* *)
+(* Interface Functions *)
+(* *)
+(***********************************************************************)
+
+(** Return the contents of the lvalue. *)
+let rvalue (lv : lvalue) : tau =
+ lv.contents
+
+(** Dereference the rvalue. If it does not have enough structure to support
+ the operation, then the correct structure is added via new unification
+ constraints. *)
+let rec deref (t : tau) : lvalue =
+ match U.deref t with
+ Pair p ->
+ begin
+ match U.deref p.ptr with
+ Var _ ->
+ let is_global = global_tau p.ptr in
+ let points_to = fresh_var is_global in
+ let l = fresh_label is_global in
+ let r = make_ref (l, points_to)
+ in
+ add_toplev_constraint (Unification (p.ptr, r));
+ make_lval (l, points_to)
+ | Ref r -> make_lval (r.rl, r.points_to)
+ | _ -> raise WellFormed
+ end
+ | Var v ->
+ let is_global = global_tau t in
+ add_toplev_constraint
+ (Unification (t, make_pair (fresh_var is_global,
+ fresh_var is_global)));
+ deref t
+ | _ -> raise WellFormed
+
+(** Form the union of [t] and [t'], if it doesn't exist already. *)
+let join (t : tau) (t' : tau) : tau =
+ try H.find join_cache (get_stamp t, get_stamp t')
+ with Not_found ->
+ let t'' = fresh_var false in
+ add_toplev_constraint (Leq (t, (0, Sub), t''));
+ add_toplev_constraint (Leq (t', (0, Sub), t''));
+ H.add join_cache (get_stamp t, get_stamp t') t'';
+ t''
+
+(** Form the union of a list [tl], expected to be the initializers of some
+ structure or array type. *)
+let join_inits (tl : tau list) : tau =
+ let t' = fresh_var false in
+ List.iter
+ (fun t -> add_toplev_constraint (Leq (t, (0, Sub), t')))
+ tl;
+ t'
+
+(** Take the address of an lvalue. Does not add constraints. *)
+let address (lv : lvalue) : tau =
+ make_pair (make_ref (lv.l, lv.contents), fresh_var false)
+
+(** For this version of golf, instantiation is handled at [apply] *)
+let instantiate (lv : lvalue) (i : int) : lvalue =
+ lv
+
+(** Constraint generated from assigning [t] to [lv]. *)
+let assign (lv : lvalue) (t : tau) : unit =
+ add_toplev_constraint (Leq (t, (0, Sub), lv.contents))
+
+let assign_ret (i : int) (lv : lvalue) (t : tau) : unit =
+ add_toplev_constraint (Leq (t, (i, Pos), lv.contents))
+
+(** Project out the first (ref) component or a pair. If the argument [t] has
+ no discovered structure, raise NoContents. *)
+let proj_ref (t : tau) : tau =
+ match U.deref t with
+ Pair p -> p.ptr
+ | Var v -> raise NoContents
+ | _ -> raise WellFormed
+
+(* Project out the second (fun) component of a pair. If the argument [t] has
+ no discovered structure, create it on the fly by adding constraints. *)
+let proj_fun (t : tau) : tau =
+ match U.deref t with
+ Pair p -> p.lam
+ | Var v ->
+ let p, f = fresh_var false, fresh_var false in
+ add_toplev_constraint (Unification (t, make_pair(p, f)));
+ f
+ | _ -> raise WellFormed
+
+let get_args (t : tau) : tau list =
+ match U.deref t with
+ Fun f -> f.args
+ | _ -> raise WellFormed
+
+let get_finfo (t : tau) : finfo =
+ match U.deref t with
+ Fun f -> f
+ | _ -> raise WellFormed
+
+(** Function type [t] is applied to the arguments [actuals]. Unifies the
+ actuals with the formals of [t]. If no functions have been discovered for
+ [t] yet, create a fresh one and unify it with t. The result is the return
+ value of the function plus the index of this application site. *)
+let apply (t : tau) (al : tau list) : (tau * int) =
+ let i = fresh_appsite () in
+ let f = proj_fun t in
+ let actuals = ref al in
+ let fi,ret =
+ match U.deref f with
+ Fun fi -> fi, fi.ret
+ | Var v ->
+ let new_l, new_ret, new_args =
+ fresh_label false, fresh_var false,
+ List.map (function _ -> fresh_var false) !actuals
+ in
+ let new_fun = make_fun (new_l, new_args, new_ret) in
+ add_toplev_constraint (Unification (new_fun, f));
+ (get_finfo new_fun, new_ret)
+ | _ -> raise WellFormed
+ in
+ pad_args2 (fi, actuals);
+ List.iter2
+ (fun actual -> fun formal ->
+ add_toplev_constraint (Leq (actual,(i, Neg), formal)))
+ !actuals fi.args;
+ (ret, i)
+
+(** Create a new function type with name [name], list of formal arguments
+ [formals], and return value [ret]. Adds no constraints. *)
+let make_function (name : string) (formals : lvalue list) (ret : tau) : tau =
+ let f = make_fun (make_label false name None,
+ List.map (fun x -> rvalue x) formals,
+ ret)
+ in
+ make_pair (fresh_var false, f)
+
+(** Create an lvalue. If [is_global] is true, the lvalue will be treated
+ monomorphically. *)
+let make_lvalue (is_global : bool) (name : string) (vio : Cil.varinfo option) : lvalue =
+ if !debug && is_global then
+ Printf.printf "Making global lvalue : %s\n" name
+ else ();
+ make_lval (make_label is_global name vio, make_var is_global name)
+
+(** Create a fresh non-global named variable. *)
+let make_fresh (name : string) : tau =
+ make_var false name
+
+(** The default type for constants. *)
+let bottom () : tau =
+ make_var false "bottom"
+
+(** Unify the result of a function with its return value. *)
+let return (t : tau) (t' : tau) =
+ add_toplev_constraint (Leq (t', (0, Sub), t))
+
+(***********************************************************************)
+(* *)
+(* Query/Extract Solutions *)
+(* *)
+(***********************************************************************)
+
+let make_summary = leq_label
+
+let path_signature k l l' b : int list =
+ let ksig =
+ match k with
+ Positive -> 1
+ | Negative -> 2
+ | _ -> 3
+ in
+ [ksig;
+ get_label_stamp l;
+ get_label_stamp l';
+ if b then 1 else 0]
+
+let make_path (k, l, l', b) =
+ let psig = path_signature k l l' b in
+ if PH.mem path_hash psig then ()
+ else
+ let new_path = {kind = k; head = l; tail = l'; reached_global = b}
+ and li, li' = find l, find l' in
+ PH.add path_hash psig new_path;
+ Q.add new_path path_worklist;
+ begin
+ match k with
+ Positive ->
+ li.p_upath <- P.add new_path li.p_upath;
+ li'.p_lpath <- P.add new_path li'.p_lpath
+ | Negative ->
+ li.n_upath <- P.add new_path li.n_upath;
+ li'.n_lpath <- P.add new_path li'.n_lpath
+ | _ ->
+ li.m_upath <- P.add new_path li.m_upath;
+ li'.m_lpath <- P.add new_path li'.m_lpath
+ end;
+ if !debug then
+ begin
+ print_string "Discovered path : ";
+ print_path new_path;
+ print_newline ()
+ end
+
+let backwards_tabulate (l : label) : unit =
+ let rec loop () =
+ let rule1 p =
+ if !debug then print_endline "rule1";
+ B.iter
+ (fun lb ->
+ make_path (Match, lb.info, p.tail,
+ p.reached_global || is_global_label p.head))
+ (find p.head).m_lbounds
+ and rule2 p =
+ if !debug then print_endline "rule2";
+ B.iter
+ (fun lb ->
+ make_path (Negative, lb.info, p.tail,
+ p.reached_global || is_global_label p.head))
+ (find p.head).n_lbounds
+ and rule2m p =
+ if !debug then print_endline "rule2m";
+ B.iter
+ (fun lb ->
+ make_path (Match, lb.info, p.tail,
+ p.reached_global || is_global_label p.head))
+ (find p.head).n_lbounds
+ and rule3 p =
+ if !debug then print_endline "rule3";
+ B.iter
+ (fun lb ->
+ make_path (Positive, lb.info, p.tail,
+ p.reached_global || is_global_label p.head))
+ (find p.head).p_lbounds
+ and rule4 p =
+ if !debug then print_endline "rule4";
+ B.iter
+ (fun lb ->
+ make_path(Negative, lb.info, p.tail,
+ p.reached_global || is_global_label p.head))
+ (find p.head).m_lbounds
+ and rule5 p =
+ if !debug then print_endline "rule5";
+ B.iter
+ (fun lb ->
+ make_path (Positive, lb.info, p.tail,
+ p.reached_global || is_global_label p.head))
+ (find p.head).m_lbounds
+ and rule6 p =
+ if !debug then print_endline "rule6";
+ B.iter
+ (fun lb ->
+ if is_seeded_label lb.info then ()
+ else
+ begin
+ (find lb.info).l_seeded <- true; (* set seeded *)
+ make_path (Seed, lb.info, lb.info,
+ is_global_label lb.info)
+ end)
+ (find p.head).p_lbounds
+ and rule7 p =
+ if !debug then print_endline "rule7";
+ if not (is_ret_label p.tail && is_param_label p.head) then ()
+ else
+ B.iter
+ (fun lb ->
+ B.iter
+ (fun ub ->
+ if lb.index = ub.index then
+ begin
+ if !debug then
+ Printf.printf "New summary : %s %s\n"
+ (string_of_label lb.info)
+ (string_of_label ub.info);
+ make_summary (lb.info, (0, Sub), ub.info);
+ (* rules 1, 4, and 5 *)
+ P.iter
+ (fun ubp -> (* rule 1 *)
+ make_path (Match, lb.info, ubp.tail,
+ ubp.reached_global))
+ (find ub.info).m_upath;
+ P.iter
+ (fun ubp -> (* rule 4 *)
+ make_path (Negative, lb.info, ubp.tail,
+ ubp.reached_global))
+ (find ub.info).n_upath;
+ P.iter
+ (fun ubp -> (* rule 5 *)
+ make_path (Positive, lb.info, ubp.tail,
+ ubp.reached_global))
+ (find ub.info).p_upath
+ end)
+ (find p.tail).p_ubounds)
+ (find p.head).n_lbounds
+ in
+ let matched_backward_rules p =
+ rule1 p;
+ if p.reached_global then rule2m p else rule2 p;
+ rule3 p;
+ rule6 p;
+ rule7 p
+ and negative_backward_rules p =
+ rule2 p;
+ rule3 p;
+ rule4 p;
+ rule6 p;
+ rule7 p
+ and positive_backward_rules p =
+ rule3 p;
+ rule5 p;
+ rule6 p;
+ rule7 p
+ in (* loop *)
+ if Q.is_empty path_worklist then ()
+ else
+ let p = Q.take path_worklist in
+ if !debug then
+ begin
+ print_string "Processing path: ";
+ print_path p;
+ print_newline ()
+ end;
+ begin
+ match p.kind with
+ Positive ->
+ if is_global_label p.tail then matched_backward_rules p
+ else positive_backward_rules p
+ | Negative -> negative_backward_rules p
+ | _ -> matched_backward_rules p
+ end;
+ loop ()
+ in (* backwards_tabulate *)
+ if !debug then
+ begin
+ Printf.printf "Tabulating for %s..." (string_of_label l);
+ if is_global_label l then print_string "(global)";
+ print_newline ()
+ end;
+ make_path (Seed, l, l, is_global_label l);
+ loop ()
+
+let collect_ptsets (l : label) : constantset = (* todo -- cache aliases *)
+ let li = find l
+ and collect init s =
+ P.fold (fun x a -> C.union a (find x.head).aliases) s init
+ in
+ backwards_tabulate l;
+ collect (collect (collect li.aliases li.m_lpath) li.n_lpath) li.p_lpath
+
+let extract_ptlabel (lv : lvalue) : label option =
+ try
+ match find (proj_ref lv.contents) with
+ Var v -> None
+ | Ref r -> Some r.rl;
+ | _ -> raise WellFormed
+ with NoContents -> None
+
+let points_to_aux (t : tau) : constant list =
+ try
+ match find (proj_ref t) with
+ Var v -> []
+ | Ref r -> C.elements (collect_ptsets r.rl)
+ | _ -> raise WellFormed
+ with NoContents -> []
+
+let points_to_names (lv : lvalue) : string list =
+ List.map (fun (_, str, _) -> str) (points_to_aux lv.contents)
+
+let points_to (lv : lvalue) : Cil.varinfo list =
+ let rec get_vinfos l : Cil.varinfo list = match l with
+ | (_, _, h) :: t -> h :: get_vinfos t
+ | [] -> []
+ in
+ get_vinfos (points_to_aux lv.contents)
+
+let epoints_to (t : tau) : Cil.varinfo list =
+ let rec get_vinfos l : Cil.varinfo list = match l with
+ | (_, _, h) :: t -> h :: get_vinfos t
+ | [] -> []
+ in
+ get_vinfos (points_to_aux t)
+
+let smart_alias_query (l : label) (l' : label) : bool =
+ (* Set of dead configurations *)
+ let dead_configs : config_map = CH.create 16 in
+ (* the set of discovered configurations *)
+ let discovered : config_map = CH.create 16 in
+ let rec filter_match (i : int) =
+ B.filter (fun (b : lblinfo bound) -> i = b.index)
+ in
+ let rec simulate c l l' =
+ let config = (c, get_label_stamp l, get_label_stamp l') in
+ if U.equal (l, l') then
+ begin
+ if !debug then
+ Printf.printf
+ "%s and %s are aliased\n"
+ (string_of_label l)
+ (string_of_label l');
+ raise APFound
+ end
+ else if CH.mem discovered config then ()
+ else
+ begin
+ if !debug_aliases then
+ Printf.printf
+ "Exploring configuration %s\n"
+ (string_of_configuration config);
+ CH.add discovered config ();
+ B.iter
+ (fun lb -> simulate c lb.info l')
+ (get_bounds Sub false l); (* epsilon closure of l *)
+ B.iter
+ (fun lb -> simulate c l lb.info)
+ (get_bounds Sub false l'); (* epsilon closure of l' *)
+ B.iter
+ (fun lb ->
+ let matching =
+ filter_match lb.index (get_bounds Pos false l')
+ in
+ B.iter
+ (fun b -> simulate Closed lb.info b.info)
+ matching;
+ if is_global_label l' then (* positive self-loops on l' *)
+ simulate Closed lb.info l')
+ (get_bounds Pos false l); (* positive transitions on l *)
+ if is_global_label l then
+ B.iter
+ (fun lb -> simulate Closed l lb.info)
+ (get_bounds Pos false l'); (* positive self-loops on l *)
+ begin
+ match c with (* negative transitions on l, only if Open *)
+ Open ->
+ B.iter
+ (fun lb ->
+ let matching =
+ filter_match lb.index (get_bounds Neg false l')
+ in
+ B.iter
+ (fun b -> simulate Open lb.info b.info)
+ matching ;
+ if is_global_label l' then (* neg self-loops on l' *)
+ simulate Open lb.info l')
+ (get_bounds Neg false l);
+ if is_global_label l then
+ B.iter
+ (fun lb -> simulate Open l lb.info)
+ (get_bounds Neg false l') (* negative self-loops on l *)
+ | _ -> ()
+ end;
+ (* if we got this far, then the configuration was not used *)
+ CH.add dead_configs config ();
+ end
+ in
+ try
+ begin
+ if H.mem cached_aliases (get_label_stamp l, get_label_stamp l') then
+ true
+ else
+ begin
+ simulate Open l l';
+ if !debug then
+ Printf.printf
+ "%s and %s are NOT aliased\n"
+ (string_of_label l)
+ (string_of_label l');
+ false
+ end
+ end
+ with APFound ->
+ CH.iter
+ (fun config -> fun _ ->
+ if not (CH.mem dead_configs config) then
+ H.add
+ cached_aliases
+ (get_label_stamp l, get_label_stamp l')
+ ())
+ discovered;
+ true
+
+(** todo : uses naive alias query for now *)
+let may_alias (t1 : tau) (t2 : tau) : bool =
+ try
+ let l1 =
+ match find (proj_ref t1) with
+ Ref r -> r.rl
+ | Var v -> raise NoContents
+ | _ -> raise WellFormed
+ and l2 =
+ match find (proj_ref t2) with
+ Ref r -> r.rl
+ | Var v -> raise NoContents
+ | _ -> raise WellFormed
+ in
+ not (C.is_empty (C.inter (collect_ptsets l1) (collect_ptsets l2)))
+ with NoContents -> false
+
+let alias_query (b : bool) (lvl : lvalue list) : int * int =
+ let naive_count = ref 0 in
+ let smart_count = ref 0 in
+ let lbls = List.map extract_ptlabel lvl in (* label option list *)
+ let ptsets =
+ List.map
+ (function
+ Some l -> collect_ptsets l
+ | None -> C.empty)
+ lbls in
+ let record_alias s lo s' lo' =
+ match lo, lo' with
+ Some l, Some l' ->
+ if !debug_aliases then
+ Printf.printf
+ "Checking whether %s and %s are aliased...\n"
+ (string_of_label l)
+ (string_of_label l');
+ if C.is_empty (C.inter s s') then ()
+ else
+ begin
+ incr naive_count;
+ if !smart_aliases && smart_alias_query l l' then
+ incr smart_count
+ end
+ | _ -> ()
+ in
+ let rec check_alias sets labels =
+ match sets,labels with
+ s :: st, l :: lt ->
+ List.iter2 (record_alias s l) ptsets lbls;
+ check_alias st lt
+ | [], [] -> ()
+ | _ -> die "check_alias"
+ in
+ check_alias ptsets lbls;
+ (!naive_count, !smart_count)
+
+let alias_frequency (lvl : (lvalue * bool) list) : int * int =
+ let extract_lbl (lv, b : lvalue * bool) = (lv.l, b) in
+ let naive_count = ref 0 in
+ let smart_count = ref 0 in
+ let lbls = List.map extract_lbl lvl in
+ let ptsets =
+ List.map
+ (fun (lbl, b) ->
+ if b then (find lbl).loc (* symbol access *)
+ else collect_ptsets lbl)
+ lbls in
+ let record_alias s (l, b) s' (l', b') =
+ if !debug_aliases then
+ Printf.printf
+ "Checking whether %s and %s are aliased...\n"
+ (string_of_label l)
+ (string_of_label l');
+ if C.is_empty (C.inter s s') then ()
+ else
+ begin
+ if !debug_aliases then
+ Printf.printf
+ "%s and %s are aliased naively...\n"
+ (string_of_label l)
+ (string_of_label l');
+ incr naive_count;
+ if !smart_aliases then
+ if b || b' || smart_alias_query l l' then incr smart_count
+ else
+ Printf.printf
+ "%s and %s are not aliased by smart queries...\n"
+ (string_of_label l)
+ (string_of_label l');
+ end
+ in
+ let rec check_alias sets labels =
+ match sets, labels with
+ s :: st, l :: lt ->
+ List.iter2 (record_alias s l) ptsets lbls;
+ check_alias st lt
+ | [], [] -> ()
+ | _ -> die "check_alias"
+ in
+ check_alias ptsets lbls;
+ (!naive_count, !smart_count)
+
+
+(** an interface for extracting abstract locations from this analysis *)
+
+type absloc = label
+
+let absloc_of_lvalue (l : lvalue) : absloc = l.l
+let absloc_eq (a1, a2) = smart_alias_query a1 a2
+let absloc_print_name = ref true
+let d_absloc () (p : absloc) =
+ let a = find p in
+ if !absloc_print_name then Pretty.dprintf "%s" a.l_name
+ else Pretty.dprintf "%d" a.l_stamp
+
+let phonyAddrOf (lv : lvalue) : lvalue =
+ make_lval (fresh_label true, address lv)
+
+(* transitive closure of points to, starting from l *)
+let rec tauPointsTo (l : tau) : absloc list =
+ match find l with
+ Var _ -> []
+ | Ref r -> r.rl :: tauPointsTo r.points_to
+ | _ -> []
+
+let rec absloc_points_to (l : lvalue) : absloc list =
+ tauPointsTo l.contents
+
+
+(** The following definitions are only introduced for the
+ compatability with Olf. *)
+
+exception UnknownLocation
+
+let finished_constraints () = ()
+let apply_undefined (_ : tau list) = (fresh_var true, 0)
+let assign_undefined (_ : lvalue) = ()
+
+let absloc_epoints_to = tauPointsTo
diff --git a/cil/src/ext/pta/golf.mli b/cil/src/ext/pta/golf.mli
new file mode 100644
index 0000000..569855c
--- /dev/null
+++ b/cil/src/ext/pta/golf.mli
@@ -0,0 +1,83 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+type lvalue
+type tau
+type absloc
+
+(* only for compatability with Olf *)
+exception UnknownLocation
+
+val debug : bool ref
+val debug_constraints : bool ref
+val debug_aliases : bool ref
+val smart_aliases : bool ref
+val finished_constraints : unit -> unit (* only for compatability with Olf *)
+val print_constraints : bool ref
+val no_flow : bool ref
+val no_sub : bool ref
+val analyze_mono : bool ref
+val solve_constraints : unit -> unit
+val rvalue : lvalue -> tau
+val deref : tau -> lvalue
+val join : tau -> tau -> tau
+val join_inits : tau list -> tau
+val address : lvalue -> tau
+val instantiate : lvalue -> int -> lvalue
+val assign : lvalue -> tau -> unit
+val assign_ret : int -> lvalue -> tau -> unit
+val apply : tau -> tau list -> (tau * int)
+val apply_undefined : tau list -> (tau * int) (* only for compatability with Olf *)
+val assign_undefined : lvalue -> unit (* only for compatability with Olf *)
+val make_function : string -> lvalue list -> tau -> tau
+val make_lvalue : bool -> string -> (Cil.varinfo option) -> lvalue
+val bottom : unit -> tau
+val return : tau -> tau -> unit
+val make_fresh : string -> tau
+val points_to_names : lvalue -> string list
+val points_to : lvalue -> Cil.varinfo list
+val epoints_to : tau -> Cil.varinfo list
+val string_of_lvalue : lvalue -> string
+val global_lvalue : lvalue -> bool
+val alias_query : bool -> lvalue list -> int * int
+val alias_frequency : (lvalue * bool) list -> int * int
+
+val may_alias : tau -> tau -> bool
+
+val absloc_points_to : lvalue -> absloc list
+val absloc_epoints_to : tau -> absloc list
+val absloc_of_lvalue : lvalue -> absloc
+val absloc_eq : (absloc * absloc) -> bool
+val d_absloc : unit -> absloc -> Pretty.doc
+val phonyAddrOf : lvalue -> lvalue
diff --git a/cil/src/ext/pta/olf.ml b/cil/src/ext/pta/olf.ml
new file mode 100644
index 0000000..0d77002
--- /dev/null
+++ b/cil/src/ext/pta/olf.ml
@@ -0,0 +1,1108 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(***********************************************************************)
+(* *)
+(* Exceptions *)
+(* *)
+(***********************************************************************)
+
+exception Inconsistent (* raised if constraint system is inconsistent *)
+exception WellFormed (* raised if types are not well-formed *)
+exception NoContents
+exception APFound (* raised if an alias pair is found, a control
+ flow exception *)
+exception ReachedTop (* raised if top (from an undefined function)
+ flows to a c_absloc during the flow step *)
+exception UnknownLocation
+
+let solve_constraints () = () (* only for compatability with Golf *)
+
+open Cil
+
+module U = Uref
+module S = Setp
+module H = Hashtbl
+module Q = Queue
+
+(** Generic bounds *)
+type 'a bound = {info : 'a U.uref}
+
+module Bound =
+struct
+ type 'a t = 'a bound
+ let compare (x : 'a t) (y : 'a t) =
+ Pervasives.compare (U.deref x.info) (U.deref y.info)
+end
+
+module B = S.Make (Bound)
+
+type 'a boundset = 'a B.t
+
+(** Abslocs, which identify elements in points-to sets *)
+(** jk : I'd prefer to make this an 'a absloc and specialize it to
+ varinfo for use with the Cil frontend, but for now, this will do *)
+type absloc = int * string * Cil.varinfo option
+
+module Absloc =
+struct
+ type t = absloc
+ let compare (xid, _, _) (yid, _, _) = xid - yid
+end
+
+module C = Set.Make (Absloc)
+
+(** Sets of abslocs. Set union is used when two c_abslocs containing
+ absloc sets are unified *)
+type abslocset = C.t
+
+let d_absloc () (a: absloc) : Pretty.doc =
+ let i,s,_ = a in
+ Pretty.dprintf "<%d, %s>" i s
+
+type c_abslocinfo = {
+ mutable l_name: string; (** name of the location *)
+ loc : absloc;
+ l_stamp : int;
+ mutable l_top : bool;
+ mutable aliases : abslocset;
+ mutable lbounds : c_abslocinfo boundset;
+ mutable ubounds : c_abslocinfo boundset;
+ mutable flow_computed : bool
+}
+and c_absloc = c_abslocinfo U.uref
+
+(** The type of lvalues. *)
+type lvalue = {
+ l: c_absloc;
+ contents: tau
+}
+and vinfo = {
+ v_stamp : int;
+ v_name : string;
+ mutable v_top : bool;
+ mutable v_lbounds : tinfo boundset;
+ mutable v_ubounds : tinfo boundset
+}
+and rinfo = {
+ r_stamp : int;
+ rl : c_absloc;
+ points_to : tau
+}
+and finfo = {
+ f_stamp : int;
+ fl : c_absloc;
+ ret : tau;
+ mutable args : tau list
+}
+and pinfo = {
+ p_stamp : int;
+ ptr : tau;
+ lam : tau
+}
+and tinfo =
+ Var of vinfo
+ | Ref of rinfo
+ | Fun of finfo
+ | Pair of pinfo
+and tau = tinfo U.uref
+
+type tconstraint =
+ Unification of tau * tau
+ | Leq of tau * tau
+
+(** Association lists, used for printing recursive types. The first
+ element is a type that has been visited. The second element is the
+ string representation of that type (so far). If the string option is
+ set, then this type occurs within itself, and is associated with the
+ recursive var name stored in the option. When walking a type, add it
+ to an association list.
+
+ Example: suppose we have the constraint 'a = ref('a). The type is
+ unified via cyclic unification, and would loop infinitely if we
+ attempted to print it. What we want to do is print the type u
+ rv. ref(rv). This is accomplished in the following manner:
+
+ -- ref('a) is visited. It is not in the association list, so it is
+ added and the string "ref(" is stored in the second element. We
+ recurse to print the first argument of the constructor.
+
+ -- In the recursive call, we see that 'a (or ref('a)) is already
+ in the association list, so the type is recursive. We check the
+ string option, which is None, meaning that this is the first
+ recurrence of the type. We create a new recursive variable, rv and
+ set the string option to 'rv. Next, we prepend u rv. to the string
+ representation we have seen before, "ref(", and return "rv" as the
+ string representation of this type.
+
+ -- The string so far is "u rv.ref(". The recursive call returns,
+ and we complete the type by printing the result of the call, "rv",
+ and ")"
+
+ In a type where the recursive variable appears twice, e.g. 'a =
+ pair('a,'a), the second time we hit 'a, the string option will be
+ set, so we know to reuse the same recursive variable name.
+*)
+type association = tau * string ref * string option ref
+
+(** The current state of the solver engine either adding more
+ constraints, or finished adding constraints and querying graph *)
+type state =
+ AddingConstraints
+ | FinishedConstraints
+
+(***********************************************************************)
+(* *)
+(* Global Variables *)
+(* *)
+(***********************************************************************)
+
+(** A count of the constraints introduced from the AST. Used for
+ debugging. *)
+let toplev_count = ref 0
+
+let solver_state : state ref = ref AddingConstraints
+
+(** Print the instantiations constraints. *)
+let print_constraints : bool ref = ref false
+
+(** If true, print all constraints (including induced) and show
+ additional debug output. *)
+let debug = ref false
+
+(** Just debug all the constraints (including induced) *)
+let debug_constraints = ref false
+
+(** Debug the flow step *)
+let debug_flow_step = ref false
+
+(** Compatibility with GOLF *)
+let debug_aliases = ref false
+let smart_aliases = ref false
+let no_flow = ref false
+let analyze_mono = ref false
+
+(** If true, disable subtyping (unification at all levels) *)
+let no_sub = ref false
+
+(** A list of equality constraints. *)
+let eq_worklist : tconstraint Q.t = Q.create ()
+
+(** A list of leq constraints. *)
+let leq_worklist : tconstraint Q.t = Q.create ()
+
+(** A hashtable containing stamp pairs of c_abslocs that must be aliased. *)
+let cached_aliases : (int * int, unit) H.t = H.create 64
+
+(** A hashtable mapping pairs of tau's to their join node. *)
+let join_cache : (int * int, tau) H.t = H.create 64
+
+(** *)
+let label_prefix = "l_"
+
+
+(***********************************************************************)
+(* *)
+(* Utility Functions *)
+(* *)
+(***********************************************************************)
+
+let starts_with s p =
+ let n = String.length p in
+ if String.length s < n then false
+ else String.sub s 0 n = p
+
+
+let die s =
+ Printf.printf "*******\nAssertion failed: %s\n*******\n" s;
+ assert false
+
+let insist b s =
+ if not b then die s else ()
+
+
+let can_add_constraints () =
+ !solver_state = AddingConstraints
+
+let can_query_graph () =
+ !solver_state = FinishedConstraints
+
+let finished_constraints () =
+ insist (!solver_state = AddingConstraints) "inconsistent states";
+ solver_state := FinishedConstraints
+
+let find = U.deref
+
+(** return the prefix of the list up to and including the first
+ element satisfying p. if no element satisfies p, return the empty
+ list *)
+let rec keep_until p l =
+ match l with
+ [] -> []
+ | x :: xs -> if p x then [x] else x :: keep_until p xs
+
+
+(** Generate a unique integer. *)
+let fresh_index : (unit -> int) =
+ let counter = ref 0 in
+ fun () ->
+ incr counter;
+ !counter
+
+let fresh_stamp : (unit -> int) =
+ let stamp = ref 0 in
+ fun () ->
+ incr stamp;
+ !stamp
+
+(** Return a unique integer representation of a tau *)
+let get_stamp (t : tau) : int =
+ match find t with
+ Var v -> v.v_stamp
+ | Ref r -> r.r_stamp
+ | Pair p -> p.p_stamp
+ | Fun f -> f.f_stamp
+
+(** Consistency checks for inferred types *)
+let pair_or_var (t : tau) =
+ match find t with
+ Pair _ -> true
+ | Var _ -> true
+ | _ -> false
+
+let ref_or_var (t : tau) =
+ match find t with
+ Ref _ -> true
+ | Var _ -> true
+ | _ -> false
+
+let fun_or_var (t : tau) =
+ match find t with
+ Fun _ -> true
+ | Var _ -> true
+ | _ -> false
+
+
+(** Apply [f] structurally down [t]. Guaranteed to terminate, even if [t]
+ is recursive *)
+let iter_tau f t =
+ let visited : (int, tau) H.t = H.create 4 in
+ let rec iter_tau' t =
+ if H.mem visited (get_stamp t) then () else
+ begin
+ f t;
+ H.add visited (get_stamp t) t;
+ match find t with
+ Pair p ->
+ iter_tau' p.ptr;
+ iter_tau' p.lam
+ | Fun f ->
+ List.iter iter_tau' f.args;
+ iter_tau' f.ret;
+ | Ref r -> iter_tau' r.points_to
+ | _ -> ()
+ end
+ in
+ iter_tau' t
+
+let equal_absloc = function
+ (i, _, _), (i', _, _) -> i = i'
+
+let equal_c_absloc l l' =
+ (find l).l_stamp = (find l').l_stamp
+
+let equal_tau (t : tau) (t' : tau) =
+ get_stamp t = get_stamp t'
+
+let top_c_absloc l =
+ (find l).l_top
+
+let get_flow_computed l =
+ (find l).flow_computed
+
+let set_flow_computed l =
+ (find l).flow_computed <- true
+
+let rec top_tau (t : tau) =
+ match find t with
+ Pair p -> top_tau p.ptr || top_tau p.lam
+ | Ref r -> top_c_absloc r.rl
+ | Fun f -> top_c_absloc f.fl
+ | Var v -> v.v_top
+
+let get_c_absloc_stamp (l : c_absloc) : int =
+ (find l).l_stamp
+
+let set_top_c_absloc (l : c_absloc) (b: bool) : unit =
+ (find l).l_top <- b
+
+let get_aliases (l : c_absloc) =
+ if top_c_absloc l then raise ReachedTop
+ else (find l).aliases
+
+(***********************************************************************)
+(* *)
+(* Printing Functions *)
+(* *)
+(***********************************************************************)
+
+(** Convert a c_absloc to a string, short representation *)
+let string_of_c_absloc (l : c_absloc) : string =
+ "\"" ^
+ (find l).l_name ^
+ if top_c_absloc l then "(top)" else "" ^
+ "\""
+
+(** Return true if the element [e] is present in the association list,
+ according to uref equality *)
+let rec assoc_list_mem (e : tau) (l : association list) =
+ match l with
+ [] -> None
+ | (h, s, so) :: t ->
+ if U.equal (h, e) then Some (s, so)
+ else assoc_list_mem e t
+
+(** Given a tau, create a unique recursive variable name. This should
+ always return the same name for a given tau *)
+let fresh_recvar_name (t : tau) : string =
+ match find t with
+ Pair p -> "rvp" ^ string_of_int p.p_stamp
+ | Ref r -> "rvr" ^ string_of_int r.r_stamp
+ | Fun f -> "rvf" ^ string_of_int f.f_stamp
+ | _ -> die "fresh_recvar_name"
+
+
+(** Return a string representation of a tau, using association lists. *)
+let string_of_tau (t : tau) : string =
+ let tau_map : association list ref = ref [] in
+ let rec string_of_tau' t =
+ match assoc_list_mem t !tau_map with
+ Some (s, so) -> (* recursive type. see if a var name has been set *)
+ begin
+ match !so with
+ None ->
+ let rv = fresh_recvar_name t in
+ s := "u " ^ rv ^ "." ^ !s;
+ so := Some rv;
+ rv
+ | Some rv -> rv
+ end
+ | None -> (* type's not recursive. Add it to the assoc list and cont. *)
+ let s = ref ""
+ and so : string option ref = ref None in
+ tau_map := (t, s, so) :: !tau_map;
+ begin
+ match find t with
+ Var v -> s := v.v_name
+ | Pair p ->
+ insist (ref_or_var p.ptr) "wellformed";
+ insist (fun_or_var p.lam) "wellformed";
+ s := "{";
+ s := !s ^ string_of_tau' p.ptr;
+ s := !s ^ ",";
+ s := !s ^ string_of_tau' p.lam;
+ s := !s ^ "}"
+ | Ref r ->
+ insist (pair_or_var r.points_to) "wellformed";
+ s := "ref(|";
+ s := !s ^ string_of_c_absloc r.rl;
+ s := !s ^ "|,";
+ s := !s ^ string_of_tau' r.points_to;
+ s := !s ^ ")"
+ | Fun f ->
+ let rec string_of_args = function
+ [] -> ()
+ | h :: [] ->
+ insist (pair_or_var h) "wellformed";
+ s := !s ^ string_of_tau' h
+ | h :: t ->
+ insist (pair_or_var h) "wellformed";
+ s := !s ^ string_of_tau' h ^ ",";
+ string_of_args t
+ in
+ insist (pair_or_var f.ret) "wellformed";
+ s := "fun(|";
+ s := !s ^ string_of_c_absloc f.fl;
+ s := !s ^ "|,";
+ s := !s ^ "<";
+ if List.length f.args > 0 then string_of_args f.args
+ else s := !s ^ "void";
+ s := !s ^ ">,";
+ s := !s ^ string_of_tau' f.ret;
+ s := !s ^ ")"
+ end;
+ tau_map := List.tl !tau_map;
+ !s
+ in
+ string_of_tau' t
+
+(** Convert an lvalue to a string *)
+let rec string_of_lvalue (lv : lvalue) : string =
+ let contents = string_of_tau lv.contents
+ and l = string_of_c_absloc lv.l
+ in
+ insist (pair_or_var lv.contents) "inconsistency at string_of_lvalue";
+ (* do a consistency check *)
+ Printf.sprintf "[%s]^(%s)" contents l
+
+(** Print a list of tau elements, comma separated *)
+let rec print_tau_list (l : tau list) : unit =
+ let rec print_t_strings = function
+ [] -> ()
+ | h :: [] -> print_endline h
+ | h :: t ->
+ print_string h;
+ print_string ", ";
+ print_t_strings t
+ in
+ print_t_strings (List.map string_of_tau l)
+
+let print_constraint (c : tconstraint) =
+ match c with
+ Unification (t, t') ->
+ let lhs = string_of_tau t in
+ let rhs = string_of_tau t' in
+ Printf.printf "%s == %s\n" lhs rhs
+ | Leq (t, t') ->
+ let lhs = string_of_tau t in
+ let rhs = string_of_tau t' in
+ Printf.printf "%s <= %s\n" lhs rhs
+
+(***********************************************************************)
+(* *)
+(* Type Operations -- these do not create any constraints *)
+(* *)
+(***********************************************************************)
+
+(** Create an lvalue with c_absloc [lbl] and tau contents [t]. *)
+let make_lval (loc, t : c_absloc * tau) : lvalue =
+ {l = loc; contents = t}
+
+let make_c_absloc_int (is_top : bool) (name : string) (vio : Cil.varinfo option) : c_absloc =
+ let my_absloc = (fresh_index (), name, vio) in
+ let locc = C.add my_absloc C.empty
+ in
+ U.uref {
+ l_name = name;
+ l_top = is_top;
+ l_stamp = fresh_stamp ();
+ loc = my_absloc;
+ aliases = locc;
+ ubounds = B.empty;
+ lbounds = B.empty;
+ flow_computed = false
+ }
+
+(** Create a new c_absloc with name [name]. Also adds a fresh absloc
+ with name [name] to this c_absloc's aliases set. *)
+let make_c_absloc (is_top : bool) (name : string) (vio : Cil.varinfo option) =
+ make_c_absloc_int is_top name vio
+
+let fresh_c_absloc (is_top : bool) : c_absloc =
+ let index = fresh_index () in
+ make_c_absloc_int is_top (label_prefix ^ string_of_int index) None
+
+(** Create a fresh bound (edge in the constraint graph). *)
+let make_bound (a : c_absloc) : c_abslocinfo bound =
+ {info = a}
+
+let make_tau_bound (t : tau) : tinfo bound =
+ {info = t}
+
+(** Create a fresh named variable with name '[name]. *)
+let make_var (is_top : bool) (name : string) : tau =
+ U.uref (Var {v_name = ("'" ^ name);
+ v_top = is_top;
+ v_stamp = fresh_index ();
+ v_lbounds = B.empty;
+ v_ubounds = B.empty})
+
+let fresh_var (is_top : bool) : tau =
+ make_var is_top ("fi" ^ string_of_int (fresh_index ()))
+
+(** Create a fresh unnamed variable (name will be 'fi). *)
+let fresh_var_i (is_top : bool) : tau =
+ make_var is_top ("fi" ^ string_of_int (fresh_index ()))
+
+(** Create a Fun constructor. *)
+let make_fun (lbl, a, r : c_absloc * (tau list) * tau) : tau =
+ U.uref (Fun {fl = lbl;
+ f_stamp = fresh_index ();
+ args = a;
+ ret = r})
+
+(** Create a Ref constructor. *)
+let make_ref (lbl, pt : c_absloc * tau) : tau =
+ U.uref (Ref {rl = lbl;
+ r_stamp = fresh_index ();
+ points_to = pt})
+
+(** Create a Pair constructor. *)
+let make_pair (p, f : tau * tau) : tau =
+ U.uref (Pair {ptr = p;
+ p_stamp = fresh_index ();
+ lam = f})
+
+(** Copy the toplevel constructor of [t], putting fresh variables in each
+ argement of the constructor. *)
+let copy_toplevel (t : tau) : tau =
+ match find t with
+ Pair _ -> make_pair (fresh_var_i false, fresh_var_i false)
+ | Ref _ -> make_ref (fresh_c_absloc false, fresh_var_i false)
+ | Fun f ->
+ make_fun (fresh_c_absloc false,
+ List.map (fun _ -> fresh_var_i false) f.args,
+ fresh_var_i false)
+ | _ -> die "copy_toplevel"
+
+let has_same_structure (t : tau) (t' : tau) =
+ match find t, find t' with
+ Pair _, Pair _ -> true
+ | Ref _, Ref _ -> true
+ | Fun _, Fun _ -> true
+ | Var _, Var _ -> true
+ | _ -> false
+
+let pad_args (fi, tlr : finfo * tau list ref) : unit =
+ let padding = List.length fi.args - List.length !tlr
+ in
+ if padding == 0 then ()
+ else
+ if padding > 0 then
+ for i = 1 to padding do
+ tlr := !tlr @ [fresh_var false]
+ done
+ else
+ for i = 1 to -padding do
+ fi.args <- fi.args @ [fresh_var false]
+ done
+
+(***********************************************************************)
+(* *)
+(* Constraint Generation/ Resolution *)
+(* *)
+(***********************************************************************)
+
+let set_top (b : bool) (t : tau) : unit =
+ let set_top_down t =
+ match find t with
+ Var v -> v.v_top <- b
+ | Ref r -> set_top_c_absloc r.rl b
+ | Fun f -> set_top_c_absloc f.fl b
+ | Pair p -> ()
+ in
+ iter_tau set_top_down t
+
+let rec unify_int (t, t' : tau * tau) : unit =
+ if equal_tau t t' then ()
+ else
+ let ti, ti' = find t, find t' in
+ U.unify combine (t, t');
+ match ti, ti' with
+ Var v, Var v' ->
+ set_top (v.v_top || v'.v_top) t';
+ merge_v_lbounds (v, v');
+ merge_v_ubounds (v, v')
+ | Var v, _ ->
+ set_top (v.v_top || top_tau t') t';
+ notify_vlbounds t v;
+ notify_vubounds t v
+ | _, Var v ->
+ set_top (v.v_top || top_tau t) t;
+ notify_vlbounds t' v;
+ notify_vubounds t' v
+ | Ref r, Ref r' -> unify_ref (r, r')
+ | Fun f, Fun f' -> unify_fun (f, f')
+ | Pair p, Pair p' -> unify_pair (p, p')
+ | _ -> raise Inconsistent
+and notify_vlbounds (t : tau) (vi : vinfo) : unit =
+ let notify bounds =
+ List.iter
+ (fun b ->
+ add_constraint (Unification (b.info, copy_toplevel t));
+ add_constraint (Leq (b.info, t)))
+ bounds
+ in
+ notify (B.elements vi.v_lbounds)
+and notify_vubounds (t : tau) (vi : vinfo) : unit =
+ let notify bounds =
+ List.iter
+ (fun b ->
+ add_constraint (Unification (b.info, copy_toplevel t));
+ add_constraint (Leq (t, b.info)))
+ bounds
+ in
+ notify (B.elements vi.v_ubounds)
+and unify_ref (ri, ri' : rinfo * rinfo) : unit =
+ unify_c_abslocs (ri.rl, ri'.rl);
+ add_constraint (Unification (ri.points_to, ri'.points_to))
+and unify_fun (fi, fi' : finfo * finfo) : unit =
+ let rec union_args = function
+ _, [] -> false
+ | [], _ -> true
+ | h :: t, h' :: t' ->
+ add_constraint (Unification (h, h'));
+ union_args(t, t')
+ in
+ unify_c_abslocs (fi.fl, fi'.fl);
+ add_constraint (Unification (fi.ret, fi'.ret));
+ if union_args (fi.args, fi'.args) then fi.args <- fi'.args
+and unify_pair (pi, pi' : pinfo * pinfo) : unit =
+ add_constraint (Unification (pi.ptr, pi'.ptr));
+ add_constraint (Unification (pi.lam, pi'.lam))
+and unify_c_abslocs (l, l' : c_absloc * c_absloc) : unit =
+ let pick_name (li, li' : c_abslocinfo * c_abslocinfo) =
+ if starts_with li.l_name label_prefix then li.l_name <- li'.l_name
+ else () in
+ let combine_c_absloc (li, li' : c_abslocinfo * c_abslocinfo) : c_abslocinfo =
+ pick_name (li, li');
+ li.l_top <- li.l_top || li'.l_top;
+ li.aliases <- C.union li.aliases li'.aliases;
+ li.ubounds <- B.union li.ubounds li'.ubounds;
+ li.lbounds <- B.union li.lbounds li'.lbounds;
+ li
+ in
+ if !debug_constraints then
+ Printf.printf
+ "%s == %s\n"
+ (string_of_c_absloc l)
+ (string_of_c_absloc l');
+ U.unify combine_c_absloc (l, l')
+and merge_v_lbounds (vi, vi' : vinfo * vinfo) : unit =
+ vi'.v_lbounds <- B.union vi.v_lbounds vi'.v_lbounds;
+and merge_v_ubounds (vi, vi' : vinfo * vinfo) : unit =
+ vi'.v_ubounds <- B.union vi.v_ubounds vi'.v_ubounds;
+(** Pick the representative info for two tinfo's. This function
+ prefers the first argument when both arguments are the same
+ structure, but when one type is a structure and the other is a
+ var, it picks the structure. All other actions (e.g., updating
+ the info) is done in unify_int *)
+and combine (ti, ti' : tinfo * tinfo) : tinfo =
+ match ti, ti' with
+ Var _, _ -> ti'
+ | _, _ -> ti
+and leq_int (t, t') : unit =
+ if equal_tau t t' then ()
+ else
+ let ti, ti' = find t, find t' in
+ match ti, ti' with
+ Var v, Var v' ->
+ v.v_ubounds <- B.add (make_tau_bound t') v.v_ubounds;
+ v'.v_lbounds <- B.add (make_tau_bound t) v'.v_lbounds
+ | Var v, _ ->
+ add_constraint (Unification (t, copy_toplevel t'));
+ add_constraint (Leq (t, t'))
+ | _, Var v ->
+ add_constraint (Unification (t', copy_toplevel t));
+ add_constraint (Leq (t, t'))
+ | Ref r, Ref r' -> leq_ref (r, r')
+ | Fun f, Fun f' ->
+ (* TODO: check, why not do subtyping here? *)
+ add_constraint (Unification (t, t'))
+ | Pair pr, Pair pr' ->
+ add_constraint (Leq (pr.ptr, pr'.ptr));
+ add_constraint (Leq (pr.lam, pr'.lam))
+ | _ -> raise Inconsistent
+and leq_ref (ri, ri') : unit =
+ leq_c_absloc (ri.rl, ri'.rl);
+ add_constraint (Unification (ri.points_to, ri'.points_to))
+and leq_c_absloc (l, l') : unit =
+ let li, li' = find l, find l' in
+ if !debug_constraints then
+ Printf.printf
+ "%s <= %s\n"
+ (string_of_c_absloc l)
+ (string_of_c_absloc l');
+ if U.equal (l, l') then ()
+ else
+ begin
+ li.ubounds <- B.add (make_bound l') li.ubounds;
+ li'.lbounds <- B.add (make_bound l) li'.lbounds
+ end
+and add_constraint_int (c : tconstraint) (toplev : bool) =
+ if !debug_constraints && toplev then
+ begin
+ Printf.printf "%d:>" !toplev_count;
+ print_constraint c;
+ incr toplev_count
+ end
+ else
+ if !debug_constraints then print_constraint c else ();
+ insist (can_add_constraints ())
+ "can't add constraints after compute_results is called";
+ begin
+ match c with
+ Unification _ -> Q.add c eq_worklist
+ | Leq _ -> Q.add c leq_worklist
+ end;
+ solve_constraints () (* solve online *)
+and add_constraint (c : tconstraint) =
+ add_constraint_int c false
+and add_toplev_constraint (c : tconstraint) =
+ if !print_constraints && not !debug_constraints then
+ begin
+ Printf.printf "%d:>" !toplev_count;
+ incr toplev_count;
+ print_constraint c
+ end
+ else ();
+ add_constraint_int c true
+and fetch_constraint () : tconstraint option =
+ try Some (Q.take eq_worklist)
+ with Q.Empty ->
+ begin
+ try Some (Q.take leq_worklist)
+ with Q.Empty -> None
+ end
+(** The main solver loop. *)
+and solve_constraints () : unit =
+ match fetch_constraint () with
+ None -> ()
+ | Some c ->
+ begin
+ match c with
+ Unification (t, t') -> unify_int (t, t')
+ | Leq (t, t') ->
+ if !no_sub then unify_int (t, t')
+ else leq_int (t, t')
+ end;
+ solve_constraints ()
+
+(***********************************************************************)
+(* *)
+(* Interface Functions *)
+(* *)
+(***********************************************************************)
+
+(** Return the contents of the lvalue. *)
+let rvalue (lv : lvalue) : tau =
+ lv.contents
+
+(** Dereference the rvalue. If it does not have enough structure to
+ support the operation, then the correct structure is added via new
+ unification constraints. *)
+let rec deref (t : tau) : lvalue =
+ match find t with
+ Pair p ->
+ begin
+ match find p.ptr with
+ | Var _ ->
+ let is_top = top_tau p.ptr in
+ let points_to = fresh_var is_top in
+ let l = fresh_c_absloc is_top in
+ let r = make_ref (l, points_to)
+ in
+ add_toplev_constraint (Unification (p.ptr, r));
+ make_lval (l, points_to)
+ | Ref r -> make_lval (r.rl, r.points_to)
+ | _ -> raise WellFormed
+ end
+ | Var v ->
+ let is_top = top_tau t in
+ add_toplev_constraint
+ (Unification (t, make_pair (fresh_var is_top, fresh_var is_top)));
+ deref t
+ | _ -> raise WellFormed
+
+
+(** Form the union of [t] and [t'], if it doesn't exist already. *)
+let join (t : tau) (t' : tau) : tau =
+ let s, s' = get_stamp t, get_stamp t' in
+ try H.find join_cache (s, s')
+ with Not_found ->
+ let t'' = fresh_var false in
+ add_toplev_constraint (Leq (t, t''));
+ add_toplev_constraint (Leq (t', t''));
+ H.add join_cache (s, s') t'';
+ t''
+
+(** Form the union of a list [tl], expected to be the initializers of some
+ structure or array type. *)
+let join_inits (tl : tau list) : tau =
+ let t' = fresh_var false in
+ List.iter (function t -> add_toplev_constraint (Leq (t, t'))) tl;
+ t'
+
+(** Take the address of an lvalue. Does not add constraints. *)
+let address (lv : lvalue) : tau =
+ make_pair (make_ref (lv.l, lv.contents), fresh_var false )
+
+(** No instantiation in this analysis *)
+let instantiate (lv : lvalue) (i : int) : lvalue =
+ lv
+
+(** Constraint generated from assigning [t] to [lv]. *)
+let assign (lv : lvalue) (t : tau) : unit =
+ add_toplev_constraint (Leq (t, lv.contents))
+
+let assign_ret (i : int) (lv : lvalue) (t : tau) : unit =
+ add_toplev_constraint (Leq (t, lv.contents))
+
+(** Project out the first (ref) component or a pair. If the argument
+ [t] has no discovered structure, raise NoContents. *)
+let proj_ref (t : tau) : tau =
+ match find t with
+ Pair p -> p.ptr
+ | Var v -> raise NoContents
+ | _ -> raise WellFormed
+
+(* Project out the second (fun) component of a pair. If the argument
+ [t] has no discovered structure, create it on the fly by adding
+ constraints. *)
+let proj_fun (t : tau) : tau =
+ match find t with
+ Pair p -> p.lam
+ | Var v ->
+ let p, f = fresh_var false, fresh_var false in
+ add_toplev_constraint (Unification (t, make_pair (p, f)));
+ f
+ | _ -> raise WellFormed
+
+let get_args (t : tau) : tau list =
+ match find t with
+ Fun f -> f.args
+ | _ -> raise WellFormed
+
+let get_finfo (t : tau) : finfo =
+ match find t with
+ Fun f -> f
+ | _ -> raise WellFormed
+
+(** Function type [t] is applied to the arguments [actuals]. Unifies
+ the actuals with the formals of [t]. If no functions have been
+ discovered for [t] yet, create a fresh one and unify it with
+ t. The result is the return value of the function plus the index
+ of this application site.
+
+ For this analysis, the application site is always 0 *)
+let apply (t : tau) (al : tau list) : (tau * int) =
+ let f = proj_fun t in
+ let actuals = ref al in
+ let fi, ret =
+ match find f with
+ Fun fi -> fi, fi.ret
+ | Var v ->
+ let new_l, new_ret, new_args =
+ fresh_c_absloc false,
+ fresh_var false,
+ List.map (function _ -> fresh_var false) !actuals
+ in
+ let new_fun = make_fun (new_l, new_args, new_ret) in
+ add_toplev_constraint (Unification (new_fun, f));
+ (get_finfo new_fun, new_ret)
+ | _ -> raise WellFormed
+ in
+ pad_args (fi, actuals);
+ List.iter2
+ (fun actual -> fun formal ->
+ add_toplev_constraint (Leq (actual, formal)))
+ !actuals fi.args;
+ (ret, 0)
+
+let make_undefined_lvalue () =
+ make_lval (make_c_absloc false "undefined" None,
+ make_var true "undefined")
+
+let make_undefined_rvalue () =
+ make_var true "undefined"
+
+let assign_undefined (lv : lvalue) : unit =
+ assign lv (make_undefined_rvalue ())
+
+let apply_undefined (al : tau list) : (tau * int) =
+ List.iter
+ (fun actual -> assign (make_undefined_lvalue ()) actual)
+ al;
+ (fresh_var true, 0)
+
+(** Create a new function type with name [name], list of formal
+ arguments [formals], and return value [ret]. Adds no constraints. *)
+let make_function (name : string) (formals : lvalue list) (ret : tau) : tau =
+ let f = make_fun (make_c_absloc false name None,
+ List.map (fun x -> rvalue x) formals,
+ ret)
+ in
+ make_pair (fresh_var false, f)
+
+(** Create an lvalue. *)
+let make_lvalue (b : bool ) (name : string) (vio : Cil.varinfo option) =
+ make_lval (make_c_absloc false name vio,
+ make_var false name)
+
+(** Create a fresh named variable. *)
+let make_fresh (name : string) : tau =
+ make_var false name
+
+(** The default type for abslocs. *)
+let bottom () : tau =
+ make_var false "bottom"
+
+(** Unify the result of a function with its return value. *)
+let return (t : tau) (t' : tau) =
+ add_toplev_constraint (Leq (t', t))
+
+(***********************************************************************)
+(* *)
+(* Query/Extract Solutions *)
+(* *)
+(***********************************************************************)
+
+module IntHash = Hashtbl.Make (struct
+ type t = int
+ let equal x y = x = y
+ let hash x = x
+ end)
+
+(** todo : reached_top !! *)
+let collect_ptset_fast (l : c_absloc) : abslocset =
+ let onpath : unit IntHash.t = IntHash.create 101 in
+ let path : c_absloc list ref = ref [] in
+ let compute_path (i : int) =
+ keep_until (fun l -> i = get_c_absloc_stamp l) !path in
+ let collapse_cycle (cycle : c_absloc list) =
+ match cycle with
+ l :: ls ->
+ List.iter (fun l' -> unify_c_abslocs (l, l')) ls;
+ C.empty
+ | [] -> die "collapse cycle" in
+ let rec flow_step (l : c_absloc) : abslocset =
+ let stamp = get_c_absloc_stamp l in
+ if IntHash.mem onpath stamp then (* already seen *)
+ collapse_cycle (compute_path stamp)
+ else
+ let li = find l in
+ IntHash.add onpath stamp ();
+ path := l :: !path;
+ B.iter
+ (fun lb -> li.aliases <- C.union li.aliases (flow_step lb.info))
+ li.lbounds;
+ path := List.tl !path;
+ IntHash.remove onpath stamp;
+ li.aliases
+ in
+ insist (can_query_graph ()) "collect_ptset_fast can't query graph";
+ if get_flow_computed l then get_aliases l
+ else
+ begin
+ set_flow_computed l;
+ flow_step l
+ end
+
+(** this is a quadratic flow step. keep it for debugging the fast
+ version above. *)
+let collect_ptset_slow (l : c_absloc) : abslocset =
+ let onpath : unit IntHash.t = IntHash.create 101 in
+ let rec flow_step (l : c_absloc) : abslocset =
+ if top_c_absloc l then raise ReachedTop
+ else
+ let stamp = get_c_absloc_stamp l in
+ if IntHash.mem onpath stamp then C.empty
+ else
+ let li = find l in
+ IntHash.add onpath stamp ();
+ B.iter
+ (fun lb -> li.aliases <- C.union li.aliases (flow_step lb.info))
+ li.lbounds;
+ li.aliases
+ in
+ insist (can_query_graph ()) "collect_ptset_slow can't query graph";
+ if get_flow_computed l then get_aliases l
+ else
+ begin
+ set_flow_computed l;
+ flow_step l
+ end
+
+let collect_ptset =
+ collect_ptset_slow
+ (* if !debug_flow_step then collect_ptset_slow
+ else collect_ptset_fast *)
+
+let may_alias (t1 : tau) (t2 : tau) : bool =
+ let get_l (t : tau) : c_absloc =
+ match find (proj_ref t) with
+ Ref r -> r.rl
+ | Var v -> raise NoContents
+ | _ -> raise WellFormed
+ in
+ try
+ let l1 = get_l t1
+ and l2 = get_l t2 in
+ equal_c_absloc l1 l2 ||
+ not (C.is_empty (C.inter (collect_ptset l1) (collect_ptset l2)))
+ with
+ NoContents -> false
+ | ReachedTop -> raise UnknownLocation
+
+let points_to_aux (t : tau) : absloc list =
+ try
+ match find (proj_ref t) with
+ Var v -> []
+ | Ref r -> C.elements (collect_ptset r.rl)
+ | _ -> raise WellFormed
+ with
+ NoContents -> []
+ | ReachedTop -> raise UnknownLocation
+
+let points_to (lv : lvalue) : Cil.varinfo list =
+ let rec get_vinfos l : Cil.varinfo list =
+ match l with
+ [] -> []
+ | (_, _, Some h) :: t -> h :: get_vinfos t
+ | (_, _, None) :: t -> get_vinfos t
+ in
+ get_vinfos (points_to_aux lv.contents)
+
+let epoints_to (t : tau) : Cil.varinfo list =
+ let rec get_vinfos l : Cil.varinfo list = match l with
+ [] -> []
+ | (_, _, Some h) :: t -> h :: get_vinfos t
+ | (_, _, None) :: t -> get_vinfos t
+ in
+ get_vinfos (points_to_aux t)
+
+let points_to_names (lv : lvalue) : string list =
+ List.map (fun v -> v.vname) (points_to lv)
+
+let absloc_points_to (lv : lvalue) : absloc list =
+ points_to_aux lv.contents
+
+let absloc_epoints_to (t : tau) : absloc list =
+ points_to_aux t
+
+let absloc_of_lvalue (lv : lvalue) : absloc =
+ (find lv.l).loc
+
+let absloc_eq = equal_absloc
diff --git a/cil/src/ext/pta/olf.mli b/cil/src/ext/pta/olf.mli
new file mode 100644
index 0000000..4379482
--- /dev/null
+++ b/cil/src/ext/pta/olf.mli
@@ -0,0 +1,80 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+type lvalue
+type tau
+type absloc
+
+(** Raised if a pointer flows to an undefined function.
+ We assume that such a function can have any effect on the pointer's contents
+*)
+exception UnknownLocation
+
+val debug : bool ref
+val debug_constraints : bool ref
+val debug_aliases : bool ref
+val smart_aliases : bool ref
+val finished_constraints : unit -> unit
+val print_constraints : bool ref
+val no_flow : bool ref
+val no_sub : bool ref
+val analyze_mono : bool ref
+val solve_constraints : unit -> unit (* only for compatability with Golf *)
+val rvalue : lvalue -> tau
+val deref : tau -> lvalue
+val join : tau -> tau -> tau
+val join_inits : tau list -> tau
+val address : lvalue -> tau
+val instantiate : lvalue -> int -> lvalue
+val assign : lvalue -> tau -> unit
+val assign_ret : int -> lvalue -> tau -> unit
+val apply : tau -> tau list -> (tau * int)
+val apply_undefined : tau list -> (tau * int)
+val assign_undefined : lvalue -> unit
+val make_function : string -> lvalue list -> tau -> tau
+val make_lvalue : bool -> string -> (Cil.varinfo option) -> lvalue
+val bottom : unit -> tau
+val return : tau -> tau -> unit
+val make_fresh : string -> tau
+val points_to_names : lvalue -> string list
+val points_to : lvalue -> Cil.varinfo list
+val epoints_to : tau -> Cil.varinfo list
+val string_of_lvalue : lvalue -> string
+val may_alias : tau -> tau -> bool
+
+val absloc_points_to : lvalue -> absloc list
+val absloc_epoints_to : tau -> absloc list
+val absloc_of_lvalue : lvalue -> absloc
+val absloc_eq : (absloc * absloc) -> bool
+val d_absloc : unit -> absloc -> Pretty.doc
diff --git a/cil/src/ext/pta/ptranal.ml b/cil/src/ext/pta/ptranal.ml
new file mode 100644
index 0000000..c91bda8
--- /dev/null
+++ b/cil/src/ext/pta/ptranal.ml
@@ -0,0 +1,597 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+exception Bad_return
+exception Bad_function
+
+
+open Cil
+
+module H = Hashtbl
+
+module A = Olf
+exception UnknownLocation = A.UnknownLocation
+
+type access = A.lvalue * bool
+
+type access_map = (lval, access) H.t
+
+(** a mapping from varinfo's back to fundecs *)
+module VarInfoKey =
+struct
+ type t = varinfo
+ let compare v1 v2 = v1.vid - v2.vid
+end
+
+module F = Map.Make (VarInfoKey)
+
+
+(***********************************************************************)
+(* *)
+(* Global Variables *)
+(* *)
+(***********************************************************************)
+
+let model_strings = ref false
+let print_constraints = A.print_constraints
+let debug_constraints = A.debug_constraints
+let debug_aliases = A.debug_aliases
+let smart_aliases = A.smart_aliases
+let debug = A.debug
+let analyze_mono = A.analyze_mono
+let no_flow = A.no_flow
+let no_sub = A.no_sub
+let fun_ptrs_as_funs = ref false
+let show_progress = ref false
+let debug_may_aliases = ref false
+
+let found_undefined = ref false
+
+let conservative_undefineds = ref false
+
+let current_fundec : fundec option ref = ref None
+
+let fun_access_map : (fundec, access_map) H.t = H.create 64
+
+(* A mapping from varinfos to fundecs *)
+let fun_varinfo_map = ref F.empty
+
+let current_ret : A.tau option ref = ref None
+
+let lvalue_hash : (varinfo,A.lvalue) H.t = H.create 64
+
+let expressions : (exp,A.tau) H.t = H.create 64
+
+let lvalues : (lval,A.lvalue) H.t = H.create 64
+
+let fresh_index : (unit -> int) =
+ let count = ref 0 in
+ fun () ->
+ incr count;
+ !count
+
+let alloc_names = [
+ "malloc";
+ "calloc";
+ "realloc";
+ "xmalloc";
+ "__builtin_alloca";
+ "alloca";
+ "kmalloc"
+]
+
+let all_globals : varinfo list ref = ref []
+let all_functions : fundec list ref = ref []
+
+
+(***********************************************************************)
+(* *)
+(* Utility Functions *)
+(* *)
+(***********************************************************************)
+
+let is_undefined_fun = function
+ Lval (lh, o) ->
+ if isFunctionType (typeOfLval (lh, o)) then
+ match lh with
+ Var v -> v.vstorage = Extern
+ | _ -> false
+ else false
+ | _ -> false
+
+let is_alloc_fun = function
+ Lval (lh, o) ->
+ if isFunctionType (typeOfLval (lh, o)) then
+ match lh with
+ Var v -> List.mem v.vname alloc_names
+ | _ -> false
+ else false
+ | _ -> false
+
+let next_alloc = function
+ Lval (Var v, o) ->
+ let name = Printf.sprintf "%s@%d" v.vname (fresh_index ())
+ in
+ A.address (A.make_lvalue false name (Some v)) (* check *)
+ | _ -> raise Bad_return
+
+let is_effect_free_fun = function
+ Lval (lh, o) when isFunctionType (typeOfLval (lh, o)) ->
+ begin
+ match lh with
+ Var v ->
+ begin
+ try ("CHECK_" = String.sub v.vname 0 6)
+ with Invalid_argument _ -> false
+ end
+ | _ -> false
+ end
+ | _ -> false
+
+
+(***********************************************************************)
+(* *)
+(* AST Traversal Functions *)
+(* *)
+(***********************************************************************)
+
+(* should do nothing, might need to worry about Index case *)
+(* let analyzeOffset (o : offset ) : A.tau = A.bottom () *)
+
+let analyze_var_decl (v : varinfo ) : A.lvalue =
+ try H.find lvalue_hash v
+ with Not_found ->
+ let lv = A.make_lvalue false v.vname (Some v)
+ in
+ H.add lvalue_hash v lv;
+ lv
+
+let isFunPtrType (t : typ) : bool =
+ match t with
+ TPtr (t, _) -> isFunctionType t
+ | _ -> false
+
+let rec analyze_lval (lv : lval ) : A.lvalue =
+ let find_access (l : A.lvalue) (is_var : bool) : A.lvalue =
+ match !current_fundec with
+ None -> l
+ | Some f ->
+ let accesses = H.find fun_access_map f in
+ if H.mem accesses lv then l
+ else
+ begin
+ H.add accesses lv (l, is_var);
+ l
+ end in
+ let result =
+ match lv with
+ Var v, _ -> (* instantiate every syntactic occurrence of a function *)
+ let alv =
+ if isFunctionType (typeOfLval lv) then
+ A.instantiate (analyze_var_decl v) (fresh_index ())
+ else analyze_var_decl v
+ in
+ find_access alv true
+ | Mem e, _ ->
+ (* assert (not (isFunctionType(typeOf(e))) ); *)
+ let alv =
+ if !fun_ptrs_as_funs && isFunPtrType (typeOf e) then
+ analyze_expr_as_lval e
+ else A.deref (analyze_expr e)
+ in
+ find_access alv false
+ in
+ H.replace lvalues lv result;
+ result
+and analyze_expr_as_lval (e : exp) : A.lvalue =
+ match e with
+ Lval l -> analyze_lval l
+ | _ -> assert false (* todo -- other kinds of expressions? *)
+and analyze_expr (e : exp ) : A.tau =
+ let result =
+ match e with
+ Const (CStr s) ->
+ if !model_strings then
+ A.address (A.make_lvalue
+ false
+ s
+ (Some (makeVarinfo false s charConstPtrType)))
+ else A.bottom ()
+ | Const c -> A.bottom ()
+ | Lval l -> A.rvalue (analyze_lval l)
+ | SizeOf _ -> A.bottom ()
+ | SizeOfStr _ -> A.bottom ()
+ | AlignOf _ -> A.bottom ()
+ | UnOp (op, e, t) -> analyze_expr e
+ | BinOp (op, e, e', t) -> A.join (analyze_expr e) (analyze_expr e')
+ | CastE (t, e) -> analyze_expr e
+ | AddrOf l ->
+ if !fun_ptrs_as_funs && isFunctionType (typeOfLval l) then
+ A.rvalue (analyze_lval l)
+ else A.address (analyze_lval l)
+ | StartOf l -> A.address (analyze_lval l)
+ | AlignOfE _ -> A.bottom ()
+ | SizeOfE _ -> A.bottom ()
+ in
+ H.add expressions e result;
+ result
+
+
+(* check *)
+let rec analyze_init (i : init ) : A.tau =
+ match i with
+ SingleInit e -> analyze_expr e
+ | CompoundInit (t, oi) ->
+ A.join_inits (List.map (function (_, i) -> analyze_init i) oi)
+
+let analyze_instr (i : instr ) : unit =
+ match i with
+ Set (lval, rhs, l) ->
+ A.assign (analyze_lval lval) (analyze_expr rhs)
+ | Call (res, fexpr, actuals, l) ->
+ if not (isFunctionType (typeOf fexpr)) then
+ () (* todo : is this a varargs? *)
+ else if is_alloc_fun fexpr then
+ begin
+ if !debug then print_string "Found allocation function...\n";
+ match res with
+ Some r -> A.assign (analyze_lval r) (next_alloc fexpr)
+ | None -> ()
+ end
+ else if is_effect_free_fun fexpr then
+ List.iter (fun e -> ignore (analyze_expr e)) actuals
+ else (* todo : check to see if the thing is an undefined function *)
+ let fnres, site =
+ if is_undefined_fun fexpr & !conservative_undefineds then
+ A.apply_undefined (List.map analyze_expr actuals)
+ else
+ A.apply (analyze_expr fexpr) (List.map analyze_expr actuals)
+ in
+ begin
+ match res with
+ Some r ->
+ begin
+ A.assign_ret site (analyze_lval r) fnres;
+ found_undefined := true;
+ end
+ | None -> ()
+ end
+ | Asm _ -> ()
+
+let rec analyze_stmt (s : stmt ) : unit =
+ match s.skind with
+ Instr il -> List.iter analyze_instr il
+ | Return (eo, l) ->
+ begin
+ match eo with
+ Some e ->
+ begin
+ match !current_ret with
+ Some ret -> A.return ret (analyze_expr e)
+ | None -> raise Bad_return
+ end
+ | None -> ()
+ end
+ | Goto (s', l) -> () (* analyze_stmt(!s') *)
+ | If (e, b, b', l) ->
+ (* ignore the expression e; expressions can't be side-effecting *)
+ analyze_block b;
+ analyze_block b'
+ | Switch (e, b, sl, l) ->
+ analyze_block b;
+ List.iter analyze_stmt sl
+(*
+ | Loop (b, l, _, _) -> analyze_block b
+*)
+ | While (_, b, _) -> analyze_block b
+ | DoWhile (_, b, _) -> analyze_block b
+ | For (bInit, _, bIter, b, _) ->
+ analyze_block bInit;
+ analyze_block bIter;
+ analyze_block b
+ | Block b -> analyze_block b
+ | TryFinally (b, h, _) ->
+ analyze_block b;
+ analyze_block h
+ | TryExcept (b, (il, _), h, _) ->
+ analyze_block b;
+ List.iter analyze_instr il;
+ analyze_block h
+ | Break l -> ()
+ | Continue l -> ()
+
+
+and analyze_block (b : block ) : unit =
+ List.iter analyze_stmt b.bstmts
+
+let analyze_function (f : fundec ) : unit =
+ let oldlv = analyze_var_decl f.svar in
+ let ret = A.make_fresh (f.svar.vname ^ "_ret") in
+ let formals = List.map analyze_var_decl f.sformals in
+ let newf = A.make_function f.svar.vname formals ret in
+ if !show_progress then
+ Printf.printf "Analyzing function %s\n" f.svar.vname;
+ fun_varinfo_map := F.add f.svar f (!fun_varinfo_map);
+ current_fundec := Some f;
+ H.add fun_access_map f (H.create 8);
+ A.assign oldlv newf;
+ current_ret := Some ret;
+ analyze_block f.sbody
+
+let analyze_global (g : global ) : unit =
+ match g with
+ GVarDecl (v, l) -> () (* ignore (analyze_var_decl(v)) -- no need *)
+ | GVar (v, init, l) ->
+ all_globals := v :: !all_globals;
+ begin
+ match init.init with
+ Some i -> A.assign (analyze_var_decl v) (analyze_init i)
+ | None -> ignore (analyze_var_decl v)
+ end
+ | GFun (f, l) ->
+ all_functions := f :: !all_functions;
+ analyze_function f
+ | _ -> ()
+
+let analyze_file (f : file) : unit =
+ iterGlobals f analyze_global
+
+
+(***********************************************************************)
+(* *)
+(* High-level Query Interface *)
+(* *)
+(***********************************************************************)
+
+(* Same as analyze_expr, but no constraints. *)
+let rec traverse_expr (e : exp) : A.tau =
+ H.find expressions e
+
+and traverse_expr_as_lval (e : exp) : A.lvalue =
+ match e with
+ | Lval l -> traverse_lval l
+ | _ -> assert false (* todo -- other kinds of expressions? *)
+
+and traverse_lval (lv : lval ) : A.lvalue =
+ H.find lvalues lv
+
+let may_alias (e1 : exp) (e2 : exp) : bool =
+ let tau1,tau2 = traverse_expr e1, traverse_expr e2 in
+ let result = A.may_alias tau1 tau2 in
+ if !debug_may_aliases then
+ begin
+ let doc1 = d_exp () e1 in
+ let doc2 = d_exp () e2 in
+ let s1 = Pretty.sprint ~width:30 doc1 in
+ let s2 = Pretty.sprint ~width:30 doc2 in
+ Printf.printf
+ "%s and %s may alias? %s\n"
+ s1
+ s2
+ (if result then "yes" else "no")
+ end;
+ result
+
+let resolve_lval (lv : lval) : varinfo list =
+ A.points_to (traverse_lval lv)
+
+let resolve_exp (e : exp) : varinfo list =
+ A.epoints_to (traverse_expr e)
+
+let resolve_funptr (e : exp) : fundec list =
+ let varinfos = A.epoints_to (traverse_expr e) in
+ List.fold_left
+ (fun fdecs -> fun vinf ->
+ try F.find vinf !fun_varinfo_map :: fdecs
+ with Not_found -> fdecs)
+ []
+ varinfos
+
+let count_hash_elts h =
+ let result = ref 0 in
+ H.iter (fun _ -> fun _ -> incr result) lvalue_hash;
+ !result
+
+let compute_may_aliases (b : bool) : unit =
+ let rec compute_may_aliases_aux (exps : exp list) =
+ match exps with
+ [] -> ()
+ | h :: t ->
+ ignore (List.map (may_alias h) t);
+ compute_may_aliases_aux t
+ and exprs : exp list ref = ref [] in
+ H.iter (fun e -> fun _ -> exprs := e :: !exprs) expressions;
+ compute_may_aliases_aux !exprs
+
+
+let compute_results (show_sets : bool) : unit =
+ let total_pointed_to = ref 0
+ and total_lvalues = H.length lvalue_hash
+ and counted_lvalues = ref 0
+ and lval_elts : (string * (string list)) list ref = ref [] in
+ let print_result (name, set) =
+ let rec print_set s =
+ match s with
+ [] -> ()
+ | h :: [] -> print_string h
+ | h :: t ->
+ print_string (h ^ ", ");
+ print_set t
+ and ptsize = List.length set in
+ total_pointed_to := !total_pointed_to + ptsize;
+ if ptsize > 0 then
+ begin
+ print_string (name ^ "(" ^ (string_of_int ptsize) ^ ") -> ");
+ print_set set;
+ print_newline ()
+ end
+ in
+ (* Make the most pessimistic assumptions about globals if an
+ undefined function is present. Such a function can write to every
+ global variable *)
+ let hose_globals () : unit =
+ List.iter
+ (fun vd -> A.assign_undefined (analyze_var_decl vd))
+ !all_globals
+ in
+ let show_progress_fn (counted : int ref) (total : int) : unit =
+ incr counted;
+ if !show_progress then
+ Printf.printf "Computed flow for %d of %d sets\n" !counted total
+ in
+ if !conservative_undefineds && !found_undefined then hose_globals ();
+ A.finished_constraints ();
+ if show_sets then
+ begin
+ print_endline "Computing points-to sets...";
+ Hashtbl.iter
+ (fun vinf -> fun lv ->
+ show_progress_fn counted_lvalues total_lvalues;
+ try lval_elts := (vinf.vname, A.points_to_names lv) :: !lval_elts
+ with A.UnknownLocation -> ())
+ lvalue_hash;
+ List.iter print_result !lval_elts;
+ Printf.printf
+ "Total number of things pointed to: %d\n"
+ !total_pointed_to
+ end;
+ if !debug_may_aliases then
+ begin
+ Printf.printf "Printing may alias relationships\n";
+ compute_may_aliases true
+ end
+
+let print_types () : unit =
+ print_string "Printing inferred types of lvalues...\n";
+ Hashtbl.iter
+ (fun vi -> fun lv ->
+ Printf.printf "%s : %s\n" vi.vname (A.string_of_lvalue lv))
+ lvalue_hash
+
+
+
+(** Alias queries. For each function, gather sets of locals, formals, and
+ globals. Do n^2 work for each of these functions, reporting whether or not
+ each pair of values is aliased. Aliasing is determined by taking points-to
+ set intersections.
+*)
+let compute_aliases = compute_may_aliases
+
+
+(***********************************************************************)
+(* *)
+(* Abstract Location Interface *)
+(* *)
+(***********************************************************************)
+
+type absloc = A.absloc
+
+let rec lvalue_of_varinfo (vi : varinfo) : A.lvalue =
+ H.find lvalue_hash vi
+
+let lvalue_of_lval = traverse_lval
+let tau_of_expr = traverse_expr
+
+(** return an abstract location for a varinfo, resp. lval *)
+let absloc_of_varinfo vi =
+ A.absloc_of_lvalue (lvalue_of_varinfo vi)
+
+let absloc_of_lval lv =
+ A.absloc_of_lvalue (lvalue_of_lval lv)
+
+let absloc_e_points_to e =
+ A.absloc_epoints_to (tau_of_expr e)
+
+let absloc_lval_aliases lv =
+ A.absloc_points_to (lvalue_of_lval lv)
+
+(* all abslocs that e transitively points to *)
+let absloc_e_transitive_points_to (e : Cil.exp) : absloc list =
+ let rec lv_trans_ptsto (worklist : varinfo list) (acc : varinfo list) : absloc list =
+ match worklist with
+ [] -> List.map absloc_of_varinfo acc
+ | vi :: wklst'' ->
+ if List.mem vi acc then lv_trans_ptsto wklst'' acc
+ else
+ lv_trans_ptsto
+ (List.rev_append
+ (A.points_to (lvalue_of_varinfo vi))
+ wklst'')
+ (vi :: acc)
+ in
+ lv_trans_ptsto (A.epoints_to (tau_of_expr e)) []
+
+let absloc_eq a b = A.absloc_eq (a, b)
+
+let d_absloc: unit -> absloc -> Pretty.doc = A.d_absloc
+
+
+let ptrAnalysis = ref false
+let ptrResults = ref false
+let ptrTypes = ref false
+
+
+
+(** Turn this into a CIL feature *)
+let feature : featureDescr = {
+ fd_name = "ptranal";
+ fd_enabled = ptrAnalysis;
+ fd_description = "alias analysis";
+ fd_extraopt = [
+ ("--ptr_may_aliases",
+ Arg.Unit (fun _ -> debug_may_aliases := true),
+ "Print out results of may alias queries");
+ ("--ptr_unify", Arg.Unit (fun _ -> no_sub := true),
+ "Make the alias analysis unification-based");
+ ("--ptr_model_strings", Arg.Unit (fun _ -> model_strings := true),
+ "Make the alias analysis model string constants");
+ ("--ptr_conservative",
+ Arg.Unit (fun _ -> conservative_undefineds := true),
+ "Treat undefineds conservatively in alias analysis");
+ ("--ptr_results", Arg.Unit (fun _ -> ptrResults := true),
+ "print the results of the alias analysis");
+ ("--ptr_mono", Arg.Unit (fun _ -> analyze_mono := true),
+ "run alias analysis monomorphically");
+ ("--ptr_types",Arg.Unit (fun _ -> ptrTypes := true),
+ "print inferred points-to analysis types")
+ ];
+ fd_doit = (function (f: file) ->
+ analyze_file f;
+ compute_results !ptrResults;
+ if !ptrTypes then print_types ());
+ fd_post_check = false (* No changes *)
+}
diff --git a/cil/src/ext/pta/ptranal.mli b/cil/src/ext/pta/ptranal.mli
new file mode 100644
index 0000000..36eb7a5
--- /dev/null
+++ b/cil/src/ext/pta/ptranal.mli
@@ -0,0 +1,156 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(***********************************************************************)
+(* *)
+(* Flags *)
+(* *)
+(***********************************************************************)
+
+(** Print extra debugging info *)
+val debug : bool ref
+
+(** Debug constraints (print all constraints) *)
+val debug_constraints : bool ref
+
+(** Debug smart alias queries *)
+val debug_aliases : bool ref
+
+(** Debug may alias queries *)
+val debug_may_aliases : bool ref
+
+val smart_aliases : bool ref
+
+(** Print out the top level constraints *)
+val print_constraints : bool ref
+
+(** Make the analysis monomorphic *)
+val analyze_mono : bool ref
+
+(** Disable subtyping *)
+val no_sub : bool ref
+
+(** Make the flow step a no-op *)
+val no_flow : bool ref
+
+(** Show the progress of the flow step *)
+val show_progress : bool ref
+
+(** Treat undefined functions conservatively *)
+val conservative_undefineds : bool ref
+
+(***********************************************************************)
+(* *)
+(* Building the Points-to Graph *)
+(* *)
+(***********************************************************************)
+
+(** Analyze a file *)
+val analyze_file : Cil.file -> unit
+
+(** Print the type of each lvalue in the program *)
+val print_types : unit -> unit
+
+(***********************************************************************)
+(* *)
+(* High-level Query Interface *)
+(* *)
+(***********************************************************************)
+
+(** If undefined functions are analyzed conservatively, any of the
+ high-level queries may raise this exception *)
+exception UnknownLocation
+
+val may_alias : Cil.exp -> Cil.exp -> bool
+
+val resolve_lval : Cil.lval -> (Cil.varinfo list)
+
+val resolve_exp : Cil.exp -> (Cil.varinfo list)
+
+val resolve_funptr : Cil.exp -> (Cil.fundec list)
+
+(***********************************************************************)
+(* *)
+(* Low-level Query Interface *)
+(* *)
+(***********************************************************************)
+
+(** type for abstract locations *)
+type absloc
+
+(** Give an abstract location for a varinfo *)
+val absloc_of_varinfo : Cil.varinfo -> absloc
+
+(** Give an abstract location for an Cil lvalue *)
+val absloc_of_lval : Cil.lval -> absloc
+
+(** may the two abstract locations be aliased? *)
+val absloc_eq : absloc -> absloc -> bool
+
+val absloc_e_points_to : Cil.exp -> absloc list
+val absloc_e_transitive_points_to : Cil.exp -> absloc list
+
+val absloc_lval_aliases : Cil.lval -> absloc list
+
+(** Print a string representing an absloc, for debugging. *)
+val d_absloc : unit -> absloc -> Pretty.doc
+
+
+(***********************************************************************)
+(* *)
+(* Printing results *)
+(* *)
+(***********************************************************************)
+
+(** Compute points to sets for variables. If true is passed, print the sets. *)
+val compute_results : bool -> unit
+
+(*
+
+Deprecated these. -- jk
+
+(** Compute alias relationships. If true is passed, print all alias pairs. *)
+ val compute_aliases : bool -> unit
+
+(** Compute alias frequncy *)
+val compute_alias_frequency : unit -> unit
+
+
+*)
+
+val compute_aliases : bool -> unit
+
+
+val feature: Cil.featureDescr
diff --git a/cil/src/ext/pta/setp.ml b/cil/src/ext/pta/setp.ml
new file mode 100644
index 0000000..a39b972
--- /dev/null
+++ b/cil/src/ext/pta/setp.ml
@@ -0,0 +1,342 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: setp.ml,v 1.3 2003-02-19 19:26:31 jkodumal Exp $ *)
+
+(* Sets over ordered types *)
+
+module type PolyOrderedType =
+ sig
+ type 'a t
+ val compare: 'a t -> 'a t -> int
+ end
+
+module type S =
+ sig
+ type 'a elt
+ type 'a t
+ val empty: 'a t
+ val is_empty: 'a t -> bool
+ val mem: 'a elt -> 'a t -> bool
+ val add: 'a elt -> 'a t -> 'a t
+ val singleton: 'a elt -> 'a t
+ val remove: 'a elt -> 'a t -> 'a t
+ val union: 'a t -> 'a t -> 'a t
+ val inter: 'a t -> 'a t -> 'a t
+ val diff: 'a t -> 'a t -> 'a t
+ val compare: 'a t -> 'a t -> int
+ val equal: 'a t -> 'a t -> bool
+ val subset: 'a t -> 'a t -> bool
+ val iter: ('a elt -> unit) -> 'a t -> unit
+ val fold: ('a elt -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ val for_all: ('a elt -> bool) -> 'a t -> bool
+ val exists: ('a elt -> bool) -> 'a t -> bool
+ val filter: ('a elt -> bool) -> 'a t -> 'a t
+ val partition: ('a elt -> bool) -> 'a t -> 'a t * 'a t
+ val cardinal: 'a t -> int
+ val elements: 'a t -> 'a elt list
+ val min_elt: 'a t -> 'a elt
+ val max_elt: 'a t -> 'a elt
+ val choose: 'a t -> 'a elt
+ end
+
+module Make(Ord: PolyOrderedType) =
+ struct
+ type 'a elt = 'a Ord.t
+ type 'a t = Empty | Node of 'a t * 'a elt * 'a t * int
+
+ (* Sets are represented by balanced binary trees (the heights of the
+ children differ by at most 2 *)
+
+ let height = function
+ Empty -> 0
+ | Node(_, _, _, h) -> h
+
+ (* Creates a new node with left son l, value x and right son r.
+ l and r must be balanced and | height l - height r | <= 2.
+ Inline expansion of height for better speed. *)
+
+ let create l x r =
+ let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
+ let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+ Node(l, x, r, (if hl >= hr then hl + 1 else hr + 1))
+
+ (* Same as create, but performs one step of rebalancing if necessary.
+ Assumes l and r balanced.
+ Inline expansion of create for better speed in the most frequent case
+ where no rebalancing is required. *)
+
+ let bal l x r =
+ let hl = match l with Empty -> 0 | Node(_,_,_,h) -> h in
+ let hr = match r with Empty -> 0 | Node(_,_,_,h) -> h in
+ if hl > hr + 2 then begin
+ match l with
+ Empty -> invalid_arg "Set.bal"
+ | Node(ll, lv, lr, _) ->
+ if height ll >= height lr then
+ create ll lv (create lr x r)
+ else begin
+ match lr with
+ Empty -> invalid_arg "Set.bal"
+ | Node(lrl, lrv, lrr, _)->
+ create (create ll lv lrl) lrv (create lrr x r)
+ end
+ end else if hr > hl + 2 then begin
+ match r with
+ Empty -> invalid_arg "Set.bal"
+ | Node(rl, rv, rr, _) ->
+ if height rr >= height rl then
+ create (create l x rl) rv rr
+ else begin
+ match rl with
+ Empty -> invalid_arg "Set.bal"
+ | Node(rll, rlv, rlr, _) ->
+ create (create l x rll) rlv (create rlr rv rr)
+ end
+ end else
+ Node(l, x, r, (if hl >= hr then hl + 1 else hr + 1))
+
+ (* Same as bal, but repeat rebalancing until the final result
+ is balanced. *)
+
+ let rec join l x r =
+ match bal l x r with
+ Empty -> invalid_arg "Set.join"
+ | Node(l', x', r', _) as t' ->
+ let d = height l' - height r' in
+ if d < -2 || d > 2 then join l' x' r' else t'
+
+ (* Merge two trees l and r into one.
+ All elements of l must precede the elements of r.
+ Assumes | height l - height r | <= 2. *)
+
+ let rec merge t1 t2 =
+ match (t1, t2) with
+ (Empty, t) -> t
+ | (t, Empty) -> t
+ | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
+ bal l1 v1 (bal (merge r1 l2) v2 r2)
+
+ (* Same as merge, but does not assume anything about l and r. *)
+
+ let rec concat t1 t2 =
+ match (t1, t2) with
+ (Empty, t) -> t
+ | (t, Empty) -> t
+ | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
+ join l1 v1 (join (concat r1 l2) v2 r2)
+
+ (* Splitting *)
+
+ let rec split x = function
+ Empty ->
+ (Empty, None, Empty)
+ | Node(l, v, r, _) ->
+ let c = Ord.compare x v in
+ if c = 0 then (l, Some v, r)
+ else if c < 0 then
+ let (ll, vl, rl) = split x l in (ll, vl, join rl v r)
+ else
+ let (lr, vr, rr) = split x r in (join l v lr, vr, rr)
+
+ (* Implementation of the set operations *)
+
+ let empty = Empty
+
+ let is_empty = function Empty -> true | _ -> false
+
+ let rec mem x = function
+ Empty -> false
+ | Node(l, v, r, _) ->
+ let c = Ord.compare x v in
+ c = 0 || mem x (if c < 0 then l else r)
+
+ let rec add x = function
+ Empty -> Node(Empty, x, Empty, 1)
+ | Node(l, v, r, _) as t ->
+ let c = Ord.compare x v in
+ if c = 0 then t else
+ if c < 0 then bal (add x l) v r else bal l v (add x r)
+
+ let singleton x = Node(Empty, x, Empty, 1)
+
+ let rec remove x = function
+ Empty -> Empty
+ | Node(l, v, r, _) ->
+ let c = Ord.compare x v in
+ if c = 0 then merge l r else
+ if c < 0 then bal (remove x l) v r else bal l v (remove x r)
+
+ let rec union s1 s2 =
+ match (s1, s2) with
+ (Empty, t2) -> t2
+ | (t1, Empty) -> t1
+ | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
+ if h1 >= h2 then
+ if h2 = 1 then add v2 s1 else begin
+ let (l2, _, r2) = split v1 s2 in
+ join (union l1 l2) v1 (union r1 r2)
+ end
+ else
+ if h1 = 1 then add v1 s2 else begin
+ let (l1, _, r1) = split v2 s1 in
+ join (union l1 l2) v2 (union r1 r2)
+ end
+
+ let rec inter s1 s2 =
+ match (s1, s2) with
+ (Empty, t2) -> Empty
+ | (t1, Empty) -> Empty
+ | (Node(l1, v1, r1, _), t2) ->
+ match split v1 t2 with
+ (l2, None, r2) ->
+ concat (inter l1 l2) (inter r1 r2)
+ | (l2, Some _, r2) ->
+ join (inter l1 l2) v1 (inter r1 r2)
+
+ let rec diff s1 s2 =
+ match (s1, s2) with
+ (Empty, t2) -> Empty
+ | (t1, Empty) -> t1
+ | (Node(l1, v1, r1, _), t2) ->
+ match split v1 t2 with
+ (l2, None, r2) ->
+ join (diff l1 l2) v1 (diff r1 r2)
+ | (l2, Some _, r2) ->
+ concat (diff l1 l2) (diff r1 r2)
+
+ let rec compare_aux l1 l2 =
+ match (l1, l2) with
+ ([], []) -> 0
+ | ([], _) -> -1
+ | (_, []) -> 1
+ | (Empty :: t1, Empty :: t2) ->
+ compare_aux t1 t2
+ | (Node(Empty, v1, r1, _) :: t1, Node(Empty, v2, r2, _) :: t2) ->
+ let c = Ord.compare v1 v2 in
+ if c <> 0 then c else compare_aux (r1::t1) (r2::t2)
+ | (Node(l1, v1, r1, _) :: t1, t2) ->
+ compare_aux (l1 :: Node(Empty, v1, r1, 0) :: t1) t2
+ | (t1, Node(l2, v2, r2, _) :: t2) ->
+ compare_aux t1 (l2 :: Node(Empty, v2, r2, 0) :: t2)
+
+ let compare s1 s2 =
+ compare_aux [s1] [s2]
+
+ let equal s1 s2 =
+ compare s1 s2 = 0
+
+ let rec subset s1 s2 =
+ match (s1, s2) with
+ Empty, _ ->
+ true
+ | _, Empty ->
+ false
+ | Node (l1, v1, r1, _), (Node (l2, v2, r2, _) as t2) ->
+ let c = Ord.compare v1 v2 in
+ if c = 0 then
+ subset l1 l2 && subset r1 r2
+ else if c < 0 then
+ subset (Node (l1, v1, Empty, 0)) l2 && subset r1 t2
+ else
+ subset (Node (Empty, v1, r1, 0)) r2 && subset l1 t2
+
+ let rec iter f = function
+ Empty -> ()
+ | Node(l, v, r, _) -> iter f l; f v; iter f r
+
+ let rec fold f s accu =
+ match s with
+ Empty -> accu
+ | Node(l, v, r, _) -> fold f l (f v (fold f r accu))
+
+ let rec for_all p = function
+ Empty -> true
+ | Node(l, v, r, _) -> p v && for_all p l && for_all p r
+
+ let rec exists p = function
+ Empty -> false
+ | Node(l, v, r, _) -> p v || exists p l || exists p r
+
+ let filter p s =
+ let rec filt accu = function
+ | Empty -> accu
+ | Node(l, v, r, _) ->
+ filt (filt (if p v then add v accu else accu) l) r in
+ filt Empty s
+
+ let partition p s =
+ let rec part (t, f as accu) = function
+ | Empty -> accu
+ | Node(l, v, r, _) ->
+ part (part (if p v then (add v t, f) else (t, add v f)) l) r in
+ part (Empty, Empty) s
+
+ let rec cardinal = function
+ Empty -> 0
+ | Node(l, v, r, _) -> cardinal l + 1 + cardinal r
+
+ let rec elements_aux accu = function
+ Empty -> accu
+ | Node(l, v, r, _) -> elements_aux (v :: elements_aux accu r) l
+
+ let elements s =
+ elements_aux [] s
+
+ let rec min_elt = function
+ Empty -> raise Not_found
+ | Node(Empty, v, r, _) -> v
+ | Node(l, v, r, _) -> min_elt l
+
+ let rec max_elt = function
+ Empty -> raise Not_found
+ | Node(l, v, Empty, _) -> v
+ | Node(l, v, r, _) -> max_elt r
+
+ let choose = min_elt
+
+ end
diff --git a/cil/src/ext/pta/setp.mli b/cil/src/ext/pta/setp.mli
new file mode 100644
index 0000000..a3b3031
--- /dev/null
+++ b/cil/src/ext/pta/setp.mli
@@ -0,0 +1,180 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(***********************************************************************)
+(* *)
+(* Objective Caml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. All rights reserved. This file is distributed *)
+(* under the terms of the GNU Library General Public License, with *)
+(* the special exception on linking described in file ../LICENSE. *)
+(* *)
+(***********************************************************************)
+
+(* $Id: setp.mli,v 1.3 2003-02-19 19:26:31 jkodumal Exp $ *)
+
+(** Sets over ordered types.
+
+ This module implements the set data structure, given a total ordering
+ function over the set elements. All operations over sets
+ are purely applicative (no side-effects).
+ The implementation uses balanced binary trees, and is therefore
+ reasonably efficient: insertion and membership take time
+ logarithmic in the size of the set, for instance.
+*)
+
+module type PolyOrderedType =
+ sig
+ type 'a t
+ (** The type of the set elements. *)
+ val compare : 'a t -> 'a t -> int
+ (** A total ordering function over the set elements.
+ This is a two-argument function [f] such that
+ [f e1 e2] is zero if the elements [e1] and [e2] are equal,
+ [f e1 e2] is strictly negative if [e1] is smaller than [e2],
+ and [f e1 e2] is strictly positive if [e1] is greater than [e2].
+ Example: a suitable ordering function is
+ the generic structural comparison function {!Pervasives.compare}. *)
+ end
+(** Input signature of the functor {!Set.Make}. *)
+
+module type S =
+ sig
+ type 'a elt
+ (** The type of the set elements. *)
+
+ type 'a t
+ (** The type of sets. *)
+
+ val empty: 'a t
+ (** The empty set. *)
+
+ val is_empty: 'a t -> bool
+ (** Test whether a set is empty or not. *)
+
+ val mem: 'a elt -> 'a t -> bool
+ (** [mem x s] tests whether [x] belongs to the set [s]. *)
+
+ val add: 'a elt -> 'a t -> 'a t
+ (** [add x s] returns a set containing all elements of [s],
+ plus [x]. If [x] was already in [s], [s] is returned unchanged. *)
+
+ val singleton: 'a elt -> 'a t
+ (** [singleton x] returns the one-element set containing only [x]. *)
+
+ val remove: 'a elt -> 'a t -> 'a t
+ (** [remove x s] returns a set containing all elements of [s],
+ except [x]. If [x] was not in [s], [s] is returned unchanged. *)
+
+ val union: 'a t -> 'a t -> 'a t
+ (** Set union. *)
+
+ val inter: 'a t -> 'a t -> 'a t
+ (** Set interseection. *)
+
+ (** Set difference. *)
+ val diff: 'a t -> 'a t -> 'a t
+
+ val compare: 'a t -> 'a t -> int
+ (** Total ordering between sets. Can be used as the ordering function
+ for doing sets of sets. *)
+
+ val equal: 'a t -> 'a t -> bool
+ (** [equal s1 s2] tests whether the sets [s1] and [s2] are
+ equal, that is, contain equal elements. *)
+
+ val subset: 'a t -> 'a t -> bool
+ (** [subset s1 s2] tests whether the set [s1] is a subset of
+ the set [s2]. *)
+
+ val iter: ('a elt -> unit) -> 'a t -> unit
+ (** [iter f s] applies [f] in turn to all elements of [s].
+ The order in which the elements of [s] are presented to [f]
+ is unspecified. *)
+
+ val fold: ('a elt -> 'b -> 'b) -> 'a t -> 'b -> 'b
+ (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
+ where [x1 ... xN] are the elements of [s].
+ The order in which elements of [s] are presented to [f] is
+ unspecified. *)
+
+ val for_all: ('a elt -> bool) -> 'a t -> bool
+ (** [for_all p s] checks if all elements of the set
+ satisfy the predicate [p]. *)
+
+ val exists: ('a elt -> bool) -> 'a t -> bool
+ (** [exists p s] checks if at least one element of
+ the set satisfies the predicate [p]. *)
+
+ val filter: ('a elt -> bool) -> 'a t -> 'a t
+ (** [filter p s] returns the set of all elements in [s]
+ that satisfy predicate [p]. *)
+
+ val partition: ('a elt -> bool) -> 'a t -> 'a t * 'a t
+ (** [partition p s] returns a pair of sets [(s1, s2)], where
+ [s1] is the set of all the elements of [s] that satisfy the
+ predicate [p], and [s2] is the set of all the elements of
+ [s] that do not satisfy [p]. *)
+
+ val cardinal: 'a t -> int
+ (** Return the number of elements of a set. *)
+
+ val elements: 'a t -> 'a elt list
+ (** Return the list of all elements of the given set.
+ The returned list is sorted in increasing order with respect
+ to the ordering [Ord.compare], where [Ord] is the argument
+ given to {!Set.Make}. *)
+
+ val min_elt: 'a t -> 'a elt
+ (** Return the smallest element of the given set
+ (with respect to the [Ord.compare] ordering), or raise
+ [Not_found] if the set is empty. *)
+
+ val max_elt: 'a t -> 'a elt
+ (** Same as {!Set.S.min_elt}, but returns the largest element of the
+ given set. *)
+
+ val choose: 'a t -> 'a elt
+ (** Return one element of the given set, or raise [Not_found] if
+ the set is empty. Which element is chosen is unspecified,
+ but equal elements will be chosen for equal sets. *)
+ end
+(** Output signature of the functor {!Set.Make}. *)
+
+module Make (Ord : PolyOrderedType) : S with type 'a elt = 'a Ord.t
+(** Functor building an implementation of the set structure
+ given a totally ordered type. *)
diff --git a/cil/src/ext/pta/steensgaard.ml b/cil/src/ext/pta/steensgaard.ml
new file mode 100644
index 0000000..6368693
--- /dev/null
+++ b/cil/src/ext/pta/steensgaard.ml
@@ -0,0 +1,1417 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(***********************************************************************)
+(* *)
+(* *)
+(* This file is currently unused by CIL. It is included in the *)
+(* distribution for reference only. *)
+(* *)
+(* *)
+(***********************************************************************)
+
+
+(***********************************************************************)
+(* *)
+(* Type Declarations *)
+(* *)
+(***********************************************************************)
+
+exception Inconsistent of string
+exception Bad_cache
+exception No_contents
+exception Bad_proj
+exception Bad_type_copy
+exception Instantiation_cycle
+
+module U = Uref
+module S = Setp
+module H = Hashtbl
+module Q = Queue
+
+(** Polarity kinds-- positive, negative, or nonpolar. *)
+type polarity = Pos
+ | Neg
+ | Non
+
+(** Label bounds. The polymorphic type is a hack for recursive modules *)
+type 'a bound = {index : int; info : 'a}
+
+(** The 'a type may in general contain urefs, which makes Pervasives.compare
+ incorrect. However, the bounds will always be correct because if two tau's
+ get unified, their cached instantiations will be re-entered into the
+ worklist, ensuring that any labels find the new bounds *)
+module Bound =
+struct
+ type 'a t = 'a bound
+ let compare (x : 'a t) (y : 'a t) =
+ Pervasives.compare x y
+end
+
+module B = S.Make(Bound)
+
+type 'a boundset = 'a B.t
+
+(** Constants, which identify elements in points-to sets *)
+type constant = int * string
+
+module Constant =
+struct
+ type t = constant
+
+ let compare ((xid,_) : t) ((yid,_) : t) =
+ Pervasives.compare xid yid
+end
+
+module C = Set.Make(Constant)
+
+(** Sets of constants. Set union is used when two labels containing
+ constant sets are unified *)
+type constantset = C.t
+
+type lblinfo = {
+ mutable l_name: string;
+ (** Name of this label *)
+ mutable aliases: constantset;
+ (** Set of constants (tags) for checking aliases *)
+ p_bounds: label boundset U.uref;
+ (** Set of umatched (p) lower bounds *)
+ n_bounds: label boundset U.uref;
+ (** Set of unmatched (n) lower bounds *)
+ mutable p_cached: bool;
+ (** Flag indicating whether all reachable p edges have been locally cached *)
+ mutable n_cached: bool;
+ (** Flag indicating whether all reachable n edges have been locally cached *)
+ mutable on_path: bool;
+ (** For cycle detection during reachability queries *)
+}
+
+(** Constructor labels *)
+and label = lblinfo U.uref
+
+(** The type of lvalues. *)
+type lvalue = {
+ l: label;
+ contents: tau
+}
+
+(** Data for variables. *)
+and vinfo = {
+ v_name: string;
+ mutable v_global: bool;
+ v_cache: cache
+}
+
+(** Data for ref constructors. *)
+and rinfo = {
+ rl: label;
+ mutable r_global: bool;
+ points_to: tau;
+ r_cache: cache
+}
+
+(** Data for fun constructors. *)
+and finfo = {
+ fl: label;
+ mutable f_global: bool;
+ args: tau list ref;
+ ret: tau;
+ f_cache: cache
+}
+
+(* Data for pairs. Note there is no label. *)
+and pinfo = {
+ mutable p_global: bool;
+ ptr: tau;
+ lam: tau;
+ p_cache: cache
+}
+
+(** Type constructors discovered by type inference *)
+and tinfo = Wild
+ | Var of vinfo
+ | Ref of rinfo
+ | Fun of finfo
+ | Pair of pinfo
+
+(** The top-level points-to type. *)
+and tau = tinfo U.uref
+
+(** The instantiation constraint cache. The index is used as a key. *)
+and cache = (int,polarity * tau) H.t
+
+(* Type of semi-unification constraints *)
+type su_constraint = Instantiation of tau * (int * polarity) * tau
+ | Unification of tau * tau
+
+(** Association lists, used for printing recursive types. The first element
+ is a type that has been visited. The second element is the string
+ representation of that type (so far). If the string option is set, then
+ this type occurs within itself, and is associated with the recursive var
+ name stored in the option. When walking a type, add it to an association
+ list.
+
+ Example : suppose we have the constraint 'a = ref('a). The type is unified
+ via cyclic unification, and would loop infinitely if we attempted to print
+ it. What we want to do is print the type u rv. ref(rv). This is accomplished
+ in the following manner:
+
+ -- ref('a) is visited. It is not in the association list, so it is added
+ and the string "ref(" is stored in the second element. We recurse to print
+ the first argument of the constructor.
+
+ -- In the recursive call, we see that 'a (or ref('a)) is already in the
+ association list, so the type is recursive. We check the string option,
+ which is None, meaning that this is the first recurrence of the type. We
+ create a new recursive variable, rv and set the string option to 'rv. Next,
+ we prepend u rv. to the string representation we have seen before, "ref(",
+ and return "rv" as the string representation of this type.
+
+ -- The string so far is "u rv.ref(". The recursive call returns, and we
+ complete the type by printing the result of the call, "rv", and ")"
+
+ In a type where the recursive variable appears twice, e.g. 'a = pair('a,'a),
+ the second time we hit 'a, the string option will be set, so we know to
+ reuse the same recursive variable name.
+*)
+type association = tau * string ref * string option ref
+
+(***********************************************************************)
+(* *)
+(* Global Variables *)
+(* *)
+(***********************************************************************)
+
+(** Print the instantiations constraints (loops with cyclic structures). *)
+let print_constraints : bool ref = ref false
+
+(** Solve constraints as they are introduced. If this is false, constraints
+ are solved in batch fashion at calls to solveConstraints. *)
+let solve_online : bool ref = ref true
+
+(** If true, print all constraints (including induced) and show additional
+ debug output. *)
+let debug = ref false
+let debug_constraints = debug
+
+(** If true, print out extra verbose debug information (including contents
+ of label sets *)
+let verbose_debug = ref false
+
+
+(** If true, make the flow step a no-op *)
+let no_flow = ref false
+
+let no_sub = ref false
+
+(** If true, do not add instantiation constraints *)
+let analyze_mono = ref false
+
+(** A counter for generating unique integers. *)
+let counter : int ref = ref 0
+
+(** A list of equality constraints. *)
+let eq_worklist : su_constraint Q.t = Q.create()
+
+(** A list of instantiation constraints. *)
+let inst_worklist : su_constraint Q.t = Q.create()
+
+(***********************************************************************)
+(* *)
+(* Utility Functions *)
+(* *)
+(***********************************************************************)
+
+(** Consistency check for inferred types *)
+let pair_or_var (t : tau) =
+ match (U.deref t) with
+ | Pair _ -> true
+ | Var _ -> true
+ | _ -> false
+
+let ref_or_var (t : tau) =
+ match (U.deref t) with
+ | Ref _ -> true
+ | Var _ -> true
+ | _ -> false
+
+let fun_or_var (t : tau) =
+ match (U.deref t) with
+ | Fun _ -> true
+ | Var _ -> true
+ | _ -> false
+
+(** Generate a unique integer. *)
+let fresh_index () : int =
+ incr counter;
+ !counter
+
+(** Negate a polarity. *)
+let negate (p : polarity) : polarity =
+ match p with
+ | Pos -> Neg
+ | Neg -> Pos
+ | Non -> Non
+
+(** Compute the least-upper-bounds of two polarities. *)
+let lub (p,p' : polarity * polarity) : polarity =
+ match p with
+ | Pos ->
+ begin
+ match p' with
+ | Pos -> Pos
+ | _ -> Non
+ end
+ | Neg ->
+ begin
+ match p' with
+ | Neg -> Neg
+ | _ -> Non
+ end
+ | Non -> Non
+
+(** Extract the cache from a type *)
+let get_cache (t : tau) : cache =
+ match U.deref t with
+ | Wild -> raise Bad_cache
+ | Var v -> v.v_cache
+ | Ref r -> r.r_cache
+ | Pair p -> p.p_cache
+ | Fun f -> f.f_cache
+
+(** Determine whether or not a type is global *)
+let get_global (t : tau) : bool =
+ match U.deref t with
+ | Wild -> false
+ | Var v -> v.v_global
+ | Ref r -> r.r_global
+ | Pair p -> p.p_global
+ | Fun f -> f.f_global
+
+(** Return true if a type is monomorphic (global). *)
+let global_tau = get_global
+
+let global_lvalue lv = get_global lv.contents
+
+(** Return true if e is a member of l (according to uref equality) *)
+let rec ulist_mem e l =
+ match l with
+ | [] -> false
+ | h :: t -> if (U.equal(h,e)) then true else ulist_mem e t
+
+(** Convert a polarity to a string *)
+let string_of_polarity p =
+ match p with
+ | Pos -> "+"
+ | Neg -> "-"
+ | Non -> "T"
+
+(** Convert a label to a string, short representation *)
+let string_of_label2 (l : label) : string =
+ "\"" ^ (U.deref l).l_name ^ "\""
+
+(** Convert a label to a string, long representation *)
+let string_of_label (l : label ) : string =
+ let rec constset_to_string = function
+ | (_,s) :: [] -> s
+ | (_,s) :: t -> s ^ "," ^ (constset_to_string t)
+ | [] -> ""
+ in
+ let aliases = constset_to_string (C.elements ((U.deref l).aliases))
+ in
+ if ( (aliases = "") || (not !verbose_debug))
+ then string_of_label2 l
+ else aliases
+
+(** Return true if the element [e] is present in the association list *)
+let rec assoc_list_mem (e : tau) (l : association list) =
+ match l with
+ | [] -> None
+ | (h,s,so) :: t ->
+ if (U.equal(h,e)) then (Some (s,so)) else assoc_list_mem e t
+
+(** Given a tau, create a unique recursive variable name. This should always
+ return the same name for a given tau *)
+let fresh_recvar_name (t : tau) : string =
+ match U.deref t with
+ | Pair p -> "rvp" ^ string_of_int((Hashtbl.hash p))
+ | Ref r -> "rvr" ^ string_of_int((Hashtbl.hash r))
+ | Fun f -> "rvf" ^ string_of_int((Hashtbl.hash f))
+ | _ -> raise (Inconsistent ("recvar_name"))
+
+(** Return a string representation of a tau, using association lists. *)
+let string_of_tau (t : tau ) : string =
+ let tau_map : association list ref = ref [] in
+ let rec string_of_tau' t =
+ match (assoc_list_mem t (!tau_map)) with
+ | Some (s,so) -> (* recursive type. see if a var name has been set *)
+ begin
+ match (!so) with
+ | None ->
+ begin
+ let rv = fresh_recvar_name(t) in
+ s := "u " ^ rv ^ "." ^ (!s);
+ so := Some (rv);
+ rv
+ end
+ | Some rv -> rv
+ end
+ | None -> (* type's not recursive. Add it to the assoc list and cont. *)
+ let s = ref "" in
+ let so : string option ref = ref None in
+ begin
+ tau_map := (t,s,so) :: (!tau_map);
+
+ (match (U.deref t) with
+ | Wild -> s := "_";
+ | Var v -> s := v.v_name;
+ | Pair p ->
+ begin
+ assert (ref_or_var(p.ptr));
+ assert (fun_or_var(p.lam));
+ s := "{";
+ s := (!s) ^ (string_of_tau' p.ptr);
+ s := (!s) ^ ",";
+ s := (!s) ^ (string_of_tau' p.lam);
+ s := (!s) ^"}"
+
+ end
+ | Ref r ->
+ begin
+ assert(pair_or_var(r.points_to));
+ s := "ref(|";
+ s := (!s) ^ (string_of_label r.rl);
+ s := (!s) ^ "|,";
+ s := (!s) ^ (string_of_tau' r.points_to);
+ s := (!s) ^ ")"
+
+ end
+ | Fun f ->
+ begin
+ assert(pair_or_var(f.ret));
+ let rec string_of_args = function
+ | h :: [] ->
+ begin
+ assert(pair_or_var(h));
+ s := (!s) ^ (string_of_tau' h)
+ end
+ | h :: t ->
+ begin
+ assert(pair_or_var(h));
+ s := (!s) ^ (string_of_tau' h) ^ ",";
+ string_of_args t
+ end
+ | [] -> ()
+ in
+ s := "fun(|";
+ s := (!s) ^ (string_of_label f.fl);
+ s := (!s) ^ "|,";
+ s := (!s) ^ "<";
+ if (List.length !(f.args) > 0)
+ then
+ string_of_args !(f.args)
+ else
+ s := (!s) ^ "void";
+ s := (!s) ^">,";
+ s := (!s) ^ (string_of_tau' f.ret);
+ s := (!s) ^ ")"
+ end);
+ tau_map := List.tl (!tau_map);
+ !s
+ end
+ in
+ string_of_tau' t
+
+(** Convert an lvalue to a string *)
+let rec string_of_lvalue (lv : lvalue) : string =
+ let contents = (string_of_tau(lv.contents)) in
+ let l = (string_of_label lv.l) in
+ assert(pair_or_var(lv.contents));
+ Printf.sprintf "[%s]^(%s)" contents l
+
+(** Print a list of tau elements, comma separated *)
+let rec print_tau_list (l : tau list) : unit =
+ let t_strings = List.map string_of_tau l in
+ let rec print_t_strings = function
+ | h :: [] -> print_string h; print_newline();
+ | h :: t -> print_string h; print_string ", "; print_t_strings t
+ | [] -> ()
+ in
+ print_t_strings t_strings
+
+(** Print a constraint. *)
+let print_constraint (c : su_constraint) =
+ match c with
+ | Unification (t,t') ->
+ let lhs = string_of_tau t in
+ let rhs = string_of_tau t' in
+ Printf.printf "%s == %s\n" lhs rhs
+ | Instantiation (t,(i,p),t') ->
+ let lhs = string_of_tau t in
+ let rhs = string_of_tau t' in
+ let index = string_of_int i in
+ let pol = string_of_polarity p in
+ Printf.printf "%s <={%s,%s} %s\n" lhs index pol rhs
+
+(* If [positive] is true, return the p-edge bounds, otherwise, return
+ the n-edge bounds. *)
+let get_bounds (positive : bool) (l : label) : label boundset U.uref =
+ if (positive) then
+ (U.deref l).p_bounds
+ else
+ (U.deref l).n_bounds
+
+(** Used for cycle detection during the flow step. Returns true if the
+ label [l] is found on the current path. *)
+let on_path (l : label) : bool =
+ (U.deref l).on_path
+
+(** Used for cycle detection during the flow step. Identifies [l] as being
+ on/off the current path. *)
+let set_on_path (l : label) (b : bool) : unit =
+ (U.deref l).on_path <- b
+
+(** Make the type a global type *)
+let set_global (t : tau) (b : bool) : bool =
+ if (!debug && b)
+ then
+ Printf.printf "Setting a new global : %s\n" (string_of_tau t);
+ begin
+ assert ( (not (get_global(t)) ) || b );
+ (match U.deref t with
+ | Wild -> ()
+ | Var v -> v.v_global <- b
+ | Ref r -> r.r_global <- b
+ | Pair p -> p.p_global <- b
+ | Fun f -> f.f_global <- b);
+ b
+ end
+
+(** Return a label's bounds as a string *)
+let string_of_bounds (is_pos : bool) (l : label) : string =
+ let bounds =
+ if (is_pos) then
+ U.deref ((U.deref l).p_bounds)
+ else
+ U.deref ((U.deref l).n_bounds)
+ in
+ B.fold (fun b -> fun res -> res ^ (string_of_label2 b.info) ^ " "
+ ) bounds ""
+
+(***********************************************************************)
+(* *)
+(* Type Operations -- these do not create any constraints *)
+(* *)
+(***********************************************************************)
+
+let wild_val = U.uref Wild
+
+(** The wild (don't care) value. *)
+let wild () : tau =
+ wild_val
+
+(** Create an lvalue with label [lbl] and tau contents [t]. *)
+let make_lval (lbl,t : label * tau) : lvalue =
+ {l = lbl; contents = t}
+
+(** Create a new label with name [name]. Also adds a fresh constant
+ with name [name] to this label's aliases set. *)
+let make_label (name : string) : label =
+ U.uref {
+ l_name = name;
+ aliases = (C.add (fresh_index(),name) C.empty);
+ p_bounds = U.uref (B.empty);
+ n_bounds = U.uref (B.empty);
+ p_cached = false;
+ n_cached = false;
+ on_path = false
+ }
+
+(** Create a new label with an unspecified name and an empty alias set. *)
+let fresh_label () : label =
+ U.uref {
+ l_name = "l_" ^ (string_of_int (fresh_index()));
+ aliases = (C.empty);
+ p_bounds = U.uref (B.empty);
+ n_bounds = U.uref (B.empty);
+ p_cached = false;
+ n_cached = false;
+ on_path = false
+ }
+
+(** Create a fresh bound. *)
+let make_bound (i,a : int * 'a) : 'a bound =
+ {index = i; info = a }
+
+(** Create a fresh named variable with name '[name]. *)
+let make_var (b: bool) (name : string) : tau =
+ U.uref (Var {v_name = ("'" ^name);
+ v_global = b;
+ v_cache = H.create 4})
+
+(** Create a fresh unnamed variable (name will be 'fv). *)
+let fresh_var () : tau =
+ make_var false ("fv" ^ (string_of_int (fresh_index())) )
+
+(** Create a fresh unnamed variable (name will be 'fi). *)
+let fresh_var_i () : tau =
+ make_var false ("fi" ^ (string_of_int (fresh_index())) )
+
+(** Create a Fun constructor. *)
+let make_fun (lbl,a,r : label * (tau list) * tau) : tau =
+ U.uref (Fun {fl = lbl ;
+ f_global = false;
+ args = ref a;
+ ret = r;
+ f_cache = H.create 4})
+
+(** Create a Ref constructor. *)
+let make_ref (lbl,pt : label * tau) : tau =
+ U.uref (Ref {rl = lbl ;
+ r_global = false;
+ points_to = pt;
+ r_cache = H.create 4})
+
+(** Create a Pair constructor. *)
+let make_pair (p,f : tau * tau) : tau =
+ U.uref (Pair {ptr = p;
+ p_global = false;
+ lam = f;
+ p_cache = H.create 4})
+
+(** Copy the toplevel constructor of [t], putting fresh variables in each
+ argement of the constructor. *)
+let copy_toplevel (t : tau) : tau =
+ match U.deref t with
+ | Pair _ ->
+ make_pair (fresh_var_i(), fresh_var_i())
+ | Ref _ ->
+ make_ref (fresh_label(),fresh_var_i())
+ | Fun f ->
+ let fresh_fn = fun _ -> fresh_var_i()
+ in
+ make_fun (fresh_label(), List.map fresh_fn !(f.args) , fresh_var_i())
+ | _ -> raise Bad_type_copy
+
+let pad_args (l,l' : (tau list ref) * (tau list ref)) : unit =
+ let padding = ref ((List.length (!l)) - (List.length (!l')))
+ in
+ if (!padding == 0) then ()
+ else
+ let to_pad =
+ if (!padding > 0) then l' else (padding := -(!padding);l)
+ in
+ for i = 1 to (!padding) do
+ to_pad := (!to_pad) @ [fresh_var()]
+ done
+
+(***********************************************************************)
+(* *)
+(* Constraint Generation/ Resolution *)
+(* *)
+(***********************************************************************)
+
+(** Returns true if the constraint has no effect, i.e. either the left-hand
+ side or the right-hand side is wild. *)
+let wild_constraint (t,t' : tau * tau) : bool =
+ let ti,ti' = U.deref t, U.deref t' in
+ match ti,ti' with
+ | Wild, _ -> true
+ | _, Wild -> true
+ | _ -> false
+
+exception Cycle_found
+
+(** Cycle detection between instantiations. Returns true if there is a cycle
+ from t to t' *)
+let exists_cycle (t,t' : tau * tau) : bool =
+ let visited : tau list ref = ref [] in
+ let rec exists_cycle' t =
+ if (ulist_mem t (!visited))
+ then
+ begin (*
+ print_string "Instantiation cycle found :";
+ print_tau_list (!visited);
+ print_newline();
+ print_string (string_of_tau t);
+ print_newline(); *)
+ (* raise Instantiation_cycle *)
+ (* visited := List.tl (!visited) *) (* check *)
+ end
+ else
+ begin
+ visited := t :: (!visited);
+ if (U.equal(t,t'))
+ then raise Cycle_found
+ else
+ H.iter (fun _ -> fun (_,t'') ->
+ if (U.equal (t,t'')) then ()
+ else
+ ignore (exists_cycle' t'')
+ ) (get_cache t) ;
+ visited := List.tl (!visited)
+ end
+ in
+ try
+ exists_cycle' t;
+ false
+ with
+ | Cycle_found -> true
+
+exception Subterm
+
+(** Returns true if [t'] is a proper subterm of [t] *)
+let proper_subterm (t,t') =
+ let visited : tau list ref = ref [] in
+ let rec proper_subterm' t =
+ if (ulist_mem t (!visited))
+ then () (* recursive type *)
+ else
+ if (U.equal (t,t'))
+ then raise Subterm
+ else
+ begin
+ visited := t :: (!visited);
+ (
+ match (U.deref t) with
+ | Wild -> ()
+ | Var _ -> ()
+ | Ref r ->
+ proper_subterm' r.points_to
+ | Pair p ->
+ proper_subterm' p.ptr;
+ proper_subterm' p.lam
+ | Fun f ->
+ proper_subterm' f.ret;
+ List.iter (proper_subterm') !(f.args)
+ );
+ visited := List.tl (!visited)
+ end
+ in
+ try
+ if (U.equal(t,t')) then false
+ else
+ begin
+ proper_subterm' t;
+ false
+ end
+ with
+ | Subterm -> true
+
+(** The extended occurs check. Search for a cycle of instantiations from [t]
+ to [t']. If such a cycle exists, check to see that [t'] is a proper subterm
+ of [t]. If it is, then return true *)
+let eoc (t,t') : bool =
+ if (exists_cycle(t,t') && proper_subterm(t,t'))
+ then
+ begin
+ if (!debug)
+ then
+ Printf.printf "Occurs check : %s occurs within %s\n" (string_of_tau t')
+ (string_of_tau t)
+ else
+ ();
+ true
+ end
+ else
+ false
+
+(** Resolve an instantiation constraint *)
+let rec instantiate_int (t,(i,p),t' : tau * (int * polarity) * tau) =
+ if ( wild_constraint(t,t') || (not (store(t,(i,p),t'))) ||
+ U.equal(t,t') )
+ then ()
+ else
+ let ti,ti' = U.deref t, U.deref t' in
+ match ti,ti' with
+ | Ref r, Ref r' ->
+ instantiate_ref(r,(i,p),r')
+ | Fun f, Fun f' ->
+ instantiate_fun(f,(i,p),f')
+ | Pair pr, Pair pr' ->
+ begin
+ add_constraint_int (Instantiation (pr.ptr,(i,p),pr'.ptr));
+ add_constraint_int (Instantiation (pr.lam,(i,p),pr'.lam))
+ end
+ | Var v, _ -> ()
+ | _,Var v' ->
+ if eoc(t,t')
+ then
+ add_constraint_int (Unification (t,t'))
+ else
+ begin
+ unstore(t,i);
+ add_constraint_int (Unification ((copy_toplevel t),t'));
+ add_constraint_int (Instantiation (t,(i,p),t'))
+ end
+ | _ -> raise (Inconsistent("instantiate"))
+
+(** Apply instantiations to the ref's label, and structurally down the type.
+ Contents of ref constructors are instantiated with polarity Non. *)
+and instantiate_ref (ri,(i,p),ri') : unit =
+ add_constraint_int (Instantiation(ri.points_to,(i,Non),ri'.points_to));
+ instantiate_label (ri.rl,(i,p),ri'.rl)
+
+(** Apply instantiations to the fun's label, and structurally down the type.
+ Flip the polarity for the function's args. If the lengths of the argument
+ lists don't match, extend the shorter list as necessary. *)
+and instantiate_fun (fi,(i,p),fi') : unit =
+ pad_args (fi.args, fi'.args);
+ assert(List.length !(fi.args) == List.length !(fi'.args));
+ add_constraint_int (Instantiation (fi.ret,(i,p),fi'.ret));
+ List.iter2 (fun t ->fun t' ->
+ add_constraint_int (Instantiation(t,(i,negate p),t')))
+ !(fi.args) !(fi'.args);
+ instantiate_label (fi.fl,(i,p),fi'.fl)
+
+(** Instantiate a label. Update the label's bounds with new flow edges.
+ *)
+and instantiate_label (l,(i,p),l' : label * (int * polarity) * label) : unit =
+ if (!debug) then
+ Printf.printf "%s <= {%d,%s} %s\n" (string_of_label l) i
+ (string_of_polarity p) (string_of_label l');
+ let li,li' = U.deref l, U.deref l' in
+ match p with
+ | Pos ->
+ U.update (li'.p_bounds,
+ B.add(make_bound (i,l)) (U.deref li'.p_bounds)
+ )
+ | Neg ->
+ U.update (li.n_bounds,
+ B.add(make_bound (i,l')) (U.deref li.n_bounds)
+ )
+ | Non ->
+ begin
+ U.update (li'.p_bounds,
+ B.add(make_bound (i,l)) (U.deref li'.p_bounds)
+ );
+ U.update (li.n_bounds,
+ B.add(make_bound (i,l')) (U.deref li.n_bounds)
+ )
+ end
+
+(** Resolve a unification constraint. Does the uref unification after grabbing
+ a copy of the information before the two infos are unified. The other
+ interesting feature of this function is the way 'globalness' is propagated.
+ If a non-global is unified with a global, the non-global becomes global.
+ If the ecr became global, there is a problem because none of its cached
+ instantiations know that the type became monomorphic. In this case, they
+ must be re-inserted via merge-cache. Merge-cache always reinserts cached
+ instantiations from the non-ecr type, i.e. the type that was 'killed' by the
+ unification. *)
+and unify_int (t,t' : tau * tau) : unit =
+ if (wild_constraint(t,t') || U.equal(t,t'))
+ then ()
+ else
+ let ti, ti' = U.deref t, U.deref t' in
+ begin
+ U.unify combine (t,t');
+ match ti,ti' with
+ | Var v, _ ->
+ begin
+ if (set_global t' (v.v_global || (get_global t')))
+ then (H.iter (merge_cache t') (get_cache t'))
+ else ();
+ H.iter (merge_cache t') v.v_cache
+ end
+ | _, Var v ->
+ begin
+ if (set_global t (v.v_global || (get_global t)))
+ then (H.iter (merge_cache t) (get_cache t))
+ else ();
+ H.iter (merge_cache t) v.v_cache
+ end
+ | Ref r, Ref r' ->
+ begin
+ if (set_global t (r.r_global || r'.r_global))
+ then (H.iter (merge_cache t) (get_cache t))
+ else ();
+ H.iter (merge_cache t) r'.r_cache;
+ unify_ref(r,r')
+ end
+ | Fun f, Fun f' ->
+ begin
+ if (set_global t (f.f_global || f'.f_global))
+ then (H.iter (merge_cache t) (get_cache t))
+ else ();
+ H.iter (merge_cache t) f'.f_cache;
+ unify_fun (f,f');
+ end
+ | Pair p, Pair p' ->
+ begin
+ if (set_global t (p.p_global || p'.p_global))
+ then (H.iter (merge_cache t) (get_cache t))
+ else ();
+ H.iter (merge_cache t) p'.p_cache;
+ add_constraint_int (Unification (p.ptr,p'.ptr));
+ add_constraint_int (Unification (p.lam,p'.lam))
+ end
+ | _ -> raise (Inconsistent("unify"))
+ end
+
+(** Unify the ref's label, and apply unification structurally down the type. *)
+and unify_ref (ri,ri' : rinfo * rinfo) : unit =
+ add_constraint_int (Unification (ri.points_to,ri'.points_to));
+ unify_label(ri.rl,ri'.rl)
+
+(** Unify the fun's label, and apply unification structurally down the type,
+ at arguments and return value. When combining two lists of different lengths,
+ always choose the longer list for the representative. *)
+and unify_fun (li,li' : finfo * finfo) : unit =
+ let rec union_args = function
+ | _, [] -> false
+ | [], _ -> true
+ | h :: t, h' :: t' ->
+ add_constraint_int (Unification (h,h')); union_args(t,t')
+ in
+ begin
+ unify_label(li.fl,li'.fl);
+ add_constraint_int (Unification (li.ret,li'.ret));
+ if (union_args(!(li.args),!(li'.args)))
+ then li.args := !(li'.args);
+ end
+
+(** Unify two labels, combining the set of constants denoting aliases. *)
+and unify_label (l,l' : label * label) : unit =
+ let pick_name (li,li' : lblinfo * lblinfo) =
+ if ( (String.length li.l_name) > 1 && (String.sub (li.l_name) 0 2) = "l_")
+ then
+ li.l_name <- li'.l_name
+ else ()
+ in
+ let combine_label (li,li' : lblinfo *lblinfo) : lblinfo =
+ let p_bounds = U.deref (li.p_bounds) in
+ let p_bounds' = U.deref (li'.p_bounds) in
+ let n_bounds = U.deref (li.n_bounds) in
+ let n_bounds' = U.deref (li'.n_bounds) in
+ begin
+ pick_name(li,li');
+ li.aliases <- C.union (li.aliases) (li'.aliases);
+ U.update (li.p_bounds, (B.union p_bounds p_bounds'));
+ U.update (li.n_bounds, (B.union n_bounds n_bounds'));
+ li
+ end
+ in(*
+ if (!debug) then
+ begin
+ Printf.printf "Unifying %s with %s...\n"
+ (string_of_label l) (string_of_label l');
+ Printf.printf "pbounds : %s\n" (string_of_bounds true l);
+ Printf.printf "nbounds : %s\n" (string_of_bounds false l);
+ Printf.printf "pbounds : %s\n" (string_of_bounds true l');
+ Printf.printf "nbounds : %s\n\n" (string_of_bounds false l')
+ end; *)
+ U.unify combine_label (l,l')
+ (* if (!debug) then
+ begin
+ Printf.printf "pbounds : %s\n" (string_of_bounds true l);
+ Printf.printf "nbounds : %s\n" (string_of_bounds false l)
+ end *)
+
+(** Re-assert a cached instantiation constraint, since the old type was
+ killed by a unification *)
+and merge_cache (rep : tau) (i : int) (p,t' : polarity * tau) : unit =
+ add_constraint_int (Instantiation (rep,(i,p),t'))
+
+(** Pick the representative info for two tinfo's. This function prefers the
+ first argument when both arguments are the same structure, but when
+ one type is a structure and the other is a var, it picks the structure. *)
+and combine (ti,ti' : tinfo * tinfo) : tinfo =
+ match ti,ti' with
+ | Var _, _ -> ti'
+ | _,_ -> ti
+
+(** Add a new constraint induced by other constraints. *)
+and add_constraint_int (c : su_constraint) =
+ if (!print_constraints && !debug) then print_constraint c else ();
+ begin
+ match c with
+ | Instantiation _ ->
+ Q.add c inst_worklist
+ | Unification _ ->
+ Q.add c eq_worklist
+ end;
+ if (!debug) then solve_constraints() else ()
+
+(** Add a new constraint introduced through this module's interface (a
+ top-level constraint). *)
+and add_constraint (c : su_constraint) =
+ begin
+ add_constraint_int (c);
+ if (!print_constraints && not (!debug)) then print_constraint c else ();
+ if (!solve_online) then solve_constraints() else ()
+ end
+
+
+(* Fetch constraints, preferring equalities. *)
+and fetch_constraint () : su_constraint option =
+ if (Q.length eq_worklist > 0)
+ then
+ Some (Q.take eq_worklist)
+ else if (Q.length inst_worklist > 0)
+ then
+ Some (Q.take inst_worklist)
+ else
+ None
+
+(** Returns the target of a cached instantiation, if it exists. *)
+and target (t,i,p : tau * int * polarity) : (polarity * tau) option =
+ let cache = get_cache t in
+ if (global_tau t) then Some (Non,t)
+ else
+ try
+ Some (H.find cache i)
+ with
+ | Not_found -> None
+
+(** Caches a new instantiation, or applies well-formedness. *)
+and store ( t,(i,p),t' : tau * (int * polarity) * tau) : bool =
+ let cache = get_cache t in
+ match target(t,i,p) with
+ | Some (p'',t'') ->
+ if (U.equal (t',t'') && (lub(p,p'') = p''))
+ then
+ false
+ else
+ begin
+ add_constraint_int (Unification (t',t''));
+ H.replace cache i (lub(p,p''),t'');
+ (* add a new forced instantiation as well *)
+ if (lub(p,p'') = p'')
+ then ()
+ else
+ begin
+ unstore(t,i);
+ add_constraint_int (Instantiation (t,(i,lub(p,p'')),t''))
+ end;
+ false
+ end
+ | None ->
+ begin
+ H.add cache i (p,t');
+ true
+ end
+
+(** Remove a cached instantiation. Used when type structure changes *)
+and unstore (t,i : tau * int) =
+let cache = get_cache t in
+ H.remove cache i
+
+(** The main solver loop. *)
+and solve_constraints () : unit =
+ match fetch_constraint () with
+ | Some c ->
+ begin
+ (match c with
+ | Instantiation (t,(i,p),t') -> instantiate_int (t,(i,p),t')
+ | Unification (t,t') -> unify_int (t,t')
+ );
+ solve_constraints()
+ end
+ | None -> ()
+
+
+(***********************************************************************)
+(* *)
+(* Interface Functions *)
+(* *)
+(***********************************************************************)
+
+(** Return the contents of the lvalue. *)
+let rvalue (lv : lvalue) : tau =
+ lv.contents
+
+(** Dereference the rvalue. If it does not have enough structure to support
+ the operation, then the correct structure is added via new unification
+ constraints. *)
+let rec deref (t : tau) : lvalue =
+ match U.deref t with
+ | Pair p ->
+ (
+ match U.deref (p.ptr) with
+ | Var _ ->
+ begin
+ (* let points_to = make_pair(fresh_var(),fresh_var()) in *)
+ let points_to = fresh_var() in
+ let l = fresh_label() in
+ let r = make_ref(l,points_to)
+ in
+ add_constraint (Unification (p.ptr,r));
+ make_lval(l, points_to)
+ end
+ | Ref r -> make_lval(r.rl, r.points_to)
+ | _ -> raise (Inconsistent("deref"))
+ )
+ | Var v ->
+ begin
+ add_constraint (Unification (t,make_pair(fresh_var(),fresh_var())));
+ deref t
+ end
+ | _ -> raise (Inconsistent("deref -- no top level pair"))
+
+(** Form the union of [t] and [t']. *)
+let join (t : tau) (t' : tau) : tau =
+ let t'' = fresh_var() in
+ add_constraint (Unification (t,t''));
+ add_constraint (Unification (t',t''));
+ t''
+
+(** Form the union of a list [tl], expected to be the initializers of some
+ structure or array type. *)
+let join_inits (tl : tau list) : tau =
+ let t' = fresh_var() in
+ begin
+ List.iter (function t'' -> add_constraint (Unification(t',t''))) tl;
+ t'
+ end
+
+(** Take the address of an lvalue. Does not add constraints. *)
+let address (lv : lvalue) : tau =
+ make_pair (make_ref (lv.l, lv.contents), fresh_var() )
+
+(** Instantiate a type with index i. By default, uses positive polarity.
+ Adds an instantiation constraint. *)
+let instantiate (lv : lvalue) (i : int) : lvalue =
+ if (!analyze_mono) then lv
+ else
+ begin
+ let l' = fresh_label () in
+ let t' = fresh_var_i () in
+ instantiate_label(lv.l,(i,Pos),l');
+ add_constraint (Instantiation (lv.contents,(i,Pos),t'));
+ make_lval(l',t') (* check -- fresh label ?? *)
+ end
+
+(** Constraint generated from assigning [t] to [lv]. *)
+let assign (lv : lvalue) (t : tau) : unit =
+ add_constraint (Unification (lv.contents,t))
+
+
+(** Project out the first (ref) component or a pair. If the argument [t] has
+ no discovered structure, raise No_contents. *)
+let proj_ref (t : tau) : tau =
+ match U.deref t with
+ | Pair p -> p.ptr
+ | Var v -> raise No_contents
+ | _ -> raise Bad_proj
+
+(* Project out the second (fun) component of a pair. If the argument [t] has
+ no discovered structure, create it on the fly by adding constraints. *)
+let proj_fun (t : tau) : tau =
+ match U.deref t with
+ | Pair p -> p.lam
+ | Var v ->
+ let p,f = fresh_var(), fresh_var() in
+ add_constraint (Unification (t,make_pair(p,f)));
+ f
+ | _ -> raise Bad_proj
+
+let get_args (t : tau) : tau list ref =
+ match U.deref t with
+ | Fun f -> f.args
+ | _ -> raise (Inconsistent("get_args"))
+
+(** Function type [t] is applied to the arguments [actuals]. Unifies the
+ actuals with the formals of [t]. If no functions have been discovered for
+ [t] yet, create a fresh one and unify it with t. The result is the return
+ value of the function. *)
+let apply (t : tau) (al : tau list) : tau =
+ let f = proj_fun(t) in
+ let actuals = ref al in
+ let formals,ret =
+ match U.deref f with
+ | Fun fi -> (fi.args),fi.ret
+ | Var v ->
+ let new_l,new_ret,new_args =
+ fresh_label(), fresh_var (),
+ List.map (function _ -> fresh_var()) (!actuals)
+ in
+ let new_fun = make_fun(new_l,new_args,new_ret) in
+ add_constraint (Unification(new_fun,f));
+ (get_args new_fun,new_ret)
+ | Ref _ -> raise (Inconsistent ("apply_ref"))
+ | Pair _ -> raise (Inconsistent ("apply_pair"))
+ | Wild -> raise (Inconsistent("apply_wild"))
+ in
+ pad_args(formals,actuals);
+ List.iter2 (fun actual -> fun formal ->
+ add_constraint (Unification (actual,formal))
+ ) !actuals !formals;
+ ret
+
+(** Create a new function type with name [name], list of formal arguments
+ [formals], and return value [ret]. Adds no constraints. *)
+let make_function (name : string) (formals : lvalue list) (ret : tau) : tau =
+ let
+ f = make_fun(make_label(name),List.map (fun x -> rvalue x) formals, ret)
+ in
+ make_pair(fresh_var(),f)
+
+(** Create an lvalue. If [is_global] is true, the lvalue will be treated
+ monomorphically. *)
+let make_lvalue (is_global : bool) (name : string) : lvalue =
+ if (!debug && is_global)
+ then
+ Printf.printf "Making global lvalue : %s\n" name
+ else ();
+ make_lval(make_label(name), make_var is_global name)
+
+
+(** Create a fresh non-global named variable. *)
+let make_fresh (name : string) : tau =
+ make_var false (name)
+
+(** The default type for constants. *)
+let bottom () : tau =
+ make_var false ("bottom")
+
+(** Unify the result of a function with its return value. *)
+let return (t : tau) (t' : tau) =
+ add_constraint (Unification (t,t'))
+
+
+(***********************************************************************)
+(* *)
+(* Query/Extract Solutions *)
+(* *)
+(***********************************************************************)
+
+(** Unify the data stored in two label bounds. *)
+let combine_lbounds (s,s' : label boundset * label boundset) =
+ B.union s s'
+
+(** Truncates a list of urefs [l] to those elements up to and including the
+ first occurence of the specified element [elt]. *)
+let truncate l elt =
+ let keep = ref true in
+ List.filter
+ (fun x ->
+ if (not (!keep))
+ then
+ false
+ else
+ begin
+ if (U.equal(x,elt))
+ then
+ keep := false
+ else ();
+ true
+ end
+ ) l
+
+let debug_cycle_bounds is_pos c =
+ let rec debug_cycle_bounds' = function
+ | h :: [] ->
+ Printf.printf "%s --> %s\n" (string_of_bounds is_pos h)
+ (string_of_label2 h)
+ | h :: t ->
+ begin
+ Printf.printf "%s --> %s\n" (string_of_bounds is_pos h)
+ (string_of_label2 h);
+ debug_cycle_bounds' t
+ end
+ | [] -> ()
+ in
+ debug_cycle_bounds' c
+
+(** For debugging, print a cycle of instantiations *)
+let debug_cycle (is_pos,c,l,p) =
+ let kind = if is_pos then "P" else "N" in
+ let rec string_of_cycle = function
+ | h :: [] -> string_of_label2 h
+ | [] -> ""
+ | h :: t -> Printf.sprintf "%s,%s" (string_of_label2 h) (string_of_cycle t)
+ in
+ Printf.printf "Collapsing %s cycle around %s:\n" kind (string_of_label2 l);
+ Printf.printf "Elements are: %s\n" (string_of_cycle c);
+ Printf.printf "Per-element bounds:\n";
+ debug_cycle_bounds is_pos c;
+ Printf.printf "Full path is: %s" (string_of_cycle p);
+ print_newline()
+
+(** Compute pos or neg flow, depending on [is_pos]. Searches for cycles in the
+ instantiations (can these even occur?) and unifies either the positive or
+ negative edge sets for the labels on the cycle. Note that this does not
+ ever unify the labels themselves. The return is the new bounds of the
+ argument label *)
+let rec flow (is_pos : bool) (path : label list) (l : label) : label boundset =
+ let collapse_cycle () =
+ let cycle = truncate path l in
+ debug_cycle (is_pos,cycle,l,path);
+ List.iter (fun x -> U.unify combine_lbounds
+ ((get_bounds is_pos x),get_bounds is_pos l)
+ ) cycle
+ in
+ if (on_path l)
+ then
+ begin
+ collapse_cycle ();
+ (* set_on_path l false; *)
+ B.empty
+ end
+ else
+ if ( (is_pos && (U.deref l).p_cached) ||
+ ( (not is_pos) && (U.deref l).n_cached) ) then
+ begin
+ U.deref (get_bounds is_pos l)
+ end
+ else
+ begin
+ let newbounds = ref B.empty in
+ let base = get_bounds is_pos l in
+ set_on_path l true;
+ if (is_pos) then
+ (U.deref l).p_cached <- true
+ else
+ (U.deref l).n_cached <- true;
+ B.iter
+ (fun x ->
+ if (U.equal(x.info,l)) then ()
+ else
+ (newbounds :=
+ (B.union (!newbounds) (flow is_pos (l :: path) x.info)))
+ ) (U.deref base);
+ set_on_path l false;
+ U.update (base,(B.union (U.deref base) !newbounds));
+ U.deref base
+ end
+
+(** Compute and cache any positive flow. *)
+let pos_flow l : constantset =
+ let result = ref C.empty in
+ begin
+ ignore (flow true [] l);
+ B.iter (fun x -> result := C.union (!result) (U.deref(x.info)).aliases )
+ (U.deref (get_bounds true l));
+ !result
+ end
+
+(** Compute and cache any negative flow. *)
+let neg_flow l : constantset =
+ let result = ref C.empty in
+ begin
+ ignore (flow false [] l);
+ B.iter (fun x -> result := C.union (!result) (U.deref(x.info)).aliases )
+ (U.deref (get_bounds false l));
+ !result
+ end
+
+(** Compute and cache any pos-neg flow. Assumes that both pos_flow and
+ neg_flow have been computed for the label [l]. *)
+let pos_neg_flow(l : label) : constantset =
+ let result = ref C.empty in
+ begin
+ B.iter (fun x -> result := C.union (!result) (pos_flow x.info))
+ (U.deref (get_bounds false l));
+ !result
+ end
+
+(** Compute a points-to set by computing positive, then negative, then
+ positive-negative flow for a label. *)
+let points_to_int (lv : lvalue) : constantset =
+ let visited_caches : cache list ref = ref [] in
+ let rec points_to_tau (t : tau) : constantset =
+ try
+ begin
+ match U.deref (proj_ref t) with
+ | Var v -> C.empty
+ | Ref r ->
+ begin
+ let pos = pos_flow r.rl in
+ let neg = neg_flow r.rl in
+ let interproc = C.union (pos_neg_flow r.rl) (C.union pos neg)
+ in
+ C.union ((U.deref(r.rl)).aliases) interproc
+ end
+ | _ -> raise (Inconsistent ("points_to"))
+ end
+ with
+ | No_contents ->
+ begin
+ match (U.deref t) with
+ | Var v -> rebuild_flow v.v_cache
+ | _ -> raise (Inconsistent ("points_to"))
+ end
+ and rebuild_flow (c : cache) : constantset =
+ if (List.mem c (!visited_caches) ) (* cyclic instantiations *)
+ then
+ begin
+ (* visited_caches := List.tl (!visited_caches); *) (* check *)
+ C.empty
+ end
+ else
+ begin
+ visited_caches := c :: (!visited_caches);
+ let result = ref (C.empty) in
+ H.iter (fun _ -> fun(p,t) ->
+ match p with
+ | Pos -> ()
+ | _ -> result := C.union (!result) (points_to_tau t)
+ ) c;
+ visited_caches := List.tl (!visited_caches);
+ !result
+ end
+ in
+ if (!no_flow) then
+ (U.deref lv.l).aliases
+ else
+ points_to_tau (lv.contents)
+
+let points_to (lv : lvalue) : string list =
+ List.map snd (C.elements (points_to_int lv))
+
+let alias_query (a_progress : bool) (lv : lvalue list) : int * int =
+ (0,0) (* todo *)
+(*
+ let a_count = ref 0 in
+ let ptsets = List.map points_to_int lv in
+ let total_sets = List.length ptsets in
+ let counted_sets = ref 0 in
+ let record_alias s s' =
+ if (C.is_empty (C.inter s s'))
+ then ()
+ else (incr a_count)
+ in
+ let rec check_alias = function
+ | h :: t ->
+ begin
+ List.iter (record_alias h) ptsets;
+ check_alias t
+ end
+ | [] -> ()
+ in
+ check_alias ptsets;
+ !a_count
+*)
diff --git a/cil/src/ext/pta/steensgaard.mli b/cil/src/ext/pta/steensgaard.mli
new file mode 100644
index 0000000..f009e7e
--- /dev/null
+++ b/cil/src/ext/pta/steensgaard.mli
@@ -0,0 +1,71 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(***********************************************************************)
+(* *)
+(* *)
+(* This file is currently unused by CIL. It is included in the *)
+(* distribution for reference only. *)
+(* *)
+(* *)
+(***********************************************************************)
+
+type lvalue
+type tau
+val debug : bool ref
+val debug_constraints : bool ref
+val print_constraints : bool ref
+val no_flow : bool ref
+val no_sub : bool ref
+val analyze_mono : bool ref
+val solve_online : bool ref
+val solve_constraints : unit -> unit
+val rvalue : lvalue -> tau
+val deref : tau -> lvalue
+val join : tau -> tau -> tau
+val join_inits : tau list -> tau
+val address : lvalue -> tau
+val instantiate : lvalue -> int -> lvalue
+val assign : lvalue -> tau -> unit
+val apply : tau -> tau list -> tau
+val make_function : string -> lvalue list -> tau -> tau
+val make_lvalue : bool -> string -> lvalue
+val bottom : unit -> tau
+val return : tau -> tau -> unit
+val make_fresh : string -> tau
+val points_to : lvalue -> string list
+val string_of_lvalue : lvalue -> string
+val global_lvalue : lvalue -> bool
+val alias_query : bool -> lvalue list -> int * int
diff --git a/cil/src/ext/pta/uref.ml b/cil/src/ext/pta/uref.ml
new file mode 100644
index 0000000..53f3640
--- /dev/null
+++ b/cil/src/ext/pta/uref.ml
@@ -0,0 +1,94 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+exception Bad_find
+
+type 'a urefC =
+ Ecr of 'a * int
+ | Link of 'a uref
+and 'a uref = 'a urefC ref
+
+let rec find p =
+ match !p with
+ | Ecr _ -> p
+ | Link p' ->
+ let p'' = find p'
+ in p := Link p''; p''
+
+let uref x = ref (Ecr(x,0))
+
+let equal (p,p') = (find p == find p')
+
+let deref p =
+ match ! (find p) with
+ | Ecr (x,_) -> x
+ | _ -> raise Bad_find
+
+let update (p,x) =
+ let p' = find p
+ in
+ match !p' with
+ | Ecr (_,rank) -> p' := Ecr(x,rank)
+ | _ -> raise Bad_find
+
+let unify f (p,q) =
+ let p',q' = find p, find q in
+ match (!p',!q') with
+ | (Ecr(px,pr),Ecr(qx,qr)) ->
+ let x = f(px,qx) in
+ if (p' == q') then
+ p' := Ecr(x,pr)
+ else if pr == qr then
+ (q' := Ecr(x,qr+1); p' := Link q')
+ else if pr < qr then
+ (q' := Ecr(x,qr); p' := Link q')
+ else (* pr > qr *)
+ (p' := Ecr(x,pr); q' := Link p')
+ | _ -> raise Bad_find
+
+let union (p,q) =
+ let p',q' = find p, find q in
+ match (!p',!q') with
+ | (Ecr(px,pr),Ecr(qx,qr)) ->
+ if (p' == q') then
+ ()
+ else if pr == qr then
+ (q' := Ecr(qx, qr+1); p' := Link q')
+ else if pr < qr then
+ p' := Link q'
+ else (* pr > qr *)
+ q' := Link p'
+ | _ -> raise Bad_find
+
+
diff --git a/cil/src/ext/pta/uref.mli b/cil/src/ext/pta/uref.mli
new file mode 100644
index 0000000..1dee503
--- /dev/null
+++ b/cil/src/ext/pta/uref.mli
@@ -0,0 +1,65 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * John Kodumal <jkodumal@eecs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+type 'a uref
+
+(** Union-find with union by rank and path compression
+
+ This is an implementation of Tarjan's union-find data structure using
+ generics. The interface is analagous to standard references, with the
+ addition of a union operation which makes two references indistinguishable.
+
+*)
+
+val uref: 'a -> 'a uref
+ (** Create a new uref *)
+
+val equal: 'a uref * 'a uref -> bool
+ (** Test whether two urefs share the same equivalence class *)
+
+val deref: 'a uref -> 'a
+ (** Extract the contents of this reference *)
+
+val update: 'a uref * 'a -> unit
+ (** Update the value stored in this reference *)
+
+val unify: ('a * 'a -> 'a) -> 'a uref * 'a uref -> unit
+ (** [unify f (p,q)] unifies references [p] and [q], making them
+ indistinguishable. The contents of the reference are the result of
+ [f] *)
+
+val union: 'a uref * 'a uref -> unit
+ (** [unify (p,q)] unifies references [p] and [q], making them
+ indistinguishable. The contents of the reference are the contents of
+ one of the first or second arguments (unspecified) *)
diff --git a/cil/src/ext/reachingdefs.ml b/cil/src/ext/reachingdefs.ml
new file mode 100644
index 0000000..b6af37c
--- /dev/null
+++ b/cil/src/ext/reachingdefs.ml
@@ -0,0 +1,511 @@
+(* Calculate reaching definitions for each instruction.
+ * Determine when it is okay to replace some variables with
+ * expressions.
+ *
+ * After calling computeRDs on a fundec,
+ * ReachingDef.stmtStartData will contain a mapping from
+ * statement ids to data about which definitions reach each
+ * statement. ReachingDef.defIdStmtHash will contain a
+ * mapping from definition ids to the statement in which
+ * that definition takes place.
+ *
+ * instrRDs takes a list of instructions, and the
+ * definitions that reach the first instruction, and
+ * for each instruction figures out which definitions
+ * reach into or out of each instruction.
+ *
+ *)
+
+open Cil
+open Pretty
+
+module E = Errormsg
+module DF = Dataflow
+module UD = Usedef
+module IH = Inthash
+module U = Util
+module S = Stats
+
+let debug_fn = ref ""
+
+module IOS =
+ Set.Make(struct
+ type t = int option
+ let compare io1 io2 =
+ match io1, io2 with
+ Some i1, Some i2 -> Pervasives.compare i1 i2
+ | Some i1, None -> 1
+ | None, Some i2 -> -1
+ | None, None -> 0
+ end)
+
+let debug = ref false
+
+(* return the intersection of
+ Inthashes ih1 and ih2 *)
+let ih_inter ih1 ih2 =
+ let ih' = IH.copy ih1 in
+ IH.iter (fun id vi ->
+ if not(IH.mem ih2 id) then
+ IH.remove ih' id else
+ ()) ih1;
+ ih'
+
+let ih_union ih1 ih2 =
+ let ih' = IH.copy ih1 in
+ IH.iter (fun id vi ->
+ if not(IH.mem ih' id)
+ then IH.add ih' id vi
+ else ()) ih2;
+ ih'
+
+(* Lookup varinfo in iosh. If the set contains None
+ or is not a singleton, return None, otherwise
+ return Some of the singleton *)
+(* IOS.t IH.t -> varinfo -> int option *)
+let iosh_singleton_lookup iosh vi =
+ if IH.mem iosh vi.vid then
+ let ios = IH.find iosh vi.vid in
+ if not (IOS.cardinal ios = 1) then None
+ else IOS.choose ios
+ else None
+
+(* IOS.t IH.t -> varinfo -> IOS.t *)
+let iosh_lookup iosh vi =
+ if IH.mem iosh vi.vid
+ then Some(IH.find iosh vi.vid)
+ else None
+
+(* return Some(vid) if iosh contains defId.
+ return None otherwise *)
+(* IOS.t IH.t -> int -> int option *)
+let iosh_defId_find iosh defId =
+ (* int -> IOS.t -> int option -> int option*)
+ let get_vid vid ios io =
+ match io with
+ Some(i) -> Some(i)
+ | None ->
+ let there = IOS.exists
+ (function None -> false
+ | Some(i') -> defId = i') ios in
+ if there then Some(vid) else None
+ in
+ IH.fold get_vid iosh None
+
+(* The resulting iosh will contain the
+ union of the same entries from iosh1 and
+ iosh2. If iosh1 has an entry that iosh2
+ does not, then the result will contain
+ None in addition to the things from the
+ entry in iosh1. *)
+(* XXX this function is a performance bottleneck *)
+let iosh_combine iosh1 iosh2 =
+ let iosh' = IH.copy iosh1 in
+ IH.iter (fun id ios1 ->
+ try let ios2 = IH.find iosh2 id in
+ let newset = IOS.union ios1 ios2 in
+ IH.replace iosh' id newset;
+ with Not_found ->
+ let newset = IOS.add None ios1 in
+ IH.replace iosh' id newset) iosh1;
+ IH.iter (fun id ios2 ->
+ if not(IH.mem iosh1 id) then
+ let newset = IOS.add None ios2 in
+ IH.add iosh' id newset) iosh2;
+ iosh'
+
+
+(* determine if two IOS.t IH.t s are the same *)
+let iosh_equals iosh1 iosh2 =
+(* if IH.length iosh1 = 0 && not(IH.length iosh2 = 0) ||
+ IH.length iosh2 = 0 && not(IH.length iosh1 = 0)*)
+ if not(IH.length iosh1 = IH.length iosh2)
+ then
+ (if !debug then ignore(E.log "iosh_equals: length not same\n");
+ false)
+ else
+ IH.fold (fun vid ios b ->
+ if not b then b else
+ try let ios2 = IH.find iosh2 vid in
+ if not(IOS.compare ios ios2 = 0) then
+ (if !debug then ignore(E.log "iosh_equals: sets for vid %d not equal\n" vid);
+ false)
+ else true
+ with Not_found ->
+ (if !debug then ignore(E.log "iosh_equals: vid %d not in iosh2\n" vid);
+ false)) iosh1 true
+
+(* replace an entire set with a singleton.
+ if nothing was there just add the singleton *)
+(* IOS.t IH.t -> int -> varinfo -> unit *)
+let iosh_replace iosh i vi =
+ if IH.mem iosh vi.vid then
+ let newset = IOS.singleton (Some i) in
+ IH.replace iosh vi.vid newset
+ else
+ let newset = IOS.singleton (Some i) in
+ IH.add iosh vi.vid newset
+
+(* remove definitions that are killed.
+ add definitions that are gend *)
+(* Takes the defs, the data, and a function for
+ obtaining the next def id *)
+(* VS.t -> IOS.t IH.t -> (unit->int) -> unit *)
+let proc_defs vs iosh f =
+ let pd vi =
+ let newi = f() in
+ (*if !debug then
+ ignore (E.log "proc_defs: genning %d\n" newi);*)
+ iosh_replace iosh newi vi
+ in
+ UD.VS.iter pd vs
+
+let idMaker () start =
+ let counter = ref start in
+ fun () ->
+ let ret = !counter in
+ counter := !counter + 1;
+ ret
+
+(* given reaching definitions into a list of
+ instructions, figure out the definitions that
+ reach in/out of each instruction *)
+(* if out is true then calculate the definitions that
+ go out of each instruction, if it is false then
+ calculate the definitions reaching into each instruction *)
+(* instr list -> int -> (varinfo IH.t * int) -> bool -> (varinfo IH.t * int) list *)
+let iRDsHtbl = Hashtbl.create 128
+let instrRDs il sid (ivih, s, iosh) out =
+ if Hashtbl.mem iRDsHtbl (sid,out) then Hashtbl.find iRDsHtbl (sid,out) else
+
+(* let print_instr i (_,s', iosh') = *)
+(* let d = d_instr () i ++ line in *)
+(* fprint stdout 80 d; *)
+(* flush stdout *)
+(* in *)
+
+ let proc_one hil i =
+ match hil with
+ | [] ->
+ let _, defd = UD.computeUseDefInstr i in
+ if UD.VS.is_empty defd
+ then ((*if !debug then print_instr i ((), s, iosh);*)
+ [((), s, iosh)])
+ else
+ let iosh' = IH.copy iosh in
+ proc_defs defd iosh' (idMaker () s);
+ (*if !debug then
+ print_instr i ((), s + UD.VS.cardinal defd, iosh');*)
+ ((), s + UD.VS.cardinal defd, iosh')::hil
+ | (_, s', iosh')::hrst as l ->
+ let _, defd = UD.computeUseDefInstr i in
+ if UD.VS.is_empty defd
+ then
+ ((*if !debug then
+ print_instr i ((),s', iosh');*)
+ ((), s', iosh')::l)
+ else let iosh'' = IH.copy iosh' in
+ proc_defs defd iosh'' (idMaker () s');
+ (*if !debug then
+ print_instr i ((), s' + UD.VS.cardinal defd, iosh'');*)
+ ((),s' + UD.VS.cardinal defd, iosh'')::l
+ in
+ let folded = List.fold_left proc_one [((),s,iosh)] il in
+ let foldedout = List.tl (List.rev folded) in
+ let foldednotout = List.rev (List.tl folded) in
+ Hashtbl.add iRDsHtbl (sid,true) foldedout;
+ Hashtbl.add iRDsHtbl (sid,false) foldednotout;
+ if out then foldedout else foldednotout
+
+
+
+(* The right hand side of an assignment is either
+ a function call or an expression *)
+type rhs = RDExp of exp | RDCall of instr
+
+(* take the id number of a definition and return
+ the rhs of the definition if there is one.
+ Returns None if, for example, the definition is
+ caused by an assembly instruction *)
+(* stmt IH.t -> (()*int*IOS.t IH.t) IH.t -> int -> (rhs * int * IOS.t IH.t) option *)
+let rhsHtbl = IH.create 64 (* to avoid recomputation *)
+let getDefRhs didstmh stmdat defId =
+ if IH.mem rhsHtbl defId then IH.find rhsHtbl defId else
+ let stm =
+ try IH.find didstmh defId
+ with Not_found -> E.s (E.error "getDefRhs: defId %d not found\n" defId) in
+ let (_,s,iosh) =
+ try IH.find stmdat stm.sid
+ with Not_found -> E.s (E.error "getDefRhs: sid %d not found \n" stm.sid) in
+ match stm.skind with
+ Instr il ->
+ let ivihl = instrRDs il stm.sid ((),s,iosh) true in (* defs that reach out of each instr *)
+ let ivihl_in = instrRDs il stm.sid ((),s,iosh) false in (* defs that reach into each instr *)
+ let iihl = List.combine (List.combine il ivihl) ivihl_in in
+ (try let ((i,(_,_,diosh)),(_,_,iosh_in)) = List.find (fun ((i,(_,_,iosh')),_) ->
+ match S.time "iosh_defId_find" (iosh_defId_find iosh') defId with
+ Some vid ->
+ (match i with
+ Set((Var vi',NoOffset),_,_) -> vi'.vid = vid (* _ -> NoOffset *)
+ | Call(Some(Var vi',NoOffset),_,_,_) -> vi'.vid = vid (* _ -> NoOffset *)
+ | Call(None,_,_,_) -> false
+ | Asm(_,_,sll,_,_,_) -> List.exists
+ (function (_,(Var vi',NoOffset)) -> vi'.vid = vid | _ -> false) sll
+ | _ -> false)
+ | None -> false) iihl in
+ (match i with
+ Set((lh,_),e,_) ->
+ (match lh with
+ Var(vi') ->
+ (IH.add rhsHtbl defId (Some(RDExp(e),stm.sid,iosh_in));
+ Some(RDExp(e), stm.sid, iosh_in))
+ | _ -> E.s (E.error "Reaching Defs getDefRhs: right vi not first\n"))
+ | Call(lvo,e,el,_) ->
+ (IH.add rhsHtbl defId (Some(RDCall(i),stm.sid,iosh_in));
+ Some(RDCall(i), stm.sid, iosh_in))
+ | Asm(a,sl,slvl,sel,sl',_) -> None) (* ? *)
+ with Not_found ->
+ (if !debug then ignore (E.log "getDefRhs: No instruction defines %d\n" defId);
+ IH.add rhsHtbl defId None;
+ None))
+ | _ -> E.s (E.error "getDefRhs: defining statement not an instruction list %d\n" defId)
+ (*None*)
+
+let prettyprint didstmh stmdat () (_,s,iosh) = text ""
+ (*seq line (fun (vid,ios) ->
+ num vid ++ text ": " ++
+ IOS.fold (fun io d -> match io with
+ None -> d ++ text "None "
+ | Some i ->
+ let stm = IH.find didstmh i in
+ match getDefRhs didstmh stmdat i with
+ None -> d ++ num i
+ | Some(RDExp(e),_,_) ->
+ d ++ num i ++ text " " ++ (d_exp () e)
+ | Some(RDCall(c),_,_) ->
+ d ++ num i ++ text " " ++ (d_instr () c))
+ ios nil)
+ (IH.tolist iosh)*)
+
+module ReachingDef =
+ struct
+
+ let name = "Reaching Definitions"
+
+ let debug = debug
+
+ (* Should the analysis calculate may-reach
+ or must-reach *)
+ let mayReach = ref false
+
+
+ (* An integer that tells the id number of
+ the first definition *)
+ (* Also a hash from variable ids to a set of
+ definition ids that reach this statement.
+ None means there is a path to this point on which
+ there is no definition of the variable *)
+ type t = (unit * int * IOS.t IH.t)
+
+ let copy (_, i, iosh) = ((), i, IH.copy iosh)
+
+ (* entries for starting statements must
+ be added before calling compute *)
+ let stmtStartData = IH.create 32
+
+ (* a mapping from definition ids to
+ the statement corresponding to that id *)
+ let defIdStmtHash = IH.create 32
+
+ (* mapping from statement ids to statements
+ for better performance of ok_to_replace *)
+ let sidStmtHash = IH.create 64
+
+ (* pretty printer *)
+ let pretty = prettyprint defIdStmtHash stmtStartData
+
+
+ (* The first id to use when computeFirstPredecessor
+ is next called *)
+ let nextDefId = ref 0
+
+ (* Count the number of variable definitions in
+ a statement *)
+ let num_defs stm =
+ match stm.skind with
+ Instr(il) -> List.fold_left (fun s i ->
+ let _, d = UD.computeUseDefInstr i in
+ s + UD.VS.cardinal d) 0 il
+ | _ -> let _, d = UD.computeUseDefStmtKind stm.skind in
+ UD.VS.cardinal d
+
+ (* the first predecessor is just the data in along with
+ the id of the first definition of the statement,
+ which we get from nextDefId *)
+ let computeFirstPredecessor stm (_, s, iosh) =
+ let startDefId = max !nextDefId s in
+ let numds = num_defs stm in
+ let rec loop n =
+ if n < 0
+ then ()
+ else
+ (if !debug then
+ ignore (E.log "RD: defId %d -> stm %d\n" (startDefId + n) stm.sid);
+ IH.add defIdStmtHash (startDefId + n) stm;
+ loop (n-1))
+ in
+ loop (numds - 1);
+ nextDefId := startDefId + numds;
+ ((), startDefId, IH.copy iosh)
+
+
+ let combinePredecessors (stm:stmt) ~(old:t) ((_, s, iosh):t) =
+ match old with (_, os, oiosh) ->
+ if S.time "iosh_equals" (iosh_equals oiosh) iosh then None else
+ Some((), os, S.time "iosh_combine" (iosh_combine oiosh) iosh)
+
+ (* return an action that removes things that
+ are redefinied and adds the generated defs *)
+ let doInstr inst (_, s, iosh) =
+ let transform (_, s', iosh') =
+ let _, defd = UD.computeUseDefInstr inst in
+ proc_defs defd iosh' (idMaker () s');
+ ((), s' + UD.VS.cardinal defd, iosh')
+ in
+ DF.Post transform
+
+ (* all the work gets done at the instruction level *)
+ let doStmt stm (_, s, iosh) =
+ if not(IH.mem sidStmtHash stm.sid) then
+ IH.add sidStmtHash stm.sid stm;
+ if !debug then ignore(E.log "RD: looking at %a\n" d_stmt stm);
+ DF.SDefault
+
+ let doGuard condition _ = DF.GDefault
+
+ let filterStmt stm = true
+
+end
+
+module RD = DF.ForwardsDataFlow(ReachingDef)
+
+(* map all variables in vil to a set containing
+ None in iosh *)
+(* IOS.t IH.t -> varinfo list -> () *)
+let iosh_none_fill iosh vil =
+ List.iter (fun vi ->
+ IH.add iosh vi.vid (IOS.singleton None))
+ vil
+
+(* Computes the reaching definitions for a
+ function. *)
+(* Cil.fundec -> unit *)
+let computeRDs fdec =
+ try
+ if compare fdec.svar.vname (!debug_fn) = 0 then
+ (debug := true;
+ ignore (E.log "%s =\n%a\n" (!debug_fn) d_block fdec.sbody));
+ let bdy = fdec.sbody in
+ let slst = bdy.bstmts in
+ let _ = IH.clear ReachingDef.stmtStartData in
+ let _ = IH.clear ReachingDef.defIdStmtHash in
+ let _ = IH.clear rhsHtbl in
+ let _ = Hashtbl.clear iRDsHtbl in
+ let _ = ReachingDef.nextDefId := 0 in
+ let fst_stm = List.hd slst in
+ let fst_iosh = IH.create 32 in
+ let _ = UD.onlyNoOffsetsAreDefs := false in
+ (*let _ = iosh_none_fill fst_iosh fdec.sformals in*)
+ let _ = IH.add ReachingDef.stmtStartData fst_stm.sid ((), 0, fst_iosh) in
+ let _ = ReachingDef.computeFirstPredecessor fst_stm ((), 0, fst_iosh) in
+ if !debug then
+ ignore (E.log "computeRDs: fst_stm.sid=%d\n" fst_stm.sid);
+ RD.compute [fst_stm];
+ if compare fdec.svar.vname (!debug_fn) = 0 then
+ debug := false
+ (* now ReachingDef.stmtStartData has the reaching def data in it *)
+ with Failure "hd" -> if compare fdec.svar.vname (!debug_fn) = 0 then
+ debug := false
+
+(* return the definitions that reach the statement
+ with statement id sid *)
+let getRDs sid =
+ try
+ Some (IH.find ReachingDef.stmtStartData sid)
+ with Not_found ->
+ None
+(* E.s (E.error "getRDs: sid %d not found\n" sid) *)
+
+let getDefIdStmt defid =
+ try
+ Some(IH.find ReachingDef.defIdStmtHash defid)
+ with Not_found ->
+ None
+
+let getStmt sid =
+ try Some(IH.find ReachingDef.sidStmtHash sid)
+ with Not_found -> None
+
+(* Pretty print the reaching definition data for
+ a function *)
+let ppFdec fdec =
+ seq line (fun stm ->
+ let ivih = IH.find ReachingDef.stmtStartData stm.sid in
+ ReachingDef.pretty () ivih) fdec.sbody.bstmts
+
+
+(* If this class is extended with a visitor on expressions,
+ then the current rd data is available at each expression *)
+class rdVisitorClass = object (self)
+ inherit nopCilVisitor
+
+ (* the statement being worked on *)
+ val mutable sid = -1
+
+ (* if a list of instructions is being processed,
+ then this is the corresponding list of
+ reaching definitions *)
+ val mutable rd_dat_lst = []
+
+ (* these are the reaching defs for the current
+ instruction if there is one *)
+ val mutable cur_rd_dat = None
+
+ method vstmt stm =
+ sid <- stm.sid;
+ match getRDs sid with
+ None ->
+ if !debug then ignore(E.log "rdVis: stm %d had no data\n" sid);
+ cur_rd_dat <- None;
+ DoChildren
+ | Some(_,s,iosh) ->
+ match stm.skind with
+ Instr il ->
+ if !debug then ignore(E.log "rdVis: visit il\n");
+ rd_dat_lst <- instrRDs il stm.sid ((),s,iosh) false;
+ DoChildren
+ | _ ->
+ if !debug then ignore(E.log "rdVis: visit non-il\n");
+ cur_rd_dat <- None;
+ DoChildren
+
+ method vinst i =
+ if !debug then ignore(E.log "rdVis: before %a, rd_dat_lst is %d long\n"
+ d_instr i (List.length rd_dat_lst));
+ try
+ cur_rd_dat <- Some(List.hd rd_dat_lst);
+ rd_dat_lst <- List.tl rd_dat_lst;
+ DoChildren
+ with Failure "hd" ->
+ if !debug then ignore(E.log "rdVis: il rd_dat_lst mismatch\n");
+ DoChildren
+
+ method get_cur_iosh () =
+ match cur_rd_dat with
+ None -> (match getRDs sid with
+ None -> None
+ | Some(_,_,iosh) -> Some iosh)
+ | Some(_,_,iosh) -> Some iosh
+
+end
+
diff --git a/cil/src/ext/sfi.ml b/cil/src/ext/sfi.ml
new file mode 100755
index 0000000..9886526
--- /dev/null
+++ b/cil/src/ext/sfi.ml
@@ -0,0 +1,337 @@
+(*
+ *
+ * Copyright (c) 2005,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** This is a module that inserts runtime checks for memory reads/writes and
+ * allocations *)
+
+open Pretty
+open Cil
+module E = Errormsg
+module H = Hashtbl
+
+let doSfi = ref false
+let doSfiReads = ref false
+let doSfiWrites = ref true
+
+(* A number of functions to be skipped *)
+let skipFunctions : (string, unit) H.t = H.create 13
+let mustSfiFunction (f: fundec) : bool =
+ not (H.mem skipFunctions f.svar.vname)
+
+(** Some functions are known to be allocators *)
+type dataLocation =
+ InResult (* Interesting data is in the return value *)
+ | InArg of int (* in the nth argument. Starts from 1. *)
+ | InArgTimesArg of int * int (* (for size) data is the product of two
+ * arguments *)
+ | PointedToByArg of int (* pointed to by nth argument *)
+
+(** Compute the data based on the location and the actual argument list *)
+let extractData (dl: dataLocation) (args: exp list) (res: lval option) : exp =
+ let getArg (n: int) =
+ try List.nth args (n - 1) (* Args are based at 1 *)
+ with _ -> E.s (E.bug "Cannot extract argument %d at %a"
+ n d_loc !currentLoc)
+ in
+ match dl with
+ InResult -> begin
+ match res with
+ None ->
+ E.s (E.bug "Cannot extract InResult data (at %a)" d_loc !currentLoc)
+ | Some r -> Lval r
+ end
+ | InArg n -> getArg n
+ | InArgTimesArg (n1, n2) ->
+ let a1 = getArg n1 in
+ let a2 = getArg n2 in
+ BinOp(Mult, mkCast ~e:a1 ~newt:longType,
+ mkCast ~e:a2 ~newt:longType, longType)
+ | PointedToByArg n ->
+ let a = getArg n in
+ Lval (mkMem a NoOffset)
+
+
+
+(* for each allocator, where is the length and where is the result *)
+let allocators: (string, (dataLocation * dataLocation)) H.t = H.create 13
+let _ =
+ H.add allocators "malloc" (InArg 1, InResult);
+ H.add allocators "calloc" (InArgTimesArg (1, 2), InResult);
+ H.add allocators "realloc" (InArg 2, InResult)
+
+(* for each deallocator, where is the data being deallocated *)
+let deallocators: (string, dataLocation) H.t = H.create 13
+let _=
+ H.add deallocators "free" (InArg 1);
+ H.add deallocators "realloc" (InArg 1)
+
+(* Returns true if the given lvalue offset ends in a bitfield access. *)
+let rec is_bitfield lo = match lo with
+ | NoOffset -> false
+ | Field(fi,NoOffset) -> not (fi.fbitfield = None)
+ | Field(_,lo) -> is_bitfield lo
+ | Index(_,lo) -> is_bitfield lo
+
+(* Return an expression that evaluates to the address of the given lvalue.
+ * For most lvalues, this is merely AddrOf(lv). However, for bitfields
+ * we do some offset gymnastics.
+ *)
+let addr_of_lv (lv: lval) =
+ let lh, lo = lv in
+ if is_bitfield lo then begin
+ (* we figure out what the address would be without the final bitfield
+ * access, and then we add in the offset of the bitfield from the
+ * beginning of its enclosing comp *)
+ let rec split_offset_and_bitfield lo = match lo with
+ | NoOffset -> failwith "logwrites: impossible"
+ | Field(fi,NoOffset) -> (NoOffset,fi)
+ | Field(e,lo) -> let a,b = split_offset_and_bitfield lo in
+ ((Field(e,a)),b)
+ | Index(e,lo) -> let a,b = split_offset_and_bitfield lo in
+ ((Index(e,a)),b)
+ in
+ let new_lv_offset, bf = split_offset_and_bitfield lo in
+ let new_lv = (lh, new_lv_offset) in
+ let enclosing_type = TComp(bf.fcomp, []) in
+ let bits_offset, bits_width =
+ bitsOffset enclosing_type (Field(bf,NoOffset)) in
+ let bytes_offset = bits_offset / 8 in
+ let lvPtr = mkCast ~e:(mkAddrOf (new_lv)) ~newt:(charPtrType) in
+ (BinOp(PlusPI, lvPtr, (integer bytes_offset), ulongType))
+ end else
+ (mkAddrOf (lh,lo))
+
+
+let mustLogLval (forwrite: bool) (lv: lval) : bool =
+ match lv with
+ Var v, off -> (* Inside a variable. We assume the array offsets are fine *)
+ false
+ | Mem e, off ->
+ if forwrite && not !doSfiWrites then
+ false
+ else if not forwrite && not !doSfiReads then
+ false
+
+ (* If this is an lval of function type, we do not log it *)
+ else if isFunctionType (typeOfLval lv) then
+ false
+ else
+ true
+
+(* Create prototypes for the logging functions *)
+let mkProto (name: string) (args: (string * typ * attributes) list) =
+ let fdec = emptyFunction name in
+ fdec.svar.vtype <- TFun(voidType,
+ Some args, false, []);
+ fdec
+
+
+let logReads = mkProto "logRead" [ ("addr", voidPtrType, []);
+ ("what", charPtrType, []);
+ ("file", charPtrType, []);
+ ("line", intType, []) ]
+let callLogRead (lv: lval) =
+ let what = Pretty.sprint 80 (d_lval () lv) in
+ Call(None,
+ Lval(Var(logReads.svar),NoOffset),
+ [ addr_of_lv lv; mkString what; mkString !currentLoc.file;
+ integer !currentLoc.line], !currentLoc )
+
+let logWrites = mkProto "logWrite" [ ("addr", voidPtrType, []);
+ ("what", charPtrType, []);
+ ("file", charPtrType, []);
+ ("line", intType, []) ]
+let callLogWrite (lv: lval) =
+ let what = Pretty.sprint 80 (d_lval () lv) in
+ Call(None,
+ Lval(Var(logWrites.svar), NoOffset),
+ [ addr_of_lv lv; mkString what; mkString !currentLoc.file;
+ integer !currentLoc.line], !currentLoc )
+
+let logStackFrame = mkProto "logStackFrame" [ ("func", charPtrType, []) ]
+let callLogStack (fname: string) =
+ Call(None,
+ Lval(Var(logStackFrame.svar), NoOffset),
+ [ mkString fname; ], !currentLoc )
+
+let logAlloc = mkProto "logAlloc" [ ("addr", voidPtrType, []);
+ ("size", intType, []);
+ ("file", charPtrType, []);
+ ("line", intType, []) ]
+let callLogAlloc (szloc: dataLocation)
+ (resLoc: dataLocation)
+ (args: exp list)
+ (res: lval option) =
+ let sz = extractData szloc args res in
+ let res = extractData resLoc args res in
+ Call(None,
+ Lval(Var(logAlloc.svar), NoOffset),
+ [ res; sz; mkString !currentLoc.file;
+ integer !currentLoc.line ], !currentLoc )
+
+
+let logFree = mkProto "logFree" [ ("addr", voidPtrType, []);
+ ("file", charPtrType, []);
+ ("line", intType, []) ]
+let callLogFree (dataloc: dataLocation)
+ (args: exp list)
+ (res: lval option) =
+ let data = extractData dataloc args res in
+ Call(None,
+ Lval(Var(logFree.svar), NoOffset),
+ [ data; mkString !currentLoc.file;
+ integer !currentLoc.line ], !currentLoc )
+
+class sfiVisitorClass : Cil.cilVisitor = object (self)
+ inherit nopCilVisitor
+
+ method vexpr (e: exp) : exp visitAction =
+ match e with
+ Lval lv when mustLogLval false lv -> (* A read *)
+ self#queueInstr [ callLogRead lv ];
+ DoChildren
+
+ | _ -> DoChildren
+
+
+ method vinst (i: instr) : instr list visitAction =
+ match i with
+ Set(lv, e, l) when mustLogLval true lv ->
+ self#queueInstr [ callLogWrite lv ];
+ DoChildren
+
+ | Call(lvo, f, args, l) ->
+ (* Instrument the write *)
+ (match lvo with
+ Some lv when mustLogLval true lv ->
+ self#queueInstr [ callLogWrite lv ]
+ | _ -> ());
+ (* Do the expressions in the call, and then see if we need to
+ * instrument the function call *)
+ ChangeDoChildrenPost
+ ([i],
+ (fun il ->
+ currentLoc := l;
+ match f with
+ Lval (Var fv, NoOffset) -> begin
+ (* Is it an allocator? *)
+ try
+ let szloc, resloc = H.find allocators fv.vname in
+ il @ [callLogAlloc szloc resloc args lvo]
+ with Not_found -> begin
+ (* Is it a deallocator? *)
+ try
+ let resloc = H.find deallocators fv.vname in
+ il @ [ callLogFree resloc args lvo ]
+ with Not_found ->
+ il
+ end
+ end
+ | _ -> il))
+
+ | _ -> DoChildren
+
+ method vfunc (fdec: fundec) =
+ (* Instead a stack log at the start of a function *)
+ ChangeDoChildrenPost
+ (fdec,
+ fun fdec ->
+ fdec.sbody <-
+ mkBlock
+ [ mkStmtOneInstr (callLogStack fdec.svar.vname);
+ mkStmt (Block fdec.sbody) ];
+ fdec)
+
+end
+
+let doit (f: file) =
+ let sfiVisitor = new sfiVisitorClass in
+ let compileLoc (l: location) = function
+ ACons("inres", []) -> InResult
+ | ACons("inarg", [AInt n]) -> InArg n
+ | ACons("inargxarg", [AInt n1; AInt n2]) -> InArgTimesArg (n1, n2)
+ | ACons("pointedby", [AInt n]) -> PointedToByArg n
+ | _ -> E.warn "Invalid location at %a" d_loc l;
+ InResult
+ in
+ iterGlobals f
+ (fun glob ->
+ match glob with
+ GFun(fdec, _) when mustSfiFunction fdec ->
+ ignore (visitCilFunction sfiVisitor fdec)
+ | GPragma(Attr("sfiignore", al), l) ->
+ List.iter
+ (function AStr fn -> H.add skipFunctions fn ()
+ | _ -> E.warn "Invalid argument in \"sfiignore\" pragma at %a"
+ d_loc l)
+ al
+
+ | GPragma(Attr("sfialloc", al), l) -> begin
+ match al with
+ AStr fname :: locsz :: locres :: [] ->
+ H.add allocators fname (compileLoc l locsz, compileLoc l locres)
+ | _ -> E.warn "Invalid sfialloc pragma at %a" d_loc l
+ end
+
+ | GPragma(Attr("sfifree", al), l) -> begin
+ match al with
+ AStr fname :: locwhat :: [] ->
+ H.add deallocators fname (compileLoc l locwhat)
+ | _ -> E.warn "Invalid sfifree pragma at %a" d_loc l
+ end
+
+
+ | _ -> ());
+ (* Now add the prototypes for the instrumentation functions *)
+ f.globals <-
+ GVarDecl (logReads.svar, locUnknown) ::
+ GVarDecl (logWrites.svar, locUnknown) ::
+ GVarDecl (logStackFrame.svar, locUnknown) ::
+ GVarDecl (logAlloc.svar, locUnknown) ::
+ GVarDecl (logFree.svar, locUnknown) :: f.globals
+
+
+let feature : featureDescr =
+ { fd_name = "sfi";
+ fd_enabled = doSfi;
+ fd_description = "instrument memory operations";
+ fd_extraopt = [
+ "--sfireads", Arg.Set doSfiReads, "SFI for reads";
+ "--sfiwrites", Arg.Set doSfiWrites, "SFI for writes";
+ ];
+ fd_doit = doit;
+ fd_post_check = true;
+ }
+
diff --git a/cil/src/ext/simplemem.ml b/cil/src/ext/simplemem.ml
new file mode 100644
index 0000000..1b27815
--- /dev/null
+++ b/cil/src/ext/simplemem.ml
@@ -0,0 +1,132 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(*
+ * Simplemem: Transform a program so that all memory expressions are
+ * "simple". Introduce well-typed temporaries to hold intermediate values
+ * for expressions that would normally involve more than one memory
+ * reference.
+ *
+ * If simplemem succeeds, each lvalue should contain only one Mem()
+ * constructor.
+ *)
+open Cil
+
+(* current context: where should we put our temporaries? *)
+let thefunc = ref None
+
+(* build up a list of assignments to temporary variables *)
+let assignment_list = ref []
+
+(* turn "int a[5][5]" into "int ** temp" *)
+let rec array_to_pointer tau =
+ match unrollType tau with
+ TArray(dest,_,al) -> TPtr(array_to_pointer dest,al)
+ | _ -> tau
+
+(* create a temporary variable in the current function *)
+let make_temp tau =
+ let tau = array_to_pointer tau in
+ match !thefunc with
+ Some(fundec) -> makeTempVar fundec ~name:("mem_") tau
+ | None -> failwith "simplemem: temporary needed outside a function"
+
+(* separate loffsets into "scalar addition parts" and "memory parts" *)
+let rec separate_loffsets lo =
+ match lo with
+ NoOffset -> NoOffset, NoOffset
+ | Field(fi,rest) ->
+ let s,m = separate_loffsets rest in
+ Field(fi,s) , m
+ | Index(_) -> NoOffset, lo
+
+(* Recursively decompose the lvalue so that what is under a "Mem()"
+ * constructor is put into a temporary variable. *)
+let rec handle_lvalue (lb,lo) =
+ let s,m = separate_loffsets lo in
+ match lb with
+ Var(vi) ->
+ handle_loffset (lb,s) m
+ | Mem(Lval(Var(_),NoOffset)) ->
+ (* special case to avoid generating "tmp = ptr;" *)
+ handle_loffset (lb,s) m
+ | Mem(e) ->
+ begin
+ let new_vi = make_temp (typeOf e) in
+ assignment_list := (Set((Var(new_vi),NoOffset),e,!currentLoc))
+ :: !assignment_list ;
+ handle_loffset (Mem(Lval(Var(new_vi),NoOffset)),NoOffset) lo
+ end
+and handle_loffset lv lo =
+ match lo with
+ NoOffset -> lv
+ | Field(f,o) -> handle_loffset (addOffsetLval (Field(f,NoOffset)) lv) o
+ | Index(exp,o) -> handle_loffset (addOffsetLval (Index(exp,NoOffset)) lv) o
+
+(* the transformation is implemented as a Visitor *)
+class simpleVisitor = object
+ inherit nopCilVisitor
+
+ method vfunc fundec = (* we must record the current context *)
+ thefunc := Some(fundec) ;
+ DoChildren
+
+ method vlval lv = ChangeDoChildrenPost(lv,
+ (fun lv -> handle_lvalue lv))
+
+ method unqueueInstr () =
+ let result = List.rev !assignment_list in
+ assignment_list := [] ;
+ result
+end
+
+(* Main entry point: apply the transformation to a file *)
+let simplemem (f : file) =
+ try
+ visitCilFileSameGlobals (new simpleVisitor) f;
+ f
+ with e -> Printf.printf "Exception in Simplemem.simplemem: %s\n"
+ (Printexc.to_string e) ; raise e
+
+let feature : featureDescr =
+ { fd_name = "simpleMem";
+ fd_enabled = Cilutil.doSimpleMem;
+ fd_description = "simplify all memory expressions" ;
+ fd_extraopt = [];
+ fd_doit = (function (f: file) -> ignore (simplemem f)) ;
+ fd_post_check = true;
+ }
diff --git a/cil/src/ext/simplify.ml b/cil/src/ext/simplify.ml
new file mode 100755
index 0000000..776d491
--- /dev/null
+++ b/cil/src/ext/simplify.ml
@@ -0,0 +1,845 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Sumit Gulwani <gulwani@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* This module simplifies the expressions in a program in the following ways:
+
+1. All expressions are either
+
+ basic::=
+ Const _
+ Addrof(Var v, NoOffset)
+ StartOf(Var v, NoOffset)
+ Lval(Var v, off), where v is a variable whose address is not taken
+ and off contains only "basic"
+
+ exp::=
+ basic
+ Lval(Mem basic, NoOffset)
+ BinOp(bop, basic, basic)
+ UnOp(uop, basic)
+ CastE(t, basic)
+
+ lval ::=
+ Mem basic, NoOffset
+ Var v, off, where v is a variable whose address is not taken and off
+ contains only "basic"
+
+ - all sizeof and alignof are turned into constants
+ - accesses to variables whose address is taken is turned into "Mem" accesses
+ - same for accesses to arrays
+ - all field and index computations are turned into address arithmetic,
+ including bitfields.
+
+*)
+
+
+open Pretty
+open Cil
+module E = Errormsg
+module H = Hashtbl
+
+type taExp = exp (* Three address expression *)
+type bExp = exp (* Basic expression *)
+
+let debug = true
+
+(* Whether to split structs *)
+let splitStructs = ref true
+
+let onlyVariableBasics = ref false
+let noStringConstantsBasics = ref false
+
+exception BitfieldAccess
+
+(* Turn an expression into a three address expression (and queue some
+ * instructions in the process) *)
+let rec makeThreeAddress
+ (setTemp: taExp -> bExp) (* Given an expression save it into a temp and
+ * return that temp *)
+ (e: exp) : taExp =
+ match e with
+ SizeOf _ | SizeOfE _ | AlignOf _ | AlignOfE _ | SizeOfStr _ ->
+ constFold true e
+ | Const _ -> e
+ | AddrOf (Var _, NoOffset) -> e
+ | Lval lv -> Lval (simplifyLval setTemp lv)
+ | BinOp(bo, e1, e2, tres) ->
+ BinOp(bo, makeBasic setTemp e1, makeBasic setTemp e2, tres)
+ | UnOp(uo, e1, tres) ->
+ UnOp(uo, makeBasic setTemp e1, tres)
+ | CastE(t, e) ->
+ CastE(t, makeBasic setTemp e)
+ | AddrOf lv -> begin
+ match simplifyLval setTemp lv with
+ Mem a, NoOffset -> a
+ | _ -> (* This is impossible, because we are taking the address
+ * of v and simplifyLval should turn it into a Mem, except if the
+ * sizeof has failed. *)
+ E.s (bug "Simplify: makeThreeAddress for AddrOf(LV=%a, LVT=%a)"
+ d_lval lv d_type (typeOfLval lv))
+ end
+ | StartOf lv ->
+ makeThreeAddress setTemp (AddrOf (addOffsetLval (Index(zero, NoOffset))
+ lv))
+
+(* Make a basic expression *)
+and makeBasic (setTemp: taExp -> bExp) (e: exp) : bExp =
+ let dump = false (* !currentLoc.line = 395 *) in
+ if dump then
+ ignore (E.log "makeBasic %a\n" d_plainexp e);
+ (* Make it a three address expression first *)
+ let e' = makeThreeAddress setTemp e in
+ if dump then
+ ignore (E.log " e'= %a\n" d_plainexp e);
+ (* See if it is a basic one *)
+ match e' with
+ | Lval (Var _, _) -> e'
+ | Const _ | AddrOf (Var _, NoOffset) | StartOf (Var _, NoOffset) ->
+ if !onlyVariableBasics then setTemp e' else e'
+ | SizeOf _ | SizeOfE _ | AlignOf _ | AlignOfE _ | SizeOfStr _ ->
+ E.s (bug "Simplify: makeBasic found SizeOf: %a" d_exp e')
+
+ (* We cannot make a function to be Basic, unless it actually is a variable
+ * already. If this is a function pointer the best we can do is to make
+ * the address of the function basic *)
+ | Lval (Mem a, NoOffset) when isFunctionType (typeOf e') ->
+ if dump then
+ ignore (E.log " a function type\n");
+ let a' = makeBasic setTemp a in
+ Lval (Mem a', NoOffset)
+
+ | _ -> setTemp e' (* Put it into a temporary otherwise *)
+
+
+and simplifyLval
+ (setTemp: taExp -> bExp)
+ (lv: lval) : lval =
+ (* Add, watching for a zero *)
+ let add (e1: exp) (e2: exp) =
+ if isZero e2 then e1 else BinOp(PlusA, e1, e2, !upointType)
+ in
+ (* Convert an offset to an integer, and possibly a residual bitfield offset*)
+ let rec offsetToInt
+ (t: typ) (* The type of the host *)
+ (off: offset) : exp * offset =
+ match off with
+ NoOffset -> zero, NoOffset
+ | Field(fi, off') -> begin
+ let start =
+ try
+ let start, _ = bitsOffset t (Field(fi, NoOffset)) in
+ start
+ with SizeOfError (whystr, t') ->
+ E.s (E.bug "%a: Cannot compute sizeof: %s: %a"
+ d_loc !currentLoc whystr d_type t')
+ in
+ if start land 7 <> 0 then begin
+ (* We have a bitfield *)
+ assert (off' = NoOffset);
+ zero, Field(fi, off')
+ end else begin
+ let next, restoff = offsetToInt fi.ftype off' in
+ add (integer (start / 8)) next, restoff
+ end
+ end
+ | Index(ei, off') -> begin
+ let telem = match unrollType t with
+ TArray(telem, _, _) -> telem
+ | _ -> E.s (bug "Simplify: simplifyLval: index on a non-array")
+ in
+ let next, restoff = offsetToInt telem off' in
+ add
+ (BinOp(Mult, ei, SizeOf telem, !upointType))
+ next,
+ restoff
+ end
+ in
+ let tres = TPtr(typeOfLval lv, []) in
+ match lv with
+ Mem a, off ->
+ let offidx, restoff = offsetToInt (typeOfLval (Mem a, NoOffset)) off in
+ let a' =
+ if offidx <> zero then
+ add (mkCast a !upointType) offidx
+ else
+ a
+ in
+ let a' = makeBasic setTemp a' in
+ Mem (mkCast a' tres), restoff
+
+ | Var v, off when v.vaddrof -> (* We are taking this variable's address *)
+ let offidx, restoff = offsetToInt v.vtype off in
+ (* We cannot call makeBasic recursively here, so we must do it
+ * ourselves *)
+ let a = mkAddrOrStartOf (Var v, NoOffset) in
+ let a' =
+ if offidx = zero then a else
+ add (mkCast a !upointType) (makeBasic setTemp offidx)
+ in
+ let a' = setTemp a' in
+ Mem (mkCast a' tres), restoff
+
+ | Var v, off ->
+ (Var v, simplifyOffset setTemp off)
+
+
+(* Simplify an offset and make sure it has only three address expressions in
+ * indices *)
+and simplifyOffset (setTemp: taExp -> bExp) = function
+ NoOffset -> NoOffset
+ | Field(fi, off) -> Field(fi, simplifyOffset setTemp off)
+ | Index(ei, off) ->
+ let ei' = makeBasic setTemp ei in
+ Index(ei', simplifyOffset setTemp off)
+
+
+
+
+(** This is a visitor that will turn all expressions into three address code *)
+class threeAddressVisitor (fi: fundec) = object (self)
+ inherit nopCilVisitor
+
+ method private makeTemp (e1: exp) : exp =
+ let t = makeTempVar fi (typeOf e1) in
+ (* Add this instruction before the current statement *)
+ self#queueInstr [Set(var t, e1, !currentLoc)];
+ Lval(var t)
+
+ (* We'll ensure that this gets called only for top-level expressions
+ * inside functions. We must turn them into three address code. *)
+ method vexpr (e: exp) =
+ let e' = makeThreeAddress self#makeTemp e in
+ ChangeTo e'
+
+
+ (** We want the argument in calls to be simple variables *)
+ method vinst (i: instr) =
+ match i with
+ Call (someo, f, args, loc) ->
+ let someo' =
+ match someo with
+ Some lv -> Some (simplifyLval self#makeTemp lv)
+ | _ -> None
+ in
+ let f' = makeBasic self#makeTemp f in
+ let args' = List.map (makeBasic self#makeTemp) args in
+ ChangeTo [ Call (someo', f', args', loc) ]
+ | _ -> DoChildren
+
+ (* This method will be called only on top-level "lvals" (those on the
+ * left of assignments and function calls) *)
+ method vlval (lv: lval) =
+ ChangeTo (simplifyLval self#makeTemp lv)
+end
+
+(********************
+ Next is an old version of the code that was splitting structs into
+ * variables. It was not working on variables that are arguments or returns
+ * of function calls.
+(** This is a visitor that splits structured variables into separate
+ * variables. *)
+let isStructType (t: typ): bool =
+ match unrollType t with
+ TComp (ci, _) -> ci.cstruct
+ | _ -> false
+
+(* Keep track of how we change the variables. For each variable id we keep a
+ * hash table that maps an offset (a sequence of fieldinfo) into a
+ * replacement variable. We also keep track of the splittable vars: those
+ * with structure type but whose address is not take and which do not appear
+ * as the argument to a Return *)
+let splittableVars: (int, unit) H.t = H.create 13
+let replacementVars: (int * offset, varinfo) H.t = H.create 13
+
+let findReplacement (fi: fundec) (v: varinfo) (off: offset) : varinfo =
+ try
+ H.find replacementVars (v.vid, off)
+ with Not_found -> begin
+ let t = typeOfLval (Var v, off) in
+ (* make a name for this variable *)
+ let rec mkName = function
+ | Field(fi, off) -> "_" ^ fi.fname ^ mkName off
+ | _ -> ""
+ in
+ let v' = makeTempVar fi ~name:(v.vname ^ mkName off ^ "_") t in
+ H.add replacementVars (v.vid, off) v';
+ if debug then
+ ignore (E.log "Simplify: %s (%a) replace %a with %s\n"
+ fi.svar.vname
+ d_loc !currentLoc
+ d_lval (Var v, off)
+ v'.vname);
+ v'
+ end
+
+ (* Now separate the offset into a sequence of field accesses and the
+ * rest of the offset *)
+let rec separateOffset (off: offset): offset * offset =
+ match off with
+ NoOffset -> NoOffset, NoOffset
+ | Field(fi, off') when fi.fcomp.cstruct ->
+ let off1, off2 = separateOffset off' in
+ Field(fi, off1), off2
+ | _ -> NoOffset, off
+
+
+class splitStructVisitor (fi: fundec) = object (self)
+ inherit nopCilVisitor
+
+ method vlval (lv: lval) =
+ match lv with
+ Var v, off when H.mem splittableVars v.vid ->
+ (* The type of this lval better not be a struct *)
+ if isStructType (typeOfLval lv) then
+ E.s (unimp "Simplify: found lval of struct type %a : %a\n"
+ d_lval lv d_type (typeOfLval lv));
+ let off1, restoff = separateOffset off in
+ let lv' =
+ if off1 <> NoOffset then begin
+ (* This is a splittable variable and we have an offset that makes
+ * it a scalar. Find the replacement variable for this *)
+ let v' = findReplacement fi v off1 in
+ if restoff = NoOffset then
+ Var v', NoOffset
+ else (* We have some more stuff. Use Mem *)
+ Mem (mkAddrOrStartOf (Var v', NoOffset)), restoff
+ end else begin (* off1 = NoOffset *)
+ if restoff = NoOffset then
+ E.s (bug "Simplify: splitStructVisitor:lval")
+ else
+ simplifyLval
+ (fun e1 ->
+ let t = makeTempVar fi (typeOf e1) in
+ (* Add this instruction before the current statement *)
+ self#queueInstr [Set(var t, e1, !currentLoc)];
+ Lval(var t))
+ (Mem (mkAddrOrStartOf (Var v, NoOffset)), restoff)
+ end
+ in
+ ChangeTo lv'
+
+ | _ -> DoChildren
+
+ method vinst (i: instr) =
+ (* Accumulate to the list of instructions a number of assignments of
+ * non-splittable lvalues *)
+ let rec accAssignment (ci: compinfo) (dest: lval) (what: lval)
+ (acc: instr list) : instr list =
+ List.fold_left
+ (fun acc f ->
+ let dest' = addOffsetLval (Field(f, NoOffset)) dest in
+ let what' = addOffsetLval (Field(f, NoOffset)) what in
+ match unrollType f.ftype with
+ TComp(ci, _) when ci.cstruct ->
+ accAssignment ci dest' what' acc
+ | TArray _ -> (* We must copy the array *)
+ (Set((Mem (AddrOf dest'), NoOffset),
+ Lval (Mem (AddrOf what'), NoOffset), !currentLoc)) :: acc
+ | _ -> (* If the type of f is not a struct then leave this alone *)
+ (Set(dest', Lval what', !currentLoc)) :: acc)
+ acc
+ ci.cfields
+ in
+ let doAssignment (ci: compinfo) (dest: lval) (what: lval) : instr list =
+ let il' = accAssignment ci dest what [] in
+ List.concat (List.map (visitCilInstr (self :> cilVisitor)) il')
+ in
+ match i with
+ Set(((Var v, off) as lv), what, _) when H.mem splittableVars v.vid ->
+ let off1, restoff = separateOffset off in
+ if restoff <> NoOffset then (* This means that we are only assigning
+ * part of a replacement variable. Leave
+ * this alone because the vlval will take
+ * care of it *)
+ DoChildren
+ else begin
+ (* The type of the replacement has to be a structure *)
+ match unrollType (typeOfLval lv) with
+ TComp (ci, _) when ci.cstruct ->
+ (* The assigned thing better be an lvalue *)
+ let whatlv =
+ match what with
+ Lval lv -> lv
+ | _ -> E.s (unimp "Simplify: assigned struct is not lval")
+ in
+ ChangeTo (doAssignment ci (Var v, off) whatlv)
+
+ | _ -> (* vlval will take care of it *)
+ DoChildren
+ end
+
+ | Set(dest, Lval (Var v, off), _) when H.mem splittableVars v.vid ->
+ let off1, restoff = separateOffset off in
+ if restoff <> NoOffset then (* vlval will do this *)
+ DoChildren
+ else begin
+ (* The type of the replacement has to be a structure *)
+ match unrollType (typeOfLval dest) with
+ TComp (ci, _) when ci.cstruct ->
+ ChangeTo (doAssignment ci dest (Var v, off))
+
+ | _ -> (* vlval will take care of it *)
+ DoChildren
+ end
+
+ | _ -> DoChildren
+
+end
+*)
+
+(* Whether to split the arguments of functions *)
+let splitArguments = true
+
+(* Whether we try to do the splitting all in one pass. The advantage is that
+ * it is faster and it generates nicer names *)
+let lu = locUnknown
+
+(* Go over the code and split some temporary variables of stucture type into
+ * several separate variables. The hope is that the compiler will have an
+ * easier time to do standard optimizations with the resulting scalars *)
+(* Unfortunately, implementing this turns out to be more complicated than I
+ * thought *)
+
+(** Iterate over the fields of a structured type. Returns the empty list if
+ * no splits. The offsets are in order in which they appear in the structure
+ * type. Along with the offset we pass a string that identifies the
+ * meta-component, and the type of that component. *)
+let rec foldRightStructFields
+ (doit: offset -> string -> typ -> 'a) (* Invoked on non-struct fields *)
+ (off: offset)
+ (post: 'a list) (** A suffix to what you compute *)
+ (fields: fieldinfo list) : 'a list =
+ List.fold_right
+ (fun f post ->
+ let off' = addOffset (Field(f, NoOffset)) off in
+ match unrollType f.ftype with
+ TComp (comp, _) when comp.cstruct -> (* struct type: recurse *)
+ foldRightStructFields doit off' post comp.cfields
+ | _ ->
+ (doit off' f.fname f.ftype) :: post)
+ fields
+ post
+
+
+let rec foldStructFields
+ (t: typ)
+ (doit: offset -> string -> typ -> 'a)
+ : 'a list =
+ match unrollType t with
+ TComp (comp, _) when comp.cstruct ->
+ foldRightStructFields doit NoOffset [] comp.cfields
+ | _ -> []
+
+
+(* Map a variable name to a list of component variables, along with the
+ * accessor offset. The fields are in the order in which they appear in the
+ * structure. *)
+let newvars : (string, (offset * varinfo) list) H.t = H.create 13
+
+(* Split a variable and return the replacements, in the proper order. If this
+ * variable is not split, then return just the variable. *)
+let splitOneVar (v: varinfo)
+ (mknewvar: string -> typ -> varinfo) : varinfo list =
+ try
+ (* See if we have already split it *)
+ List.map snd (H.find newvars v.vname)
+ with Not_found -> begin
+ let vars: (offset * varinfo) list =
+ foldStructFields v.vtype
+ (fun off n t -> (* make a new one *)
+ let newname = v.vname ^ "_" ^ n in
+ let v'= mknewvar newname t in
+ (off, v'))
+ in
+ if vars = [] then
+ [ v ]
+ else begin
+ (* Now remember the newly created vars *)
+ H.add newvars v.vname vars;
+ List.map snd vars (* Return just the vars *)
+ end
+ end
+
+
+(* A visitor that finds all locals that appear in a call or have their
+ * address taken *)
+let dontSplitLocals : (string, bool) H.t = H.create 111
+class findVarsCantSplitClass : cilVisitor = object (self)
+ inherit nopCilVisitor
+
+ (* expressions, to see the address being taken *)
+ method vexpr (e: exp) : exp visitAction =
+ match e with
+ AddrOf (Var v, NoOffset) ->
+ H.add dontSplitLocals v.vname true; SkipChildren
+ (* See if we take the address of the "_ms" field in a variable *)
+ | _ -> DoChildren
+
+
+ (* variables involved in call instructions *)
+ method vinst (i: instr) : instr list visitAction =
+ match i with
+ Call (res, f, args, _) ->
+ (match res with
+ Some (Var v, NoOffset) -> H.add dontSplitLocals v.vname true
+ | _ -> ());
+ if not splitArguments then
+ List.iter (fun a ->
+ match a with
+ Lval (Var v, NoOffset) -> H.add dontSplitLocals v.vname true
+ | _ -> ()) args;
+ (* Now continue the visit *)
+ DoChildren
+
+ | _ -> DoChildren
+
+ (* Variables used in return should not be split *)
+ method vstmt (s: stmt) : stmt visitAction =
+ match s.skind with
+ Return (Some (Lval (Var v, NoOffset)), _) ->
+ H.add dontSplitLocals v.vname true; DoChildren
+ | Return (Some e, _) ->
+ DoChildren
+ | _ -> DoChildren
+
+ method vtype t = SkipChildren
+
+end
+let findVarsCantSplit = new findVarsCantSplitClass
+
+let isVar lv =
+ match lv with
+ (Var v, NoOffset) -> true
+ | _ -> false
+
+
+class splitVarVisitorClass(func:fundec option) : cilVisitor = object (self)
+ inherit nopCilVisitor
+
+ method private makeTemp (e1: exp) : exp =
+ let fi:fundec = match func with
+ Some f -> f
+ | None ->
+ E.s (bug "You can't create a temporary if you're not in a function.")
+ in
+ let t = makeTempVar fi (typeOf e1) in
+ (* Add this instruction before the current statement *)
+ self#queueInstr [Set(var t, e1, !currentLoc)];
+ Lval(var t)
+
+
+ (* We must process the function types *)
+ method vtype t =
+ (* We invoke the visitor first and then we fix it *)
+ let postProcessFunType (t: typ) : typ =
+ match t with
+ TFun(rt, Some params, isva, a) ->
+ let rec loopParams = function
+ [] -> []
+ | ((pn, pt, pa) :: rest) as params ->
+ let rest' = loopParams rest in
+ let res: (string * typ * attributes) list =
+ foldStructFields pt
+ (fun off n t ->
+ (* Careful with no-name parameters, or we end up with
+ * many parameters named _p ! *)
+ ((if pn <> "" then pn ^ n else ""), t, pa))
+ in
+ if res = [] then (* Not a fat *)
+ if rest' == rest then
+ params (* No change at all. Try not to reallocate so that
+ * the visitor does not allocate. *)
+ else
+ (pn, pt, pa) :: rest'
+ else (* Some change *)
+ res @ rest'
+ in
+ let params' = loopParams params in
+ if params == params' then
+ t
+ else
+ TFun(rt, Some params', isva, a)
+
+ | t -> t
+ in
+ if splitArguments then
+ ChangeDoChildrenPost(t, postProcessFunType)
+ else
+ SkipChildren
+
+ (* Whenever we see a variable with a field access we try to replace it
+ * by its components *)
+ method vlval ((b, off) : lval) : lval visitAction =
+ try
+ match b, off with
+ Var v, (Field _ as off) ->
+ (* See if this variable has some splits.Might throw Not_found *)
+ let splits = H.find newvars v.vname in
+ (* Now find among the splits one that matches this offset. And
+ * return the remaining offset *)
+ let rec find = function
+ [] ->
+ E.s (E.bug "Cannot find component %a of %s\n"
+ (d_offset nil) off v.vname)
+ | (splitoff, splitvar) :: restsplits ->
+ let rec matches = function
+ Field(f1, rest1), Field(f2, rest2)
+ when f1.fname = f2.fname ->
+ matches (rest1, rest2)
+ | off, NoOffset ->
+ (* We found a match *)
+ (Var splitvar, off)
+ | NoOffset, restoff ->
+ ignore (warn "Found aggregate lval %a\n"
+ d_lval (b, off));
+ find restsplits
+
+ | _, _ -> (* We did not match this one; go on *)
+ find restsplits
+ in
+ matches (off, splitoff)
+ in
+ ChangeTo (find splits)
+ | _ -> DoChildren
+ with Not_found -> DoChildren
+
+ (* Sometimes we pass the variable as a whole to a function or we
+ * assign it to something *)
+ method vinst (i: instr) : instr list visitAction =
+ match i with
+ (* Split into several instructions and then do children inside
+ * the rhs. Howver, v might appear in the rhs and if we
+ * duplicate the instruction we might get bad
+ * results. (e.g. test/small1/simplify_Structs2.c). So first copy
+ * the rhs to temp variables, then to v.
+ *
+ * Optimization: if the rhs is a variable, skip the temporary vars.
+ * Either the rhs = lhs, in which case this is all a nop, or it's not,
+ * in which case the rhs and lhs don't overlap.*)
+
+ Set ((Var v, NoOffset), Lval lv, l) when H.mem newvars v.vname -> begin
+ let needTemps = not (isVar lv) in
+ let vars4v = H.find newvars v.vname in
+ if vars4v = [] then E.s (errorLoc l "No fields in split struct");
+ ChangeTo
+ (List.map
+ (fun (off, newv) ->
+ let lv' =
+ visitCilLval (self :> cilVisitor)
+ (addOffsetLval off lv) in
+ (* makeTemp creates a temp var and puts (Lval lv') in it,
+ before any instructions in this ChangeTo list are handled.*)
+ let lv_tmp = if needTemps then
+ self#makeTemp (Lval lv')
+ else
+ (Lval lv')
+ in
+ Set((Var newv, NoOffset), lv_tmp, l))
+ vars4v)
+ end
+
+ | Set (lv, Lval (Var v, NoOffset), l) when H.mem newvars v.vname -> begin
+ (* Split->NonSplit assignment. no overlap between lhs and rhs
+ is possible*)
+ let vars4v = H.find newvars v.vname in
+ if vars4v = [] then E.s (errorLoc l "No fields in split struct");
+ ChangeTo
+ (List.map
+ (fun (off, newv) ->
+ let lv' =
+ visitCilLval (self :> cilVisitor)
+ (addOffsetLval off lv) in
+ Set(lv', Lval (Var newv, NoOffset), l))
+ vars4v)
+ end
+
+ (* Split all function arguments in calls *)
+ | Call (ret, f, args, l) when splitArguments ->
+ (* Visit the children first and then see if we must change the
+ * arguments *)
+ let finishArgs = function
+ [Call (ret', f', args', l')] as i' ->
+ let mustChange = ref false in
+ let newargs =
+ (* Look for opportunities to split arguments. If we can
+ * split, we must split the original argument (in args).
+ * Otherwise, we use the result of processing children
+ * (in args'). *)
+ List.fold_right2
+ (fun a a' acc ->
+ match a with
+ Lval (Var v, NoOffset) when H.mem newvars v.vname ->
+ begin
+ mustChange := true;
+ (List.map
+ (fun (_, newv) ->
+ Lval (Var newv, NoOffset))
+ (H.find newvars v.vname))
+ @ acc
+ end
+ | Lval lv -> begin
+ let newargs =
+ foldStructFields (typeOfLval lv)
+ (fun off n t ->
+ let lv' = addOffsetLval off lv in
+ Lval lv') in
+ if newargs = [] then
+ a' :: acc (* not a split var *)
+ else begin
+ mustChange := true;
+ newargs @ acc
+ end
+ end
+ | _ -> (* only lvals are split, right? *)
+ a' :: acc)
+ args args'
+ []
+ in
+ if !mustChange then
+ [Call (ret', f', newargs, l')]
+ else
+ i'
+ | _ -> E.s (E.bug "splitVarVisitorClass: expecting call")
+ in
+ ChangeDoChildrenPost ([i], finishArgs)
+
+ | _ -> DoChildren
+
+
+ method vfunc (func: fundec) : fundec visitAction =
+ H.clear newvars;
+ H.clear dontSplitLocals;
+ (* Visit the type of the function itself *)
+ if splitArguments then
+ func.svar.vtype <- visitCilType (self :> cilVisitor) func.svar.vtype;
+
+ (* Go over the block and find the candidates *)
+ ignore (visitCilBlock findVarsCantSplit func.sbody);
+
+ (* Now go over the formals and create the splits *)
+ if splitArguments then begin
+ (* Split all formals because we will split all arguments in function
+ * types *)
+ let newformals =
+ List.fold_right
+ (fun form acc ->
+ (* Process the type first *)
+ form.vtype <-
+ visitCilType (self : #cilVisitor :> cilVisitor) form.vtype;
+ let form' =
+ splitOneVar form
+ (fun s t -> makeLocalVar func ~insert:false s t)
+ in
+ (* Now it is a good time to check if we actually can split this
+ * one *)
+ if List.length form' > 1 &&
+ H.mem dontSplitLocals form.vname then
+ ignore (warn "boxsplit: can't split formal \"%s\" in %s. Make sure you never take the address of a formal.\n"
+ form.vname func.svar.vname);
+ form' @ acc)
+ func.sformals []
+ in
+ (* Now make sure we fix the type. *)
+ setFormals func newformals
+ end;
+ (* Now go over the locals and create the splits *)
+ List.iter
+ (fun l ->
+ (* Process the type of the local *)
+ l.vtype <- visitCilType (self :> cilVisitor) l.vtype;
+ (* Now see if we must split it *)
+ if not (H.mem dontSplitLocals l.vname) then begin
+ ignore (splitOneVar l (fun s t -> makeTempVar func ~name:s t))
+ end)
+ func.slocals;
+ (* Now visit the body and change references to these variables *)
+ ignore (visitCilBlock (self :> cilVisitor) func.sbody);
+ H.clear newvars;
+ H.clear dontSplitLocals;
+ SkipChildren (* We are done with this function *)
+
+ (* Try to catch the occurrences of the variable in a sizeof expression *)
+ method vexpr (e: exp) =
+ match e with
+ | SizeOfE (Lval(Var v, NoOffset)) -> begin
+ try
+ let splits = H.find newvars v.vname in
+ (* We cound here on no padding between the elements ! *)
+ ChangeTo
+ (List.fold_left
+ (fun acc (_, thisv) ->
+ BinOp(PlusA, SizeOfE(Lval(Var thisv, NoOffset)),
+ acc, uintType))
+ zero
+ splits)
+ with Not_found -> DoChildren
+ end
+ | _ -> DoChildren
+end
+
+let doGlobal = function
+ GFun(fi, _) ->
+ (* Visit the body and change all expressions into three address code *)
+ let v = new threeAddressVisitor fi in
+ fi.sbody <- visitCilBlock v fi.sbody;
+ if !splitStructs then begin
+ H.clear dontSplitLocals;
+ let splitVarVisitor = new splitVarVisitorClass (Some fi) in
+ ignore (visitCilFunction splitVarVisitor fi);
+ end
+ | GVarDecl(vi, _) when isFunctionType vi.vtype ->
+ (* we might need to split the args/return value in the function type. *)
+ if !splitStructs then begin
+ H.clear dontSplitLocals;
+ let splitVarVisitor = new splitVarVisitorClass None in
+ ignore (visitCilVarDecl splitVarVisitor vi);
+ end
+ | _ -> ()
+
+let feature : featureDescr =
+ { fd_name = "simplify";
+ fd_enabled = ref false;
+ fd_description = "compiles CIL to 3-address code";
+ fd_extraopt = [
+ ("--no-split-structs", Arg.Unit (fun _ -> splitStructs := false),
+ "do not split structured variables");
+ ];
+ fd_doit = (function f -> iterGlobals f doGlobal);
+ fd_post_check = true;
+}
+
diff --git a/cil/src/ext/ssa.ml b/cil/src/ext/ssa.ml
new file mode 100644
index 0000000..942c92b
--- /dev/null
+++ b/cil/src/ext/ssa.ml
@@ -0,0 +1,696 @@
+module B=Bitmap
+module E = Errormsg
+
+open Cil
+open Pretty
+
+let debug = false
+
+(* Globalsread, Globalswritten should be closed under call graph *)
+
+module StringOrder =
+ struct
+ type t = string
+ let compare s1 s2 =
+ if s1 = s2 then 0 else
+ if s1 < s2 then -1 else 1
+ end
+
+module StringSet = Set.Make (StringOrder)
+
+module IntOrder =
+ struct
+ type t = int
+ let compare i1 i2 =
+ if i1 = i2 then 0 else
+ if i1 < i2 then -1 else 1
+ end
+
+module IntSet = Set.Make (IntOrder)
+
+
+type cfgInfo = {
+ name: string; (* The function name *)
+ start : int;
+ size : int;
+ blocks: cfgBlock array; (** Dominating blocks must come first *)
+ successors: int list array; (* block indices *)
+ predecessors: int list array;
+ mutable nrRegs: int;
+ mutable regToVarinfo: varinfo array; (** Map register IDs to varinfo *)
+ }
+
+(** A block corresponds to a statement *)
+and cfgBlock = {
+ bstmt: Cil.stmt;
+
+ (* We abstract the statement as a list of def/use instructions *)
+ instrlist: instruction list;
+ mutable livevars: (reg * int) list;
+ (** For each variable ID that is live at the start of the block, the
+ * block whose definition reaches this point. If that block is the same
+ * as the current one, then the variable is a phi variable *)
+ mutable reachable: bool;
+ }
+
+and instruction = (reg list * reg list)
+ (* lhs variables, variables on rhs. *)
+
+
+and reg = int
+
+type idomInfo = int array (* immediate dominator *)
+
+and dfInfo = (int list) array (* dominance frontier *)
+
+and oneSccInfo = {
+ nodes: int list;
+ headers: int list;
+ backEdges: (int*int) list;
+ }
+
+and sccInfo = oneSccInfo list
+
+(* Muchnick's Domin_Fast, 7.16 *)
+
+let compute_idom (flowgraph: cfgInfo): idomInfo =
+ let start = flowgraph.start in
+ let size = flowgraph.size in
+ let successors = flowgraph.successors in
+ let predecessors = flowgraph.predecessors in
+ let n0 = size in (* a new node (not in the flowgraph) *)
+ let idom = Array.make size (-1) in (* Make an array of immediate dominators *)
+ let nnodes = size + 1 in
+ let nodeSet = B.init nnodes (fun i -> true) in
+
+ let ndfs = Array.create nnodes 0 in (* mapping from depth-first
+ * number to nodes. DForder
+ * starts at 1, with 0 used as
+ * an invalid entry *)
+ let parent = Array.create nnodes 0 in (* the parent in depth-first
+ * spanning tree *)
+
+ (* A semidominator of w is the node v with the minimal DForder such
+ * that there is a path from v to w containing only nodes with the
+ * DForder larger than w. *)
+ let sdno = Array.create nnodes 0 in (* depth-first number of
+ * semidominator *)
+
+ (* The set of nodes whose
+ * semidominator is ndfs(i) *)
+ let bucket = Array.init nnodes (fun _ -> B.cloneEmpty nodeSet) in
+
+ (* The functions link and eval maintain a forest within the
+ * depth-first spanning tree. Ancestor is n0 is the node is a root in
+ * the forest. Label(v) is the node in the ancestor chain with the
+ * smallest depth-first number of its semidominator. Child and Size
+ * are used to keep the trees in the forest balanced *)
+ let ancestor = Array.create nnodes 0 in
+ let label = Array.create nnodes 0 in
+ let child = Array.create nnodes 0 in
+ let size = Array.create nnodes 0 in
+
+
+ let n = ref 0 in (* depth-first scan and numbering.
+ * Initialize data structures. *)
+ ancestor.(n0) <- n0;
+ label.(n0) <- n0;
+ let rec depthFirstSearchDom v =
+ incr n;
+ sdno.(v) <- !n;
+ ndfs.(!n) <- v; label.(v) <- v;
+ ancestor.(v) <- n0; (* All nodes are roots initially *)
+ child.(v) <- n0; size.(v) <- 1;
+ List.iter
+ (fun w ->
+ if sdno.(w) = 0 then begin
+ parent.(w) <- v; depthFirstSearchDom w
+ end)
+ successors.(v);
+ in
+ (* Determine the ancestor of v whose semidominator has the the minimal
+ * DFnumber. In the process, compress the paths in the forest. *)
+ let eval v =
+ let rec compress v =
+ if ancestor.(ancestor.(v)) <> n0 then
+ begin
+ compress ancestor.(v);
+ if sdno.(label.(ancestor.(v))) < sdno.(label.(v)) then
+ label.(v) <- label.(ancestor.(v));
+ ancestor.(v) <- ancestor.(ancestor.(v))
+ end
+ in
+ if ancestor.(v) = n0 then label.(v)
+ else begin
+ compress v;
+ if sdno.(label.(ancestor.(v))) >= sdno.(label.(v)) then
+ label.(v)
+ else label.(ancestor.(v))
+ end
+ in
+
+ let link v w =
+ let s = ref w in
+ while sdno.(label.(w)) < sdno.(label.(child.(!s))) do
+ if size.(!s) + size.(child.(child.(!s))) >= 2* size.(child.(!s)) then
+ (ancestor.(child.(!s)) <- !s;
+ child.(!s) <- child.(child.(!s)))
+ else
+ (size.(child.(!s)) <- size.(!s);
+ ancestor.(!s) <- child.(!s); s := child.(!s));
+ done;
+ label.(!s) <- label.(w);
+ size.(v) <- size.(v) + size.(w);
+ if size.(v) < 2 * size.(w) then begin
+ let tmp = !s in
+ s := child.(v);
+ child.(v) <- tmp;
+ end;
+ while !s <> n0 do
+ ancestor.(!s) <- v;
+ s := child.(!s);
+ done;
+ in
+ (* Start now *)
+ depthFirstSearchDom start;
+ for i = !n downto 2 do
+ let w = ndfs.(i) in
+ List.iter (fun v ->
+ let u = eval v in
+ if sdno.(u) < sdno.(w) then sdno.(w) <- sdno.(u);)
+ predecessors.(w);
+ B.set bucket.(ndfs.(sdno.(w))) w true;
+ link parent.(w) w;
+ while not (B.empty bucket.(parent.(w))) do
+ let v =
+ match B.toList bucket.(parent.(w)) with
+ x :: _ -> x
+ | [] -> ignore(print_string "Error in dominfast");0 in
+ B.set bucket.(parent.(w)) v false;
+ let u = eval v in
+ idom.(v) <- if sdno.(u) < sdno.(v) then u else parent.(w);
+ done;
+ done;
+
+ for i=2 to !n do
+ let w = ndfs.(i) in
+ if idom.(w) <> ndfs.(sdno.(w)) then begin
+ let newDom = idom.(idom.(w)) in
+ idom.(w) <- newDom;
+ end
+ done;
+ idom
+
+
+
+
+
+let dominance_frontier (flowgraph: cfgInfo) : dfInfo =
+ let idom = compute_idom flowgraph in
+ let size = flowgraph.size in
+ let children = Array.create size [] in
+ for i = 0 to size - 1 do
+ if (idom.(i) != -1) then children.(idom.(i)) <- i :: children.(idom.(i));
+ done;
+
+ let size = flowgraph.size in
+ let start = flowgraph.start in
+ let successors = flowgraph.successors in
+
+ let df = Array.create size [] in
+ (* Compute the dominance frontier *)
+
+ let bottom = Array.make size true in (* bottom of the dominator tree *)
+ for i = 0 to size - 1 do
+ if (i != start) && idom.(i) <> -1 then bottom.(idom.(i)) <- false;
+ done;
+
+ let processed = Array.make size false in (* to record the nodes added to work_list *)
+ let workList = ref ([]) in (* to iterate in a bottom-up traversal of the dominator tree *)
+ for i = 0 to size - 1 do
+ if (bottom.(i)) then workList := i :: !workList;
+ done;
+ while (!workList != []) do
+ let x = List.hd !workList in
+ let update y = if idom.(y) <> x then df.(x) <- y::df.(x) in
+ (* compute local component *)
+
+(* We use whichPred instead of whichSucc because ultimately this info is
+ * needed by control dependence dag which is constructed from REVERSE
+ * dominance frontier *)
+ List.iter (fun succ -> update succ) successors.(x);
+ (* add on up component *)
+ List.iter (fun z -> List.iter (fun y -> update y) df.(z)) children.(x);
+ processed.(x) <- true;
+ workList := List.tl !workList;
+ if (x != start) then begin
+ let i = idom.(x) in
+ if i <> -1 &&
+ (List.for_all (fun child -> processed.(child)) children.(i)) then workList := i :: !workList;
+ end;
+ done;
+ df
+
+
+(* Computes for each register, the set of nodes that need a phi definition
+ * for the register *)
+
+let add_phi_functions_info (flowgraph: cfgInfo) : unit =
+ let df = dominance_frontier flowgraph in
+ let size = flowgraph.size in
+ let nrRegs = flowgraph.nrRegs in
+
+
+ let defs = Array.init size (fun i -> B.init nrRegs (fun j -> false)) in
+ for i = 0 to size-1 do
+ List.iter
+ (fun (lhs,rhs) ->
+ List.iter (fun (r: reg) -> B.set defs.(i) r true) lhs;
+ )
+ flowgraph.blocks.(i).instrlist
+ done;
+ let iterCount = ref 0 in
+ let hasAlready = Array.create size 0 in
+ let work = Array.create size 0 in
+ let w = ref ([]) in
+ let dfPlus = Array.init nrRegs (
+ fun i ->
+ let defIn = B.make size in
+ for j = 0 to size - 1 do
+ if B.get defs.(j) i then B.set defIn j true
+ done;
+ let res = ref [] in
+ incr iterCount;
+ B.iter (fun x -> work.(x) <- !iterCount; w := x :: !w;) defIn;
+ while (!w != []) do
+ let x = List.hd !w in
+ w := List.tl !w;
+ List.iter (fun y ->
+ if (hasAlready.(y) < !iterCount) then begin
+ res := y :: !res;
+ hasAlready.(y) <- !iterCount;
+ if (work.(y) < !iterCount) then begin
+ work.(y) <- !iterCount;
+ w := y :: !w;
+ end;
+ end;
+ ) df.(x)
+ done;
+ (* res := List.filter (fun blkId -> B.get liveIn.(blkId) i) !res; *)
+ !res
+ ) in
+ let result = Array.create size ([]) in
+ for i = 0 to nrRegs - 1 do
+ List.iter (fun node -> result.(node) <- i::result.(node);) dfPlus.(i)
+ done;
+(* result contains for each node, the list of variables that need phi
+ * definition *)
+ for i = 0 to size-1 do
+ flowgraph.blocks.(i).livevars <-
+ List.map (fun r -> (r, i)) result.(i);
+ done
+
+
+
+(* add dominating definitions info *)
+
+let add_dom_def_info (f: cfgInfo): unit =
+ let blocks = f.blocks in
+ let start = f.start in
+ let size = f.size in
+ let nrRegs = f.nrRegs in
+
+ let idom = compute_idom f in
+ let children = Array.create size [] in
+ for i = 0 to size - 1 do
+ if (idom.(i) != -1) then children.(idom.(i)) <- i :: children.(idom.(i));
+ done;
+
+ if debug then begin
+ ignore (E.log "Immediate dominators\n");
+ for i = 0 to size - 1 do
+ ignore (E.log " block %d: idom=%d, children=%a\n"
+ i idom.(i)
+ (docList num) children.(i));
+ done
+ end;
+
+ (* For each variable, maintain a stack of blocks that define it. When you
+ * process a block, the top of the stack is the closest dominator that
+ * defines the variable *)
+ let s = Array.make nrRegs ([start]) in
+
+ (* Search top-down in the idom tree *)
+ let rec search (x: int): unit = (* x is a graph node *)
+ (* Push the current block for the phi variables *)
+ List.iter
+ (fun ((r: reg), dr) ->
+ if x = dr then s.(r) <- x::s.(r))
+ blocks.(x).livevars;
+
+ (* Clear livevars *)
+ blocks.(x).livevars <- [];
+
+ (* Compute livevars *)
+ for i = 0 to nrRegs-1 do
+ match s.(i) with
+ | [] -> assert false
+ | fst :: _ ->
+ blocks.(x).livevars <- (i, fst) :: blocks.(x).livevars
+ done;
+
+
+ (* Update s for the children *)
+ List.iter
+ (fun (lhs,rhs) ->
+ List.iter (fun (lreg: reg) -> s.(lreg) <- x::s.(lreg) ) lhs;
+ )
+ blocks.(x).instrlist;
+
+
+ (* Go and do the children *)
+ List.iter search children.(x);
+
+ (* Then we pop x, whenever it is on top of a stack *)
+ Array.iteri
+ (fun i istack ->
+ let rec dropX = function
+ [] -> []
+ | x' :: rest when x = x' -> dropX rest
+ | l -> l
+ in
+ s.(i) <- dropX istack)
+ s;
+ in
+ search(start)
+
+
+
+let prune_cfg (f: cfgInfo): cfgInfo =
+ let size = f.size in
+ if size = 0 then f else
+ let reachable = Array.make size false in
+ let worklist = ref([f.start]) in
+ while (!worklist != []) do
+ let h = List.hd !worklist in
+ worklist := List.tl !worklist;
+ reachable.(h) <- true;
+ List.iter (fun s -> if (reachable.(s) = false) then worklist := s::!worklist;
+ ) f.successors.(h);
+ done;
+(*
+ let dummyblock = { bstmt = mkEmptyStmt ();
+ instrlist = [];
+ livevars = [] }
+ in
+*)
+ let successors = Array.init size (fun i -> List.filter (fun s -> reachable.(s)) f.successors.(i)) in
+ let predecessors = Array.init size (fun i -> List.filter (fun s -> reachable.(s)) f.predecessors.(i)) in
+ Array.iteri (fun i b -> b.reachable <- reachable.(i)) f.blocks;
+ let result: cfgInfo =
+ { name = f.name;
+ start = f.start;
+ size = f.size;
+ successors = successors;
+ predecessors = predecessors;
+ blocks = f.blocks;
+ nrRegs = f.nrRegs;
+ regToVarinfo = f.regToVarinfo;
+ }
+ in
+ result
+
+
+let add_ssa_info (f: cfgInfo): unit =
+ let f = prune_cfg f in
+ let d_reg () (r: int) =
+ dprintf "%s(%d)" f.regToVarinfo.(r).vname r
+ in
+ if debug then begin
+ ignore (E.log "Doing SSA for %s. Initial data:\n" f.name);
+ Array.iteri (fun i b ->
+ ignore (E.log " block %d:\n succs=@[%a@]\n preds=@[%a@]\n instr=@[%a@]\n"
+ i
+ (docList num) f.successors.(i)
+ (docList num) f.predecessors.(i)
+ (docList ~sep:line (fun (lhs, rhs) ->
+ dprintf "%a := @[%a@]"
+ (docList (d_reg ())) lhs (docList (d_reg ())) rhs))
+ b.instrlist))
+ f.blocks;
+ end;
+
+ add_phi_functions_info f;
+ add_dom_def_info f;
+
+ if debug then begin
+ ignore (E.log "After SSA\n");
+ Array.iter (fun b ->
+ ignore (E.log " block %d livevars: @[%a@]\n"
+ b.bstmt.sid
+ (docList (fun (i, fst) ->
+ dprintf "%a def at %d" d_reg i fst))
+ b.livevars))
+ f.blocks;
+ end
+
+
+let set2list s =
+ let result = ref([]) in
+ IntSet.iter (fun element -> result := element::!result) s;
+ !result
+
+
+
+
+let preorderDAG (nrNodes: int) (successors: (int list) array): int list =
+ let processed = Array.make nrNodes false in
+ let revResult = ref ([]) in
+ let predecessorsSet = Array.make nrNodes (IntSet.empty) in
+ for i = 0 to nrNodes -1 do
+ List.iter (fun s -> predecessorsSet.(s) <- IntSet.add i predecessorsSet.(s)) successors.(i);
+ done;
+ let predecessors = Array.init nrNodes (fun i -> set2list predecessorsSet.(i)) in
+ let workList = ref([]) in
+ for i = 0 to nrNodes - 1 do
+ if (predecessors.(i) = []) then workList := i::!workList;
+ done;
+ while (!workList != []) do
+ let x = List.hd !workList in
+ workList := List.tl !workList;
+ revResult := x::!revResult;
+ processed.(x) <- true;
+ List.iter (fun s ->
+ if (List.for_all (fun p -> processed.(p)) predecessors.(s)) then
+ workList := s::!workList;
+ ) successors.(x);
+ done;
+ List.rev !revResult
+
+
+(* Muchnick Fig 7.12 *)
+(* takes an SCC description as an input and returns prepares the appropriate SCC *)
+let preorder (nrNodes: int) (successors: (int list) array) (r: int): oneSccInfo =
+ if debug then begin
+ ignore (E.log "Inside preorder \n");
+ for i = 0 to nrNodes - 1 do
+ ignore (E.log "succ(%d) = %a" i (docList (fun i -> num i)) successors.(i));
+ done;
+ end;
+ let i = ref(0) in
+ let j = ref(0) in
+ let pre = Array.make nrNodes (-1) in
+ let post = Array.make nrNodes (-1) in
+ let visit = Array.make nrNodes (false) in
+ let backEdges = ref ([]) in
+ let headers = ref(IntSet.empty) in
+ let rec depth_first_search_pp (x:int) =
+ visit.(x) <- true;
+ pre.(x) <- !j;
+ incr j;
+ List.iter (fun (y:int) ->
+ if (not visit.(y)) then
+ (depth_first_search_pp y)
+ else
+ if (post.(y) = -1) then begin
+ backEdges := (x,y)::!backEdges;
+ headers := IntSet.add y !headers;
+ end;
+ ) successors.(x);
+ post.(x) <- !i;
+ incr i;
+ in
+ depth_first_search_pp r;
+ let nodes = Array.make nrNodes (-1) in
+ for y = 0 to nrNodes - 1 do
+ if (pre.(y) != -1) then nodes.(pre.(y)) <- y;
+ done;
+ let nodeList = List.filter (fun i -> (i != -1)) (Array.to_list nodes) in
+ let result = { headers = set2list !headers; backEdges = !backEdges; nodes = nodeList; } in
+ result
+
+
+exception Finished
+
+
+let strong_components (f: cfgInfo) (debug: bool) =
+ let size = f.size in
+ let parent = Array.make size (-1) in
+ let color = Array.make size (-1) in
+ let finish = Array.make size (-1) in
+ let root = Array.make size (-1) in
+
+(* returns a list of SCC. Each SCC is a tuple of SCC root and SCC nodes *)
+ let dfs (successors: (int list) array) (order: int array) =
+ let time = ref(-1) in
+ let rec dfs_visit u =
+ color.(u) <- 1;
+ incr time;
+ (* d.(u) <- time; *)
+ List.iter (fun v ->
+ if color.(v) = 0 then (parent.(v) <- u; dfs_visit v)
+ ) successors.(u);
+ color.(u) <- 2;
+ incr time;
+ finish.(u) <- !time
+ in
+ for u = 0 to size - 1 do
+ color.(u) <- 0; (* white = 0, gray = 1, black = 2 *)
+ parent.(u) <- -1; (* nil = -1 *)
+ root.(u) <- 0; (* Is u a root? *)
+ done;
+ time := 0;
+ Array.iter (fun u ->
+ if (color.(u) = 0) then begin
+ root.(u) <- 1;
+ dfs_visit u;
+ end;
+ ) order;
+ in
+
+ let simpleOrder = Array.init size (fun i -> i) in
+ dfs f.successors simpleOrder;
+ Array.sort (fun i j -> if (finish.(i) > finish.(j)) then -1 else 1) simpleOrder;
+
+ dfs f.predecessors simpleOrder;
+(* SCCs have been computed. (The trees represented by non-null parent edges
+ * represent the SCCS. We call the black nodes as the roots). Now put the
+ * result in the ouput format *)
+ let allScc = ref([]) in
+ for u = 0 to size - 1 do
+ if root.(u) = 1 then begin
+ let sccNodes = ref(IntSet.empty) in
+ let workList = ref([u]) in
+ while (!workList != []) do
+ let h=List.hd !workList in
+ workList := List.tl !workList;
+ sccNodes := IntSet.add h !sccNodes;
+ List.iter (fun s -> if parent.(s)=h then workList := s::!workList;) f.predecessors.(h);
+ done;
+ allScc := (u,!sccNodes)::!allScc;
+ if (debug) then begin
+ ignore (E.log "Got an SCC with root %d and nodes %a" u (docList num) (set2list !sccNodes));
+ end;
+ end;
+ done;
+ !allScc
+
+
+let stronglyConnectedComponents (f: cfgInfo) (debug: bool): sccInfo =
+ let size = f.size in
+ if (debug) then begin
+ ignore (E.log "size = %d\n" size);
+ for i = 0 to size - 1 do
+ ignore (E.log "Successors(%d): %a\n" i (docList (fun n -> num n)) f.successors.(i));
+ done;
+ end;
+
+ let allScc = strong_components f debug in
+ let all_sccArray = Array.of_list allScc in
+
+ if (debug) then begin
+ ignore (E.log "Computed SCCs\n");
+ for i = 0 to (Array.length all_sccArray) - 1 do
+ ignore(E.log "SCC #%d: " i);
+ let (_,sccNodes) = all_sccArray.(i) in
+ IntSet.iter (fun i -> ignore(E.log "%d, " i)) sccNodes;
+ ignore(E.log "\n");
+ done;
+ end;
+
+
+ (* Construct sccId: Node -> Scc Id *)
+ let sccId = Array.make size (-1) in
+ Array.iteri (fun i (r,sccNodes) ->
+ IntSet.iter (fun n -> sccId.(n) <- i) sccNodes;
+ ) all_sccArray;
+
+ if (debug) then begin
+ ignore (E.log "\nComputed SCC IDs: ");
+ for i = 0 to size - 1 do
+ ignore (E.log "SCCID(%d) = %d " i sccId.(i));
+ done;
+ end;
+
+
+ (* Construct sccCFG *)
+ let nrScc = Array.length all_sccArray in
+ let successors = Array.make nrScc [] in
+ for x = 0 to nrScc - 1 do
+ successors.(x) <-
+ let s = ref(IntSet.empty) in
+ IntSet.iter (fun y ->
+ List.iter (fun z ->
+ let sy = sccId.(y) in
+ let sz = sccId.(z) in
+ if (not(sy = sz)) then begin
+ s := IntSet.add sz !s;
+ end
+ ) f.successors.(y)
+ ) (snd all_sccArray.(x));
+ set2list !s
+ done;
+
+ if (debug) then begin
+ ignore (E.log "\nComputed SCC CFG, which should be a DAG:");
+ ignore (E.log "nrSccs = %d " nrScc);
+ for i = 0 to nrScc - 1 do
+ ignore (E.log "successors(%d) = [%a] " i (docList (fun j -> num j)) successors.(i));
+ done;
+ end;
+
+
+ (* Order SCCs. The graph is a DAG here *)
+ let sccorder = preorderDAG nrScc successors in
+
+ if (debug) then begin
+ ignore (E.log "\nComputed SCC Preorder: ");
+ ignore (E.log "Nodes in Preorder = [%a]" (docList (fun i -> num i)) sccorder);
+ end;
+
+ (* Order nodes of each SCC. The graph is a SCC here.*)
+ let scclist = List.map (fun i ->
+ let successors = Array.create size [] in
+ for j = 0 to size - 1 do
+ successors.(j) <- List.filter (fun x -> IntSet.mem x (snd all_sccArray.(i))) f.successors.(j);
+ done;
+ preorder f.size successors (fst all_sccArray.(i))
+ ) sccorder in
+ if (debug) then begin
+ ignore (E.log "Computed Preorder for Nodes of each SCC\n");
+ List.iter (fun scc ->
+ ignore (E.log "BackEdges = %a \n"
+ (docList (fun (src,dest) -> dprintf "(%d,%d)" src dest))
+ scc.backEdges);)
+ scclist;
+ end;
+ scclist
+
+
+
+
+
+
+
+
+
diff --git a/cil/src/ext/ssa.mli b/cil/src/ext/ssa.mli
new file mode 100644
index 0000000..be244d8
--- /dev/null
+++ b/cil/src/ext/ssa.mli
@@ -0,0 +1,45 @@
+type cfgInfo = {
+ name: string; (* The function name *)
+ start : int;
+ size : int;
+ blocks: cfgBlock array; (** Dominating blocks must come first *)
+ successors: int list array; (* block indices *)
+ predecessors: int list array;
+ mutable nrRegs: int;
+ mutable regToVarinfo: Cil.varinfo array; (** Map register IDs to varinfo *)
+ }
+
+(** A block corresponds to a statement *)
+and cfgBlock = {
+ bstmt: Cil.stmt;
+
+ (* We abstract the statement as a list of def/use instructions *)
+ instrlist: instruction list;
+ mutable livevars: (reg * int) list;
+ (** For each variable ID that is live at the start of the block, the
+ * block whose definition reaches this point. If that block is the same
+ * as the current one, then the variable is a phi variable *)
+ mutable reachable: bool;
+ }
+
+and instruction = (reg list * reg list)
+ (* lhs variables, variables on rhs. *)
+
+
+and reg = int
+
+type idomInfo = int array (* immediate dominator *)
+
+and dfInfo = (int list) array (* dominance frontier *)
+
+and oneSccInfo = {
+ nodes: int list;
+ headers: int list;
+ backEdges: (int*int) list;
+ }
+
+and sccInfo = oneSccInfo list
+
+val add_ssa_info: cfgInfo -> unit
+val stronglyConnectedComponents: cfgInfo -> bool -> sccInfo
+val prune_cfg: cfgInfo -> cfgInfo
diff --git a/cil/src/ext/stackoverflow.ml b/cil/src/ext/stackoverflow.ml
new file mode 100644
index 0000000..da2c401
--- /dev/null
+++ b/cil/src/ext/stackoverflow.ml
@@ -0,0 +1,246 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+module H = Hashtbl
+open Cil
+open Pretty
+module E = Errormsg
+
+let debug = false
+
+
+(* For each function we have a node *)
+type node = { name: string;
+ mutable scanned: bool;
+ mutable mustcheck: bool;
+ mutable succs: node list }
+(* We map names to nodes *)
+let functionNodes: (string, node) H.t = H.create 113
+let getFunctionNode (n: string) : node =
+ Util.memoize
+ functionNodes
+ n
+ (fun _ -> { name = n; mustcheck = false; scanned = false; succs = [] })
+
+(** Dump the function call graph. Assume that there is a main *)
+let dumpGraph = true
+let dumpFunctionCallGraph () =
+ H.iter (fun _ x -> x.scanned <- false) functionNodes;
+ let rec dumpOneNode (ind: int) (n: node) : unit =
+ output_string !E.logChannel "\n";
+ for i = 0 to ind do
+ output_string !E.logChannel " "
+ done;
+ output_string !E.logChannel (n.name ^ " ");
+ if n.scanned then (* Already dumped *)
+ output_string !E.logChannel " <rec> "
+ else begin
+ n.scanned <- true;
+ List.iter (dumpOneNode (ind + 1)) n.succs
+ end
+ in
+ try
+ let main = H.find functionNodes "main" in
+ dumpOneNode 0 main
+ with Not_found -> begin
+ ignore (E.log
+ "I would like to dump the function graph but there is no main");
+ end
+
+(* We add a dummy function whose name is "@@functionPointer@@" that is called
+ * at all invocations of function pointers and itself calls all functions
+ * whose address is taken. *)
+let functionPointerName = "@@functionPointer@@"
+
+let checkSomeFunctions = ref false
+
+let init () =
+ H.clear functionNodes;
+ checkSomeFunctions := false
+
+
+let addCall (caller: string) (callee: string) =
+ let callerNode = getFunctionNode caller in
+ let calleeNode = getFunctionNode callee in
+ if not (List.exists (fun n -> n.name = callee) callerNode.succs) then begin
+ if debug then
+ ignore (E.log "found call from %s to %s\n" caller callee);
+ callerNode.succs <- calleeNode :: callerNode.succs;
+ end;
+ ()
+
+
+class findCallsVisitor (host: string) : cilVisitor = object
+ inherit nopCilVisitor
+
+ method vinst i =
+ match i with
+ | Call(_,Lval(Var(vi),NoOffset),_,l) ->
+ addCall host vi.vname;
+ SkipChildren
+
+ | Call(_,e,_,l) -> (* Calling a function pointer *)
+ addCall host functionPointerName;
+ SkipChildren
+
+ | _ -> SkipChildren (* No calls in other instructions *)
+
+ (* There are no calls in expressions and types *)
+ method vexpr e = SkipChildren
+ method vtype t = SkipChildren
+
+end
+
+(* Now detect the cycles in the call graph. Do a depth first search of the
+ * graph (stack is the list of nodes already visited in the current path).
+ * Return true if we have found a cycle. *)
+let rec breakCycles (stack: node list) (n: node) : bool =
+ if n.scanned then (* We have already scanned this node. There are no cycles
+ * going through this node *)
+ false
+ else if n.mustcheck then
+ (* We are reaching a node that we already know we much check. Return with
+ * no new cycles. *)
+ false
+ else if List.memq n stack then begin
+ (* We have found a cycle. Mark the node n to be checked and return *)
+ if debug then
+ ignore (E.log "Will place an overflow check in %s\n" n.name);
+ checkSomeFunctions := true;
+ n.mustcheck <- true;
+ n.scanned <- true;
+ true
+ end else begin
+ let res = List.exists (fun nd -> breakCycles (n :: stack) nd) n.succs in
+ n.scanned <- true;
+ if res && n.mustcheck then
+ false
+ else
+ res
+ end
+let findCheckPlacement () =
+ H.iter (fun _ nd ->
+ if nd.name <> functionPointerName
+ && not nd.scanned && not nd.mustcheck then begin
+ ignore (breakCycles [] nd)
+ end)
+ functionNodes
+
+let makeFunctionCallGraph (f: Cil.file) : unit =
+ init ();
+ (* Scan the file and construct the control-flow graph *)
+ List.iter
+ (function
+ GFun(fdec, _) ->
+ if fdec.svar.vaddrof then
+ addCall functionPointerName fdec.svar.vname;
+ let vis = new findCallsVisitor fdec.svar.vname in
+ ignore (visitCilBlock vis fdec.sbody)
+
+ | _ -> ())
+ f.globals
+
+let makeAndDumpFunctionCallGraph (f: file) =
+ makeFunctionCallGraph f;
+ dumpFunctionCallGraph ()
+
+
+let addCheck (f: Cil.file) : unit =
+ makeFunctionCallGraph f;
+ findCheckPlacement ();
+ if !checkSomeFunctions then begin
+ (* Add a declaration for the stack threshhold variable. The program is
+ * stopped when the stack top is less than this value. *)
+ let stackThreshholdVar = makeGlobalVar "___stack_threshhold" !upointType in
+ stackThreshholdVar.vstorage <- Extern;
+ (* And the initialization function *)
+ let computeStackThreshhold =
+ makeGlobalVar "___compute_stack_threshhold"
+ (TFun(!upointType, Some [], false, [])) in
+ computeStackThreshhold.vstorage <- Extern;
+ (* And the failure function *)
+ let stackOverflow =
+ makeGlobalVar "___stack_overflow"
+ (TFun(voidType, Some [], false, [])) in
+ stackOverflow.vstorage <- Extern;
+ f.globals <-
+ GVar(stackThreshholdVar, {init=None}, locUnknown) ::
+ GVarDecl(computeStackThreshhold, locUnknown) ::
+ GVarDecl(stackOverflow, locUnknown) :: f.globals;
+ (* Now scan and instrument each function definition *)
+ List.iter
+ (function
+ GFun(fdec, l) ->
+ (* If this is main we must introduce the initialization of the
+ * bottomOfStack *)
+ let nd = getFunctionNode fdec.svar.vname in
+ if fdec.svar.vname = "main" then begin
+ if nd.mustcheck then
+ E.s (E.error "The \"main\" function is recursive!!");
+ let loc = makeLocalVar fdec "__a_local" intType in
+ loc.vaddrof <- true;
+ fdec.sbody <-
+ mkBlock
+ [ mkStmtOneInstr
+ (Call (Some(var stackThreshholdVar),
+ Lval(var computeStackThreshhold), [], l));
+ mkStmt (Block fdec.sbody) ]
+ end else if nd.mustcheck then begin
+ let loc = makeLocalVar fdec "__a_local" intType in
+ loc.vaddrof <- true;
+ fdec.sbody <-
+ mkBlock
+ [ mkStmt
+ (If(BinOp(Le,
+ CastE(!upointType, AddrOf (var loc)),
+ Lval(var stackThreshholdVar), intType),
+ mkBlock [mkStmtOneInstr
+ (Call(None, Lval(var stackOverflow),
+ [], l))],
+ mkBlock [],
+ l));
+ mkStmt (Block fdec.sbody) ]
+ end else
+ ()
+
+ | _ -> ())
+ f.globals;
+ ()
+ end
+
+
+
+
diff --git a/cil/src/ext/stackoverflow.mli b/cil/src/ext/stackoverflow.mli
new file mode 100644
index 0000000..6ec0200
--- /dev/null
+++ b/cil/src/ext/stackoverflow.mli
@@ -0,0 +1,43 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* This module inserts code to check for stack overflow. It saves the address
+ * of the top of the stack in "main" and then it picks one function *)
+
+val addCheck: Cil.file -> unit
+
+val makeAndDumpFunctionCallGraph: Cil.file -> unit
diff --git a/cil/src/ext/usedef.ml b/cil/src/ext/usedef.ml
new file mode 100755
index 0000000..57f226a
--- /dev/null
+++ b/cil/src/ext/usedef.ml
@@ -0,0 +1,188 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+
+open Cil
+open Pretty
+
+(** compute use/def information *)
+
+module VS = Set.Make (struct
+ type t = Cil.varinfo
+ let compare v1 v2 = Pervasives.compare v1.vid v2.vid
+ end)
+
+(** Set this global to how you want to handle function calls *)
+let getUseDefFunctionRef: (exp -> VS.t * VS.t) ref =
+ ref (fun _ -> (VS.empty, VS.empty))
+
+(** Say if you want to consider a variable use *)
+let considerVariableUse: (varinfo -> bool) ref =
+ ref (fun _ -> true)
+
+
+(** Say if you want to consider a variable def *)
+let considerVariableDef: (varinfo -> bool) ref =
+ ref (fun _ -> true)
+
+(** Save if you want to consider a variable addrof as a use *)
+let considerVariableAddrOfAsUse: (varinfo -> bool) ref =
+ ref (fun _ -> true)
+
+(* When this is true, only definitions of a variable without
+ an offset are counted as definitions. So:
+ a = 5; would be a definition, but
+ a[1] = 5; would not *)
+let onlyNoOffsetsAreDefs: bool ref = ref false
+
+let varUsed: VS.t ref = ref VS.empty
+let varDefs: VS.t ref = ref VS.empty
+
+class useDefVisitorClass : cilVisitor = object (self)
+ inherit nopCilVisitor
+
+ (** this will be invoked on variable definitions only because we intercept
+ * all uses of variables in expressions ! *)
+ method vvrbl (v: varinfo) =
+ if (!considerVariableDef) v &&
+ not(!onlyNoOffsetsAreDefs) then
+ varDefs := VS.add v !varDefs;
+ SkipChildren
+
+ (** If onlyNoOffsetsAreDefs is true, then we need to see the
+ * varinfo in an lval along with the offset. Otherwise just
+ * DoChildren *)
+ method vlval (l: lval) =
+ if !onlyNoOffsetsAreDefs then
+ match l with
+ (Var vi, NoOffset) ->
+ if (!considerVariableDef) vi then
+ varDefs := VS.add vi !varDefs;
+ SkipChildren
+ | _ -> DoChildren
+ else DoChildren
+
+ method vexpr = function
+ Lval (Var v, off) ->
+ ignore (visitCilOffset (self :> cilVisitor) off);
+ if (!considerVariableUse) v then
+ varUsed := VS.add v !varUsed;
+ SkipChildren (* So that we do not see the v *)
+
+ | AddrOf (Var v, off)
+ | StartOf (Var v, off) ->
+ ignore (visitCilOffset (self :> cilVisitor) off);
+ if (!considerVariableAddrOfAsUse) v then
+ varUsed := VS.add v !varUsed;
+ SkipChildren
+
+ | _ -> DoChildren
+
+ (* For function calls, do the transitive variable read/defs *)
+ method vinst = function
+ Call (_, f, _, _) -> begin
+ (* we will call DoChildren to compute the use and def that appear in
+ * this instruction. We also add in the stuff computed by
+ * getUseDefFunctionRef *)
+ let use, def = !getUseDefFunctionRef f in
+ varUsed := VS.union !varUsed use;
+ varDefs := VS.union !varDefs def;
+ DoChildren;
+ end
+ | Asm(_,_,slvl,_,_,_) -> List.iter (fun (s,lv) ->
+ match lv with (Var v, off) ->
+ if s.[0] = '+' then
+ varUsed := VS.add v !varUsed;
+ | _ -> ()) slvl;
+ DoChildren
+ | _ -> DoChildren
+
+end
+
+let useDefVisitor = new useDefVisitorClass
+
+(** Compute the use information for an expression (accumulate to an existing
+ * set) *)
+let computeUseExp ?(acc=VS.empty) (e: exp) : VS.t =
+ varUsed := acc;
+ ignore (visitCilExpr useDefVisitor e);
+ !varUsed
+
+
+(** Compute the use/def information for an instruction *)
+let computeUseDefInstr ?(acc_used=VS.empty)
+ ?(acc_defs=VS.empty)
+ (i: instr) : VS.t * VS.t =
+ varUsed := acc_used;
+ varDefs := acc_defs;
+ ignore (visitCilInstr useDefVisitor i);
+ !varUsed, !varDefs
+
+
+(** Compute the use/def information for a statement kind. Do not descend into
+ * the nested blocks. *)
+let computeUseDefStmtKind ?(acc_used=VS.empty)
+ ?(acc_defs=VS.empty)
+ (sk: stmtkind) : VS.t * VS.t =
+ varUsed := acc_used;
+ varDefs := acc_defs;
+ let ve e = ignore (visitCilExpr useDefVisitor e) in
+ let _ =
+ match sk with
+ Return (None, _) -> ()
+ | Return (Some e, _) -> ve e
+ | If (e, _, _, _) -> ve e
+ | Break _ | Goto _ | Continue _ -> ()
+(*
+ | Loop (_, _, _, _) -> ()
+*)
+ | While _ | DoWhile _ | For _ -> ()
+ | Switch (e, _, _, _) -> ve e
+ | Instr il ->
+ List.iter (fun i -> ignore (visitCilInstr useDefVisitor i)) il
+ | TryExcept _ | TryFinally _ -> ()
+ | Block _ -> ()
+ in
+ !varUsed, !varDefs
+
+(* Compute the use/def information for a statement kind.
+ DO descend into nested blocks *)
+let rec computeDeepUseDefStmtKind ?(acc_used=VS.empty)
+ ?(acc_defs=VS.empty)
+ (sk: stmtkind) : VS.t * VS.t =
+ let handle_block b =
+ List.fold_left (fun (u,d) s ->
+ let u',d' = computeDeepUseDefStmtKind s.skind in
+ (VS.union u u', VS.union d d')) (VS.empty, VS.empty)
+ b.bstmts
+ in
+ varUsed := acc_used;
+ varDefs := acc_defs;
+ let ve e = ignore (visitCilExpr useDefVisitor e) in
+ match sk with
+ Return (None, _) -> !varUsed, !varDefs
+ | Return (Some e, _) ->
+ let _ = ve e in
+ !varUsed, !varDefs
+ | If (e, tb, fb, _) ->
+ let _ = ve e in
+ let u, d = !varUsed, !varDefs in
+ let u', d' = handle_block tb in
+ let u'', d'' = handle_block fb in
+ (VS.union (VS.union u u') u'', VS.union (VS.union d d') d'')
+ | Break _ | Goto _ | Continue _ -> !varUsed, !varDefs
+(*
+ | Loop (b, _, _, _) -> handle_block b
+*)
+ | While (_, b, _) -> handle_block b
+ | DoWhile (_, b, _) -> handle_block b
+ | For (_, _, _, b, _) -> handle_block b
+ | Switch (e, b, _, _) ->
+ let _ = ve e in
+ let u, d = !varUsed, !varDefs in
+ let u', d' = handle_block b in
+ (VS.union u u', VS.union d d')
+ | Instr il ->
+ List.iter (fun i -> ignore (visitCilInstr useDefVisitor i)) il;
+ !varUsed, !varDefs
+ | TryExcept _ | TryFinally _ -> !varUsed, !varDefs
+ | Block b -> handle_block b
diff --git a/cil/src/formatcil.ml b/cil/src/formatcil.ml
new file mode 100644
index 0000000..33bc749
--- /dev/null
+++ b/cil/src/formatcil.ml
@@ -0,0 +1,215 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+open Cil
+open Pretty
+open Trace (* sm: 'trace' function *)
+module E = Errormsg
+module H = Hashtbl
+
+let noMemoize = ref false
+
+let expMemoTable :
+ (string, (((string * formatArg) list -> exp) *
+ (exp -> formatArg list option))) H.t = H.create 23
+
+let typeMemoTable :
+ (string, (((string * formatArg) list -> typ) *
+ (typ -> formatArg list option))) H.t = H.create 23
+
+let lvalMemoTable :
+ (string, (((string * formatArg) list -> lval) *
+ (lval -> formatArg list option))) H.t = H.create 23
+
+let instrMemoTable :
+ (string, ((location -> (string * formatArg) list -> instr) *
+ (instr -> formatArg list option))) H.t = H.create 23
+
+let stmtMemoTable :
+ (string, ((string -> typ -> varinfo) ->
+ location ->
+ (string * formatArg) list -> stmt)) H.t = H.create 23
+
+let stmtsMemoTable :
+ (string, ((string -> typ -> varinfo) ->
+ location ->
+ (string * formatArg) list -> stmt list)) H.t = H.create 23
+
+
+let doParse (prog: string)
+ (theParser: (Lexing.lexbuf -> Formatparse.token)
+ -> Lexing.lexbuf -> 'a)
+ (memoTable: (string, 'a) H.t) : 'a =
+ try
+ if !noMemoize then raise Not_found else
+ H.find memoTable prog
+ with Not_found -> begin
+ let lexbuf = Formatlex.init prog in
+ try
+ Formatparse.initialize Formatlex.initial lexbuf;
+ let res = theParser Formatlex.initial lexbuf in
+ H.add memoTable prog res;
+ Formatlex.finish ();
+ res
+ with Parsing.Parse_error -> begin
+ Formatlex.finish ();
+ E.s (E.error "Parsing error: %s" prog)
+ end
+ | e -> begin
+ ignore (E.log "Caught %s while parsing\n" (Printexc.to_string e));
+ Formatlex.finish ();
+ raise e
+ end
+ end
+
+
+let cExp (prog: string) : (string * formatArg) list -> exp =
+ let cf = doParse prog Formatparse.expression expMemoTable in
+ (fst cf)
+
+let cLval (prog: string) : (string * formatArg) list -> lval =
+ let cf = doParse prog Formatparse.lval lvalMemoTable in
+ (fst cf)
+
+let cType (prog: string) : (string * formatArg) list -> typ =
+ let cf = doParse prog Formatparse.typename typeMemoTable in
+ (fst cf)
+
+let cInstr (prog: string) : location -> (string * formatArg) list -> instr =
+ let cf = doParse prog Formatparse.instr instrMemoTable in
+ (fst cf)
+
+let cStmt (prog: string) : (string -> typ -> varinfo) ->
+ location -> (string * formatArg) list -> stmt =
+ let cf = doParse prog Formatparse.stmt stmtMemoTable in
+ cf
+
+let cStmts (prog: string) :
+ (string -> typ -> varinfo) ->
+ location -> (string * formatArg) list -> stmt list =
+ let cf = doParse prog Formatparse.stmt_list stmtsMemoTable in
+ cf
+
+
+
+(* Match an expression *)
+let dExp (prog: string) : exp -> formatArg list option =
+ let df = doParse prog Formatparse.expression expMemoTable in
+ (snd df)
+
+(* Match an lvalue *)
+let dLval (prog: string) : lval -> formatArg list option =
+ let df = doParse prog Formatparse.lval lvalMemoTable in
+ (snd df)
+
+
+(* Match a type *)
+let dType (prog: string) : typ -> formatArg list option =
+ let df = doParse prog Formatparse.typename typeMemoTable in
+ (snd df)
+
+
+
+(* Match an instruction *)
+let dInstr (prog: string) : instr -> formatArg list option =
+ let df = doParse prog Formatparse.instr instrMemoTable in
+ (snd df)
+
+
+let test () =
+ (* Construct a dummy function *)
+ let func = emptyFunction "test_formatcil" in
+ (* Construct a few varinfo *)
+ let res = makeLocalVar func "res" (TPtr(intType, [])) in
+ let fptr = makeLocalVar func "fptr"
+ (TPtr(TFun(intType, None, false, []), [])) in
+ (* Construct an instruction *)
+ let makeInstr () =
+ Call(Some (var res),
+ Lval (Mem (CastE(TPtr(TFun(TPtr(intType, []),
+ Some [ ("", intType, []);
+ ("a2", TPtr(intType, []), []);
+ ("a3", TPtr(TPtr(intType, []),
+ []), []) ],
+ false, []), []),
+ Lval (var fptr))),
+ NoOffset),
+ [ ], locUnknown)
+ in
+ let times = 100000 in
+ (* Make the instruction the regular way *)
+ Stats.time "make instruction regular"
+ (fun _ -> for i = 0 to times do ignore (makeInstr ()) done)
+ ();
+ (* Now make the instruction interpreted *)
+ noMemoize := true;
+ Stats.time "make instruction interpreted"
+ (fun _ -> for i = 0 to times do
+ let _ =
+ cInstr "%v:res = (* ((int * (*)(int, int * a2, int * * a3))%v:fptr))();"
+ locUnknown [ ("res", Fv res);
+ ("fptr", Fv fptr) ]
+ in
+ ()
+ done)
+ ();
+ (* Now make the instruction interpreted with memoization *)
+ noMemoize := false;
+ Stats.time "make instruction interpreted memoized"
+ (fun _ -> for i = 0 to times do
+ let _ =
+ cInstr "%v:res = (* ((int * (*)(int, int * a2, int * * a3))%v:fptr))();"
+ locUnknown [ ("res", Fv res); ("fptr", Fv fptr) ]
+ in
+ ()
+ done)
+ ();
+ (* Now make the instruction interpreted with partial application *)
+ let partInstr =
+ cInstr "%v:res = (* ((int * (*)(int, int * a2, int * * a3))%v:fptr))();" in
+ Stats.time "make instruction interpreted partial"
+ (fun _ -> for i = 0 to times do
+ let _ =
+ partInstr
+ locUnknown [ ("res", Fv res); ("fptr", Fv fptr) ]
+ in
+ ()
+ done)
+ ();
+
+ ()
+
+
diff --git a/cil/src/formatcil.mli b/cil/src/formatcil.mli
new file mode 100644
index 0000000..d353c5e
--- /dev/null
+++ b/cil/src/formatcil.mli
@@ -0,0 +1,103 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(** {b An Interpreter for constructing CIL constructs} *)
+
+
+(** Constructs an expression based on the program and the list of arguments.
+ * Each argument consists of a name followed by the actual data. This
+ * argument will be placed instead of occurrences of "%v:name" in the pattern
+ * (where the "v" is dependent on the type of the data). The parsing of the
+ * string is memoized. * Only the first expression is parsed. *)
+val cExp: string -> (string * Cil.formatArg) list -> Cil.exp
+
+(** Constructs an lval based on the program and the list of arguments.
+ * Only the first lvalue is parsed.
+ * The parsing of the string is memoized. *)
+val cLval: string -> (string * Cil.formatArg) list -> Cil.lval
+
+(** Constructs a type based on the program and the list of arguments.
+ * Only the first type is parsed.
+ * The parsing of the string is memoized. *)
+val cType: string -> (string * Cil.formatArg) list -> Cil.typ
+
+
+(** Constructs an instruction based on the program and the list of arguments.
+ * Only the first instruction is parsed.
+ * The parsing of the string is memoized. *)
+val cInstr: string -> Cil.location ->
+ (string * Cil.formatArg) list -> Cil.instr
+
+(* Constructs a statement based on the program and the list of arguments. We
+ * also pass a function that can be used to make new varinfo's for the
+ * declared variables, and a location to be used for the statements. Only the
+ * first statement is parsed. The parsing of the string is memoized. *)
+val cStmt: string ->
+ (string -> Cil.typ -> Cil.varinfo) ->
+ Cil.location -> (string * Cil.formatArg) list -> Cil.stmt
+
+(** Constructs a list of statements *)
+val cStmts: string ->
+ (string -> Cil.typ -> Cil.varinfo) ->
+ Cil.location -> (string * Cil.formatArg) list ->
+ Cil.stmt list
+
+(** Deconstructs an expression based on the program. Produces an optional
+ * list of format arguments. The parsing of the string is memoized. *)
+val dExp: string -> Cil.exp -> Cil.formatArg list option
+
+(** Deconstructs an lval based on the program. Produces an optional
+ * list of format arguments. The parsing of the string is memoized. *)
+val dLval: string -> Cil.lval -> Cil.formatArg list option
+
+
+(** Deconstructs a type based on the program. Produces an optional list of
+ * format arguments. The parsing of the string is memoized. *)
+val dType: string -> Cil.typ -> Cil.formatArg list option
+
+
+(** Deconstructs an instruction based on the program. Produces an optional
+ * list of format arguments. The parsing of the string is memoized. *)
+val dInstr: string -> Cil.instr -> Cil.formatArg list option
+
+
+(** If set then will not memoize the parsed patterns *)
+val noMemoize: bool ref
+
+(** Just a testing function *)
+val test: unit -> unit
diff --git a/cil/src/formatlex.mll b/cil/src/formatlex.mll
new file mode 100644
index 0000000..584a060
--- /dev/null
+++ b/cil/src/formatlex.mll
@@ -0,0 +1,308 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(* A simple lexical analyzer for constructing CIL based on format strings *)
+{
+open Formatparse
+exception Eof
+exception InternalError of string
+module H = Hashtbl
+module E = Errormsg
+(*
+** Keyword hashtable
+*)
+let keywords = H.create 211
+
+(*
+** Useful primitives
+*)
+let scan_ident id =
+ try H.find keywords id
+ with Not_found -> IDENT id (* default to variable name *)
+
+(*
+** Buffer processor
+*)
+
+
+let init ~(prog: string) : Lexing.lexbuf =
+ H.clear keywords;
+ Lexerhack.currentPattern := prog;
+ List.iter
+ (fun (key, token) -> H.add keywords key token)
+ [ ("const", CONST); ("__const", CONST); ("__const__", CONST);
+ ("static", STATIC);
+ ("extern", EXTERN);
+ ("long", LONG);
+ ("short", SHORT);
+ ("signed", SIGNED);
+ ("unsigned", UNSIGNED);
+ ("volatile", VOLATILE);
+ ("char", CHAR);
+ ("int", INT);
+ ("float", FLOAT);
+ ("double", DOUBLE);
+ ("void", VOID);
+ ("enum", ENUM);
+ ("struct", STRUCT);
+ ("typedef", TYPEDEF);
+ ("union", UNION);
+ ("break", BREAK);
+ ("continue", CONTINUE);
+ ("goto", GOTO);
+ ("return", RETURN);
+ ("switch", SWITCH);
+ ("case", CASE);
+ ("default", DEFAULT);
+ ("while", WHILE);
+ ("do", DO);
+ ("for", FOR);
+ ("if", IF);
+ ("else", ELSE);
+ ("__attribute__", ATTRIBUTE); ("__attribute", ATTRIBUTE);
+ ("__int64", INT64);
+ ("__builtin_va_arg", BUILTIN_VA_ARG);
+ ];
+ E.startParsingFromString prog
+
+let finish () =
+ E.finishParsing ()
+
+(*** Error handling ***)
+let error msg =
+ E.parse_error msg
+
+
+(*** escape character management ***)
+let scan_escape str =
+ match str with
+ "n" -> "\n"
+ | "r" -> "\r"
+ | "t" -> "\t"
+ | "b" -> "\b"
+ | "f" -> "\012" (* ASCII code 12 *)
+ | "v" -> "\011" (* ASCII code 11 *)
+ | "a" -> "\007" (* ASCII code 7 *)
+ | "e" -> "\027" (* ASCII code 27. This is a GCC extension *)
+ | _ -> str
+
+let get_value chr =
+ match chr with
+ '0'..'9' -> (Char.code chr) - (Char.code '0')
+ | 'a'..'z' -> (Char.code chr) - (Char.code 'a') + 10
+ | 'A'..'Z' -> (Char.code chr) - (Char.code 'A') + 10
+ | _ -> 0
+let scan_hex_escape str =
+ String.make 1 (Char.chr (
+ (get_value (String.get str 0)) * 16
+ + (get_value (String.get str 1))
+ ))
+let scan_oct_escape str =
+ (* weimer: wide-character constants like L'\400' may be bigger than
+ * 256 (in fact, may be up to 511), so Char.chr cannot be used directly *)
+ let the_value = (get_value (String.get str 0)) * 64
+ + (get_value (String.get str 1)) * 8
+ + (get_value (String.get str 2)) in
+ if the_value < 256 then String.make 1 (Char.chr the_value )
+ else (String.make 1 (Char.chr (the_value / 256))) ^
+ (String.make 1 (Char.chr (the_value mod 256)))
+
+(* ISO standard locale-specific function to convert a wide character
+ * into a sequence of normal characters. Here we work on strings.
+ * We convert L"Hi" to "H\000i\000" *)
+let wbtowc wstr =
+ let len = String.length wstr in
+ let dest = String.make (len * 2) '\000' in
+ for i = 0 to len-1 do
+ dest.[i*2] <- wstr.[i] ;
+ done ;
+ dest
+
+(* This function converst the "Hi" in L"Hi" to { L'H', L'i', L'\0' } *)
+let wstr_to_warray wstr =
+ let len = String.length wstr in
+ let res = ref "{ " in
+ for i = 0 to len-1 do
+ res := !res ^ (Printf.sprintf "L'%c', " wstr.[i])
+ done ;
+ res := !res ^ "}" ;
+ !res
+
+let getArgName (l: Lexing.lexbuf) (prefixlen: int) =
+ let lexeme = Lexing.lexeme l in
+ let ll = String.length lexeme in
+ if ll > prefixlen then
+ String.sub lexeme (prefixlen + 1) (ll - prefixlen - 1)
+ else
+ ""
+}
+
+let decdigit = ['0'-'9']
+let octdigit = ['0'-'7']
+let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F']
+let letter = ['a'- 'z' 'A'-'Z']
+
+let floatsuffix = ['f' 'F' 'l' 'L']
+
+let usuffix = ['u' 'U']
+let lsuffix = "l"|"L"|"ll"|"LL"
+let intsuffix = lsuffix | usuffix | usuffix lsuffix | lsuffix usuffix
+
+let intnum = decdigit+ intsuffix?
+let octnum = '0' octdigit+ intsuffix?
+let hexnum = '0' ['x' 'X'] hexdigit+ intsuffix?
+
+let exponent = ['e' 'E']['+' '-']? decdigit+
+let fraction = '.' decdigit+
+let floatraw = (intnum? fraction)
+ |(intnum exponent)
+ |(intnum? fraction exponent)
+ |(intnum '.')
+ |(intnum '.' exponent)
+let floatnum = floatraw floatsuffix?
+
+let ident = (letter|'_')(letter|decdigit|'_')*
+let attribident = (letter|'_')(letter|decdigit|'_'|':')
+let blank = [' ' '\t' '\012' '\r']
+let escape = '\\' _
+let hex_escape = '\\' ['x' 'X'] hexdigit hexdigit
+let oct_escape = '\\' octdigit octdigit octdigit
+
+
+(* The arguments are of the form %l:foo *)
+let argname = ':' ident
+
+rule initial =
+ parse blank { initial lexbuf}
+| "/*" { let _ = comment lexbuf in
+ initial lexbuf}
+| "//" { endline lexbuf }
+| "\n" { E.newline (); initial lexbuf}
+| floatnum {CST_FLOAT (Lexing.lexeme lexbuf)}
+| hexnum {CST_INT (Lexing.lexeme lexbuf)}
+| octnum {CST_INT (Lexing.lexeme lexbuf)}
+| intnum {CST_INT (Lexing.lexeme lexbuf)}
+
+| "<<=" {INF_INF_EQ}
+| ">>=" {SUP_SUP_EQ}
+| "*=" {STAR_EQ}
+| "/=" {SLASH_EQ}
+| "&=" {AND_EQ}
+| "|=" {PIPE_EQ}
+| "^=" {CIRC_EQ}
+| "%=" {PERCENT_EQ}
+
+
+| "..." {ELLIPSIS}
+| "-=" {MINUS_EQ}
+| "+=" {PLUS_EQ}
+| "*=" {STAR_EQ}
+| "<<" {INF_INF}
+| ">>" {SUP_SUP}
+| "==" {EQ_EQ}
+| "!=" {EXCLAM_EQ}
+| "<=" {INF_EQ}
+| ">=" {SUP_EQ}
+| "=" {EQ}
+| "<" {INF}
+| ">" {SUP}
+| "++" {PLUS_PLUS}
+| "--" {MINUS_MINUS}
+| "->" {ARROW}
+| '+' {PLUS}
+| '-' {MINUS}
+| '*' {STAR}
+| '/' {SLASH}
+| '!' {EXCLAM}
+| '&' {AND}
+| '|' {PIPE}
+| '^' {CIRC}
+| '~' {TILDE}
+| '[' {LBRACKET}
+| ']' {RBRACKET}
+| '{' {LBRACE}
+| '}' {RBRACE}
+| '(' {LPAREN}
+| ')' {RPAREN}
+| ';' {SEMICOLON}
+| ',' {COMMA}
+| '.' {DOT}
+| ':' {COLON}
+| '?' {QUEST}
+| "sizeof" {SIZEOF}
+
+| "%eo" argname {ARG_eo (getArgName lexbuf 3) }
+| "%e" argname {ARG_e (getArgName lexbuf 2) }
+| "%E" argname {ARG_E (getArgName lexbuf 2) }
+| "%u" argname {ARG_u (getArgName lexbuf 2) }
+| "%b" argname {ARG_b (getArgName lexbuf 2) }
+| "%t" argname {ARG_t (getArgName lexbuf 2) }
+| "%d" argname {ARG_d (getArgName lexbuf 2) }
+| "%lo" argname {ARG_lo (getArgName lexbuf 3) }
+| "%l" argname {ARG_l (getArgName lexbuf 2) }
+| "%i" argname {ARG_i (getArgName lexbuf 2) }
+| "%I" argname {ARG_I (getArgName lexbuf 2) }
+| "%o" argname {ARG_o (getArgName lexbuf 2) }
+| "%va" argname {ARG_va (getArgName lexbuf 3) }
+| "%v" argname {ARG_v (getArgName lexbuf 2) }
+| "%k" argname {ARG_k (getArgName lexbuf 2) }
+| "%f" argname {ARG_f (getArgName lexbuf 2) }
+| "%F" argname {ARG_F (getArgName lexbuf 2) }
+| "%p" argname {ARG_p (getArgName lexbuf 2) }
+| "%P" argname {ARG_P (getArgName lexbuf 2) }
+| "%s" argname {ARG_s (getArgName lexbuf 2) }
+| "%S" argname {ARG_S (getArgName lexbuf 2) }
+| "%g" argname {ARG_g (getArgName lexbuf 2) }
+| "%A" argname {ARG_A (getArgName lexbuf 2) }
+| "%c" argname {ARG_c (getArgName lexbuf 2) }
+
+| '%' {PERCENT}
+| ident {scan_ident (Lexing.lexeme lexbuf)}
+| eof {EOF}
+| _ {E.parse_error
+ "Formatlex: Invalid symbol"
+ }
+
+and comment =
+ parse
+ "*/" { () }
+| '\n' { E.newline (); comment lexbuf }
+| _ { comment lexbuf }
+
+
+and endline = parse
+ '\n' { E.newline (); initial lexbuf}
+| _ { endline lexbuf}
diff --git a/cil/src/formatparse.mly b/cil/src/formatparse.mly
new file mode 100644
index 0000000..75bdbb3
--- /dev/null
+++ b/cil/src/formatparse.mly
@@ -0,0 +1,1455 @@
+/* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. */
+
+/*(* Parser for constructing CIL from format strings *)
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+*/
+%{
+open Cil
+open Pretty
+module E = Errormsg
+
+let parse_error msg : 'a = (* sm: c++-mode highlight hack: -> ' <- *)
+ E.hadErrors := true;
+ E.parse_error
+ msg
+
+
+let getArg (argname: string) (args: (string * formatArg) list) =
+ try
+ snd (List.find (fun (n, a) -> n = argname) args)
+ with _ ->
+ E.s (error "Pattern string %s does not have argument with name %s\n"
+ !Lexerhack.currentPattern argname)
+
+let wrongArgType (which: string) (expected: string) (found: formatArg) =
+ E.s (bug "Expecting %s argument (%s) and found %a\n"
+ expected which d_formatarg found)
+
+let doUnop (uo: unop) subexp =
+ ((fun args ->
+ let e = (fst subexp) args in
+ UnOp(uo, e, typeOf e)),
+
+ (fun e -> match e with
+ UnOp(uo', e', _) when uo = uo' -> (snd subexp) e'
+ | _ -> None))
+
+let buildPlus e1 e2 : exp =
+ let t1 = typeOf e1 in
+ if isPointerType t1 then
+ BinOp(PlusPI, e1, e2, t1)
+ else
+ BinOp(PlusA, e1, e2, t1)
+
+let buildMinus e1 e2 : exp =
+ let t1 = typeOf e1 in
+ let t2 = typeOf e2 in
+ if isPointerType t1 then
+ if isPointerType t2 then
+ BinOp(MinusPP, e1, e2, intType)
+ else
+ BinOp(MinusPI, e1, e2, t1)
+ else
+ BinOp(MinusA, e1, e2, t1)
+
+let doBinop bop e1t e2t =
+ ((fun args ->
+ let e1 = (fst e1t) args in
+ let e2 = (fst e2t) args in
+ let t1 = typeOf e1 in
+ BinOp(bop, e1, e2, t1)),
+
+ (fun e -> match e with
+ BinOp(bop', e1, e2, _) when bop' = bop -> begin
+ match (snd e1t) e1, (snd e2t) e2 with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+
+(* Check the equivalence of two format lists *)
+let rec checkSameFormat (fl1: formatArg list) (fl2: formatArg list) =
+ match fl1, fl2 with
+ [], [] -> true
+ | h1::t1, h2::t2 -> begin
+ let rec checkOffsetEq o1 o2 =
+ match o1, o2 with
+ NoOffset, NoOffset -> true
+ | Field(f1, o1'), Field(f2, o2') ->
+ f1.fname = f2.fname && checkOffsetEq o1' o2'
+ | Index(e1, o1'), Index(e2, o2') ->
+ checkOffsetEq o1' o2' && checkExpEq e1 e2
+ | _, _ -> false
+
+ and checkExpEq e1 e2 =
+ match e1, e2 with
+ Const(CInt64(n1, _, _)), Const(CInt64(n2, _, _)) -> n1 = n2
+ | Lval l1, Lval l2 -> checkLvalEq l1 l2
+ | UnOp(uo1, e1, _), UnOp(uo2, e2, _) ->
+ uo1 = uo2 && checkExpEq e1 e2
+ | BinOp(bo1, e11, e12, _), BinOp(bo2, e21, e22, _) ->
+ bo1 = bo2 && checkExpEq e11 e21 && checkExpEq e21 e22
+ | AddrOf l1, AddrOf l2 -> checkLvalEq l1 l2
+ | StartOf l1, StartOf l2 -> checkLvalEq l1 l2
+ | SizeOf t1, SizeOf t2 -> typeSig t1 = typeSig t2
+ | _, _ ->
+ ignore (E.warn "checkSameFormat for Fe"); false
+
+ and checkLvalEq l1 l2 =
+ match l1, l2 with
+ (Var v1, o1), (Var v2, o2) -> v1 == v2 && checkOffsetEq o1 o2
+ | (Mem e1, o1), (Mem e2, o2) ->
+ checkOffsetEq o1 o2 && checkExpEq e1 e2
+ | _, _ -> false
+ in
+ let hdeq =
+ match h1, h2 with
+ Fv v1, Fv v2 -> v1 == v2
+ | Fd n1, Fd n2 -> n1 = n2
+ | Fe e1, Fe e2 -> checkExpEq e1 e2
+ | Fi i1, Fi i2 -> ignore (E.warn "checkSameFormat for Fi"); false
+ | Ft t1, Ft t2 -> typeSig t1 = typeSig t2
+ | Fl l1, Fl l2 -> checkLvalEq l1 l2
+ | Fo o1, Fo o2 -> checkOffsetEq o1 o2
+ | Fc c1, Fc c2 -> c1 == c2
+ | _, _ -> false
+ in
+ hdeq || checkSameFormat t1 t2
+ end
+ | _, _ -> false
+
+let matchBinopEq (bopeq: binop -> bool) lvt et =
+ (fun i -> match i with
+ Set (lv, BinOp(bop', Lval (lv'), e', _), l) when bopeq bop' -> begin
+ match lvt lv, lvt lv', et e' with
+ Some m1, Some m1', Some m2 ->
+ (* Must check that m1 and m2 are the same *)
+ if checkSameFormat m1 m1' then
+ Some (m1 @ m2)
+ else
+ None
+ | _, _, _ -> None
+ end
+ | _ -> None)
+
+let doBinopEq bop lvt et =
+ ((fun loc args ->
+ let l = (fst lvt) args in
+ Set(l, BinOp(bop, (Lval l), (fst et) args, typeOfLval l), loc)),
+
+ matchBinopEq (fun bop' -> bop = bop') (snd lvt) (snd et))
+
+
+let getField (bt: typ) (fname: string) : fieldinfo =
+ match unrollType bt with
+ TComp(ci, _) -> begin
+ try
+ List.find (fun f -> fname = f.fname) ci.cfields
+ with Not_found ->
+ E.s (bug "Cannot find field %s in %s\n" fname (compFullName ci))
+ end
+ | t -> E.s (bug "Trying to access field %s in non-struct\n" fname)
+
+
+let matchIntType (ik: ikind) (t:typ) : formatArg list option =
+ match unrollType t with
+ TInt(ik', _) when ik = ik' -> Some []
+ | _ -> None
+
+let matchFloatType (fk: fkind) (t:typ) : formatArg list option =
+ match unrollType t with
+ TFloat(fk', _) when fk = fk' -> Some []
+ | _ -> None
+
+let doAttr (id: string)
+ (aargs: (((string * formatArg) list -> attrparam list) *
+ (attrparam list -> formatArg list option)) option)
+ =
+ let t = match aargs with
+ Some t -> t
+ | None -> (fun _ -> []),
+ (function [] -> Some [] | _ -> None)
+ in
+ ((fun args -> Attr (id, (fst t) args)),
+
+ (fun attrs ->
+ (* Find the attributes with the same ID *)
+ List.fold_left
+ (fun acc a ->
+ match acc, a with
+ Some _, _ -> acc (* We found one already *)
+ | None, Attr(id', args) when id = id' ->
+ (* Now match the arguments *)
+ (snd t) args
+ | None, _ -> acc)
+ None
+ attrs))
+
+
+type falist = formatArg list
+
+type maybeInit =
+ NoInit
+ | InitExp of exp
+ | InitCall of lval * exp list
+
+%}
+
+%token <string> IDENT
+%token <string> CST_CHAR
+%token <string> CST_INT
+%token <string> CST_FLOAT
+%token <string> CST_STRING
+%token <string> CST_WSTRING
+%token <string> NAMED_TYPE
+
+%token EOF
+%token CHAR INT DOUBLE FLOAT VOID INT64 INT32
+%token ENUM STRUCT TYPEDEF UNION
+%token SIGNED UNSIGNED LONG SHORT
+%token VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
+
+%token <string> ARG_e ARG_eo ARG_E ARG_u ARG_b ARG_t ARG_d ARG_lo ARG_l ARG_i
+%token <string> ARG_o ARG_va ARG_f ARG_F ARG_A ARG_v ARG_k ARG_c ARG_d
+%token <string> ARG_s ARG_p ARG_P ARG_I ARG_S ARG_g
+
+%token SIZEOF ALIGNOF
+
+%token EQ
+%token ARROW DOT
+
+%token EQ_EQ EXCLAM_EQ INF SUP INF_EQ SUP_EQ
+%token MINUS_EQ PLUS_EQ STAR_EQ
+%token PLUS MINUS STAR SLASH PERCENT
+%token TILDE AND PIPE CIRC
+%token EXCLAM AND_AND PIPE_PIPE
+%token INF_INF SUP_SUP
+%token PLUS_PLUS MINUS_MINUS
+
+%token RPAREN LPAREN RBRACE LBRACE LBRACKET RBRACKET
+%token COLON SEMICOLON COMMA ELLIPSIS QUEST
+
+%token BREAK CONTINUE GOTO RETURN
+%token SWITCH CASE DEFAULT
+%token WHILE DO FOR
+%token IF THEN ELSE
+
+%token PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
+%token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
+
+%token ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__ LABEL__
+%token BUILTIN_VA_ARG BUILTIN_VA_LIST
+%token BLOCKATTRIBUTE
+%token DECLSPEC
+%token <string> MSASM MSATTR
+%token PRAGMA
+
+
+/* operator precedence */
+%nonassoc IF
+%nonassoc ELSE
+
+
+%left COMMA
+
+ /*(* Set the following precedences higer than COMMA *)*/
+%nonassoc ARG_e ARG_d ARG_lo ARG_l ARG_i ARG_v ARG_I ARG_g
+%right EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
+ AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
+%right COLON
+%left PIPE_PIPE
+%left AND_AND
+%left ARG_b
+%left PIPE
+%left CIRC
+%left AND
+%left EQ_EQ EXCLAM_EQ
+%left INF SUP INF_EQ SUP_EQ
+%left INF_INF SUP_SUP
+%left PLUS MINUS
+%left STAR SLASH PERCENT CONST RESTRICT VOLATILE
+%right ARG_u EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF
+%left LBRACKET
+%left DOT ARROW LPAREN LBRACE
+%nonassoc IDENT QUEST CST_INT
+
+%start initialize expression typename offset lval instr stmt stmt_list
+
+
+%type <unit> initialize
+%type <((string -> Cil.typ -> Cil.varinfo) -> Cil.location -> (string * Cil.formatArg) list -> Cil.stmt)> stmt
+%type <((string -> Cil.typ -> Cil.varinfo) -> Cil.location -> (string * Cil.formatArg) list -> Cil.stmt list)> stmt_list
+
+%type <((string * Cil.formatArg) list -> Cil.exp) * (Cil.exp -> Cil.formatArg list option)> expression
+
+%type <((string * Cil.formatArg) list -> Cil.exp) * (Cil.exp -> Cil.formatArg list option)> constant
+
+%type <((string * Cil.formatArg) list -> Cil.lval) * (Cil.lval -> Cil.formatArg list option)> lval
+
+%type <((string * Cil.formatArg) list -> Cil.typ) * (Cil.typ -> Cil.formatArg list option)> typename
+
+%type <(Cil.attributes -> (string * Cil.formatArg) list -> Cil.typ) * (Cil.typ -> Cil.formatArg list option)> type_spec
+
+%type <((string * Cil.formatArg) list -> (string * Cil.typ * Cil.attributes) list option * bool) * ((string * Cil.typ * Cil.attributes) list option * bool -> Cil.formatArg list option)> parameters
+
+
+%type <(Cil.location -> (string * Cil.formatArg) list -> Cil.instr) * (Cil.instr -> Cil.formatArg list option)> instr
+
+%type <(Cil.typ -> (string * Cil.formatArg) list -> Cil.offset) * (Cil.offset -> Cil.formatArg list option)> offset
+
+
+%%
+
+
+initialize:
+ /* empty */ { }
+;
+
+/* (*** Expressions ***) */
+
+
+expression:
+| ARG_e { (* Count arguments eagerly *)
+ let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fe e -> e
+ | a -> wrongArgType currentArg
+ "expression" a),
+
+ (fun e -> Some [ Fe e ]))
+ }
+
+| constant { $1 }
+
+| lval %prec IDENT
+ { ((fun args -> Lval ((fst $1) args)),
+
+ (fun e -> match e with
+ Lval l -> (snd $1) l
+ | _ -> None))
+ }
+
+| SIZEOF expression
+ { ((fun args -> SizeOfE ((fst $2) args)),
+
+ fun e -> match e with
+ SizeOfE e' -> (snd $2) e'
+ | _ -> None)
+ }
+
+| SIZEOF LPAREN typename RPAREN
+ { ((fun args -> SizeOf ((fst $3) args)),
+
+ (fun e -> match e with
+ SizeOf t -> (snd $3) t
+ | _ -> None))
+ }
+
+| ALIGNOF expression
+ { ((fun args -> AlignOfE ((fst $2) args)),
+
+ (fun e -> match e with
+ AlignOfE e' -> (snd $2) e' | _ -> None))
+ }
+
+| ALIGNOF LPAREN typename RPAREN
+ { ((fun args -> AlignOf ((fst $3) args)),
+
+ (fun e -> match e with
+ AlignOf t' -> (snd $3) t' | _ -> None))
+ }
+
+| PLUS expression
+ { $2 }
+| MINUS expression
+ { doUnop Neg $2 }
+
+| EXCLAM expression
+ { doUnop LNot $2 }
+
+| TILDE expression
+ { doUnop BNot $2 }
+
+| argu expression %prec ARG_u
+ { ((fun args ->
+ let e = (fst $2) args in
+ UnOp((fst $1) args, e, typeOf e)),
+
+ (fun e -> match e with
+ UnOp(uo, e', _) -> begin
+ match (snd $1) uo, (snd $2) e' with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _ -> None
+ end
+ | _ -> None))
+ }
+
+
+| AND expression %prec ADDROF
+ { ((fun args ->
+ match (fst $2) args with
+ Lval l -> mkAddrOf l
+ | _ -> E.s (bug "AddrOf applied to a non lval")),
+ (fun e -> match e with
+ AddrOf l -> (snd $2) (Lval l)
+ | e -> (snd $2) (Lval (mkMem e NoOffset))))
+ }
+
+| LPAREN expression RPAREN
+ { $2 }
+
+| expression PLUS expression
+ { ((fun args -> buildPlus ((fst $1) args)
+ ((fst $3) args)),
+ (fun e -> match e with
+ BinOp((PlusPI|PlusA), e1, e2, _) -> begin
+ match (snd $1) e1, (snd $3) e2 with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+
+| expression MINUS expression
+ { ((fun args -> buildMinus ((fst $1) args)
+ ((fst $3) args)),
+
+ (fun e -> match e with
+ BinOp((MinusPP|MinusPI|MinusA), e1, e2, _) ->
+ begin
+ match (snd $1) e1, (snd $3) e2 with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+| expression argb expression %prec ARG_b
+ { ((fun args ->
+ let e1 = (fst $1) args in
+ let bop = (fst $2) args in
+ let e2 = (fst $3) args in
+ let t1 = typeOf e1 in
+ BinOp(bop, e1, e2, t1)),
+
+ (fun e -> match e with
+ BinOp(bop, e1, e2, _) -> begin
+ match (snd $1) e1,(snd $2) bop,(snd $3) e2 with
+ Some m1, Some m2, Some m3 ->
+ Some (m1 @ m2 @ m3)
+ | _, _, _ -> None
+ end
+ | _ -> None))
+ }
+
+| expression STAR expression
+ { doBinop Mult $1 $3 }
+| expression SLASH expression
+ { doBinop Div $1 $3 }
+| expression PERCENT expression
+ { doBinop Mod $1 $3 }
+| expression INF_INF expression
+ { doBinop Shiftlt $1 $3 }
+| expression SUP_SUP expression
+ { doBinop Shiftrt $1 $3 }
+| expression AND expression
+ { doBinop BAnd $1 $3 }
+| expression PIPE expression
+ { doBinop BOr $1 $3 }
+| expression CIRC expression
+ { doBinop BXor $1 $3 }
+| expression EQ_EQ expression
+ { doBinop Eq $1 $3 }
+| expression EXCLAM_EQ expression
+ { doBinop Ne $1 $3 }
+| expression INF expression
+ { doBinop Lt $1 $3 }
+| expression SUP expression
+ { doBinop Gt $1 $3 }
+| expression INF_EQ expression
+ { doBinop Le $1 $3 }
+| expression SUP_EQ expression
+ { doBinop Ge $1 $3 }
+
+| LPAREN typename RPAREN expression
+ { ((fun args ->
+ let t = (fst $2) args in
+ let e = (fst $4) args in
+ mkCast e t),
+
+ (fun e ->
+ let t', e' =
+ match e with
+ CastE (t', e') -> t', e'
+ | _ -> typeOf e, e
+ in
+ match (snd $2) t', (snd $4 e') with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None))
+ }
+;
+
+/*(* Separate the ARG_ to ensure that the counting of arguments is right *)*/
+argu :
+| ARG_u { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fu uo -> uo
+ | a -> wrongArgType currentArg "unnop" a),
+
+ fun uo -> Some [ Fu uo ])
+ }
+;
+
+argb :
+| ARG_b { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fb bo -> bo
+ | a -> wrongArgType currentArg "binop" a),
+
+ fun bo -> Some [ Fb bo ])
+ }
+;
+
+constant:
+| ARG_d { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fd n -> integer n
+ | a -> wrongArgType currentArg "integer" a),
+
+ fun e -> match e with
+ Const(CInt64(n, _, _)) ->
+ Some [ Fd (Int64.to_int n) ]
+ | _ -> None)
+ }
+
+| ARG_g { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fg s -> Const(CStr s)
+ | a -> wrongArgType currentArg "string" a),
+
+ fun e -> match e with
+ Const(CStr s) ->
+ Some [ Fg s ]
+ | _ -> None)
+ }
+| CST_INT { let n = parseInt $1 in
+ ((fun args -> n),
+
+ (fun e -> match e, n with
+ Const(CInt64(e', _, _)),
+ Const(CInt64(n', _, _)) when e' = n' -> Some []
+ | _ -> None))
+ }
+;
+
+
+/*(***************** LVALUES *******************)*/
+lval:
+| ARG_l { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fl l -> l
+ | Fv v -> Var v, NoOffset
+ | a -> wrongArgType currentArg "lval" a),
+
+ fun l -> Some [ Fl l ])
+ }
+
+| argv offset %prec ARG_v
+ { ((fun args ->
+ let v = (fst $1) args in
+ (Var v, (fst $2) v.vtype args)),
+
+ (fun l -> match l with
+ Var vi, off -> begin
+ match (snd $1) vi, (snd $2) off with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _ -> None
+ end
+ | _ -> None))
+ }
+
+| STAR expression { ((fun args -> mkMem ((fst $2) args) NoOffset),
+
+ (fun l -> match l with
+ Mem e, NoOffset -> (snd $2) e
+ | _, _ -> None))
+ }
+
+| expression ARROW IDENT offset
+ { ((fun args ->
+ let e = (fst $1) args in
+ let baset =
+ match unrollTypeDeep (typeOf e) with
+ TPtr (t, _) -> t
+ | _ -> E.s (bug "Expecting a pointer for field %s\n" $3)
+ in
+ let fi = getField baset $3 in
+ mkMem e (Field(fi, (fst $4) fi.ftype args))),
+
+ (fun l -> match l with
+ Mem e, Field(fi, off) when fi.fname = $3 -> begin
+ match (snd $1) e, (snd $4) off with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _, _ -> None))
+ }
+
+| LPAREN STAR expression RPAREN offset
+ { ((fun args ->
+ let e = (fst $3) args in
+ let baset =
+ match unrollTypeDeep (typeOf e) with
+ TPtr (t, _) -> t
+ | _ -> E.s (bug "Expecting a pointer\n")
+ in
+ mkMem e ((fst $5) baset args)),
+
+ (fun l -> match l with
+ Mem e, off -> begin
+ match (snd $3) e, (snd $5 off) with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _, _ -> None))
+ }
+ ;
+
+argv :
+| ARG_v { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fv v -> v
+ | a -> wrongArgType currentArg "varinfo" a),
+
+ fun v -> Some [ Fv v ])
+ }
+| IDENT { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fv v -> v
+ | a -> wrongArgType currentArg "varinfo" a),
+ (fun v ->
+ E.s (bug "identifiers (%s) are not supported for deconstruction" currentArg)))
+ }
+;
+
+
+/*(********** OFFSETS *************)*/
+offset:
+| ARG_o { let currentArg = $1 in
+ ((fun t args ->
+ match getArg currentArg args with
+ Fo o -> o
+ | a -> wrongArgType currentArg "offset" a),
+
+ (fun off -> Some [ Fo off ]))
+ }
+
+| /* empty */ { ((fun t args -> NoOffset),
+
+ (fun off -> match off with
+ NoOffset -> Some []
+ | _ -> None))
+ }
+
+| DOT IDENT offset { ((fun t args ->
+ let fi = getField t $2 in
+ Field (fi, (fst $3) fi.ftype args)),
+
+ (fun off -> match off with
+ Field (fi, off') when fi.fname = $2 ->
+ (snd $3) off'
+ | _ -> None))
+ }
+
+| LBRACKET expression RBRACKET offset
+ { ((fun t args ->
+ let bt =
+ match unrollType t with
+ TArray(bt, _, _) -> bt
+ | _ -> E.s (error "Formatcil: expecting an array for index")
+ in
+ let e = (fst $2) args in
+ Index(e, (fst $4) bt args)),
+
+ (fun off -> match off with
+ Index (e, off') -> begin
+ match (snd $2) e, (snd $4) off with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+;
+
+
+/*(************ TYPES **************)*/
+typename: one_formal { ((fun args ->
+ let (_, ft, _) = (fst $1) args in
+ ft),
+
+ (fun t -> (snd $1) ("", t, [])))
+ }
+;
+
+one_formal:
+/*(* Do not allow attributes for the name *)*/
+| type_spec attributes decl
+ { ((fun args ->
+ let tal = (fst $2) args in
+ let ts = (fst $1) tal args in
+ let (fn, ft, _) = (fst $3) ts args in
+ (fn, ft, [])),
+
+ (fun (fn, ft, fa) ->
+ match (snd $3) (fn, ft) with
+ Some (restt, m3) -> begin
+ match (snd $1) restt,
+ (snd $2) (typeAttrs restt)with
+ Some m1, Some m2 ->
+ Some (m1 @ m2 @ m3)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+
+| ARG_f
+ { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Ff (fn, ft, fa) -> (fn, ft, fa)
+ | a -> wrongArgType currentArg "formal" a),
+
+ (fun (fn, ft, fa) -> Some [ Ff (fn, ft, fa) ]))
+ }
+;
+
+type_spec:
+| ARG_t { let currentArg = $1 in
+ ((fun al args ->
+ match getArg currentArg args with
+ Ft t -> typeAddAttributes al t
+ | a -> wrongArgType currentArg "type" a),
+
+ (fun t -> Some [ Ft t ]))
+ }
+
+| VOID { ((fun al args -> TVoid al),
+
+ (fun t -> match unrollType t with
+ TVoid _ -> Some []
+ | _ -> None)) }
+
+| ARG_k { let currentArg = $1 in
+ ((fun al args ->
+ match getArg currentArg args with
+ Fk ik -> TInt(ik, al)
+ | a -> wrongArgType currentArg "ikind" a),
+
+ (fun t -> match unrollType t with
+ TInt(ik, _) -> Some [ Fk ik ]
+ | _ -> None))
+ }
+
+| CHAR { ((fun al args -> TInt(IChar, al)),
+ (matchIntType IChar)) }
+| UNSIGNED CHAR { ((fun al args -> TInt(IUChar, al)),
+ matchIntType IUChar) }
+
+| SHORT { ((fun al args -> TInt(IShort, al)),
+ matchIntType IShort) }
+| UNSIGNED SHORT { ((fun al args -> TInt(IUShort, al)),
+ matchIntType IUShort) }
+
+| INT { ((fun al args -> TInt(IInt, al)),
+ matchIntType IInt) }
+| UNSIGNED INT { ((fun al args -> TInt(IUInt, al)), matchIntType IUInt) }
+
+| LONG { ((fun al args -> TInt(ILong, al)),
+ matchIntType ILong) }
+| UNSIGNED LONG { ((fun al args -> TInt(IULong, al)),
+ matchIntType IULong) }
+
+| LONG LONG { ((fun al args -> TInt(ILongLong, al)),
+
+ matchIntType ILongLong)
+ }
+| UNSIGNED LONG LONG { ((fun al args -> TInt(IULongLong, al)),
+
+ matchIntType IULongLong)
+ }
+
+| FLOAT { ((fun al args -> TFloat(FFloat, al)),
+ matchFloatType FFloat)
+ }
+| DOUBLE { ((fun al args -> TFloat(FDouble, al)),
+ matchFloatType FDouble) }
+
+| STRUCT ARG_c { let currentArg = $2 in
+ ((fun al args ->
+ match getArg currentArg args with
+ Fc ci -> TComp(ci, al)
+ | a -> wrongArgType currentArg "compinfo" a),
+
+ (fun t -> match unrollType t with
+ TComp(ci, _) -> Some [ Fc ci ]
+ | _ -> None))
+ }
+| UNION ARG_c { let currentArg = $2 in
+ ((fun al args ->
+ match getArg currentArg args with
+ Fc ci -> TComp(ci, al)
+ | a -> wrongArgType currentArg "compinfo" a),
+
+ (fun t -> match unrollType t with
+ TComp(ci, _) -> Some [ Fc ci ]
+ | _ -> None))
+
+ }
+
+| TYPEOF LPAREN expression RPAREN
+ { ((fun al args -> typeAddAttributes al
+ (typeOf ((fst $3) args))),
+
+ (fun t -> E.s (bug "Cannot match typeof(e)\n")))
+ }
+;
+
+decl:
+| STAR attributes decl
+ { ((fun ts args ->
+ let al = (fst $2) args in
+ (fst $3) (TPtr(ts, al)) args),
+
+ (fun (fn, ft) ->
+ match (snd $3) (fn, ft) with
+ Some (TPtr(bt, al), m2) -> begin
+ match (snd $2) al with
+ Some m1 -> Some (bt, m1 @ m2)
+ | _ -> None
+ end
+ | _ -> None))
+ }
+
+| direct_decl { $1 }
+;
+
+direct_decl:
+| /* empty */ { ((fun ts args -> ("", ts, [])),
+
+ (* Match any name in this case *)
+ (fun (fn, ft) ->
+ Some (unrollType ft, [])))
+ }
+
+| IDENT { ((fun ts args -> ($1, ts, [])),
+
+ (fun (fn, ft) ->
+ if fn = "" || fn = $1 then
+ Some (unrollType ft, [])
+ else
+ None))
+ }
+
+| LPAREN attributes decl RPAREN
+ { ((fun ts args ->
+ let al = (fst $2) args in
+ (fst $3) (typeAddAttributes al ts) args),
+
+ (fun (fn, ft) -> begin
+ match (snd $3) (fn, ft) with
+ Some (restt, m2) -> begin
+ match (snd $2) (typeAttrs restt) with
+ Some m1 -> Some (restt, m1 @ m2)
+ | _ -> None
+ end
+ | _ -> None
+ end))
+ }
+
+| direct_decl LBRACKET exp_opt RBRACKET
+ { ((fun ts args ->
+ (fst $1) (TArray(ts, (fst $3) args, [])) args),
+
+ (fun (fn, ft) ->
+ match (snd $1) (fn, ft) with
+ Some (TArray(bt, lo, _), m1) -> begin
+ match (snd $3) lo with
+ Some m2 -> Some (unrollType bt, m1 @ m2)
+ | _ -> None
+ end
+ | _ -> None))
+ }
+
+
+/*(* We use parentheses around the function to avoid conflicts *)*/
+| LPAREN attributes decl RPAREN LPAREN parameters RPAREN
+ { ((fun ts args ->
+ let al = (fst $2) args in
+ let pars, isva = (fst $6) args in
+ (fst $3) (TFun(ts, pars, isva, al)) args),
+
+ (fun (fn, ft) ->
+ match (snd $3) (fn, ft) with
+ Some (TFun(rt, args, isva, al), m1) -> begin
+ match (snd $2) al, (snd $6) (args, isva) with
+ Some m2, Some m6
+ -> Some (unrollType rt, m1 @ m2 @ m6)
+ | _ -> None
+ end
+ | _ -> None))
+ }
+;
+
+parameters:
+| /* empty */ { ((fun args -> (None, false)),
+
+ (* Match any formals *)
+ (fun (pars, isva) ->
+ match pars, isva with
+ (_, false) -> Some []
+ | _ -> None))
+ }
+
+| parameters_ne { ((fun args ->
+ let (pars : (string * typ * attributes) list),
+ (isva : bool) = (fst $1) args in
+ (Some pars), isva),
+
+ (function
+ ((Some pars), isva) -> (snd $1) (pars, isva)
+ | _ -> None))
+ }
+;
+parameters_ne:
+| ELLIPSIS
+ { ((fun args -> ([], true)),
+
+ (function
+ ([], true) -> Some []
+ | _ -> None))
+ }
+
+| ARG_va { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fva isva -> ([], isva)
+ | a -> wrongArgType currentArg "vararg" a),
+
+ (function
+ ([], isva) -> Some [ Fva isva ]
+ | _ -> None))
+ }
+
+| ARG_F { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ FF fl -> ( fl, false)
+ | a -> wrongArgType currentArg "formals" a),
+
+ (function
+ (pars, false) -> Some [ FF pars ]
+ | _ -> None))
+ }
+
+| one_formal { ((fun args -> ([(fst $1) args], false)),
+
+ (function
+ ([ f ], false) -> (snd $1) f
+ | _ -> None))
+ }
+
+
+| one_formal COMMA parameters_ne
+ { ((fun args ->
+ let this = (fst $1) args in
+ let (rest, isva) = (fst $3) args in
+ (this :: rest, isva)),
+
+ (function
+ ((f::rest, isva)) -> begin
+ match (snd $1) f, (snd $3) (rest, isva) with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+;
+
+
+
+
+
+exp_opt:
+ /* empty */ { ((fun args -> None),
+ (* Match anything if the pattern does not have a len *)
+ (fun _ -> Some [])) }
+
+| expression { ((fun args -> Some ((fst $1) args)),
+
+ (fun lo -> match lo with
+ Some e -> (snd $1) e
+ | _ -> None))
+ }
+| ARG_eo { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Feo lo -> lo
+ | a -> wrongArgType currentArg "exp_opt" a),
+
+ fun lo -> Some [ Feo lo ])
+ }
+;
+
+
+
+attributes:
+ /*(* Ignore other attributes *)*/
+ /* empty */ { ((fun args -> []),
+ (fun attrs -> Some [])) }
+
+| ARG_A { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ FA al -> al
+ | a -> wrongArgType currentArg "attributes" a),
+
+ (fun al -> Some [ FA al ]))
+ }
+
+| attribute attributes
+ { ((fun args ->
+ addAttribute ((fst $1) args) ((fst $2) args)),
+ (* Pass all the attributes down *)
+ (fun attrs ->
+ match (snd $1) attrs, (snd $2) attrs with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None))
+ }
+;
+
+attribute:
+| CONST { doAttr "const" None }
+| RESTRICT { doAttr "restrict" None }
+| VOLATILE { doAttr "volatile" None }
+| ATTRIBUTE LPAREN LPAREN attr RPAREN RPAREN
+ { $4 }
+
+;
+
+
+attr:
+| IDENT
+ { doAttr $1 None }
+
+| IDENT LPAREN attr_args_ne RPAREN
+ { doAttr $1 (Some $3) }
+;
+
+attr_args_ne:
+ attr_arg { ((fun args -> [ (fst $1) args ]),
+
+ (fun aargs -> match aargs with
+ [ arg ] -> (snd $1) arg
+ | _ -> None))
+ }
+| attr_arg COMMA attr_args_ne { ((fun args ->
+ let this = (fst $1) args in
+ this :: ((fst $3) args)),
+
+ (fun aargs -> match aargs with
+ h :: rest -> begin
+ match (snd $1) h, (snd $3) rest with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+| ARG_P { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ FP al -> al
+ | a -> wrongArgType currentArg "attrparams" a),
+
+ (fun al -> Some [ FP al ]))
+ }
+;
+
+attr_arg:
+| IDENT { ((fun args -> ACons($1, [])),
+
+ (fun aarg -> match aarg with
+ ACons(id, []) when id = $1 -> Some []
+ | _ -> None))
+ }
+| IDENT LPAREN attr_args_ne RPAREN
+ { ((fun args -> ACons($1, (fst $3) args)),
+
+ (fun aarg -> match aarg with
+ ACons(id, args) when id = $1 ->
+ (snd $3) args
+ | _ -> None))
+ }
+| ARG_p { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ Fp p -> p
+ | a -> wrongArgType currentArg "attrparam" a),
+
+ (fun ap -> Some [ Fp ap]))
+ }
+
+;
+
+/* (********** INSTRUCTIONS ***********) */
+instr:
+| ARG_i SEMICOLON
+ { let currentArg = $1 in
+ ((fun loc args ->
+ match getArg currentArg args with
+ Fi i -> i
+ | a -> wrongArgType currentArg "instr" a),
+
+ (fun i -> Some [ Fi i]))
+ }
+
+| lval EQ expression SEMICOLON
+ { ((fun loc args ->
+ Set((fst $1) args, (fst $3) args, loc)),
+
+ (fun i -> match i with
+ Set (lv, e, l) -> begin
+ match (snd $1) lv, (snd $3) e with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+
+| lval PLUS_EQ expression SEMICOLON
+ { ((fun loc args ->
+ let l = (fst $1) args in
+ Set(l, buildPlus (Lval l) ((fst $3) args), loc)),
+
+ matchBinopEq
+ (fun bop -> bop = PlusPI || bop = PlusA)
+ (snd $1) (snd $3))
+ }
+
+| lval MINUS_EQ expression SEMICOLON
+ { ((fun loc args ->
+ let l = (fst $1) args in
+ Set(l,
+ buildMinus (Lval l) ((fst $3) args), loc)),
+
+ matchBinopEq (fun bop -> bop = MinusA
+ || bop = MinusPP
+ || bop = MinusPI)
+ (snd $1) (snd $3))
+ }
+| lval STAR_EQ expression SEMICOLON
+ { doBinopEq Mult $1 $3 }
+
+| lval SLASH_EQ expression SEMICOLON
+ { doBinopEq Div $1 $3 }
+
+| lval PERCENT_EQ expression SEMICOLON
+ { doBinopEq Mod $1 $3 }
+
+| lval AND_EQ expression SEMICOLON
+ { doBinopEq BAnd $1 $3 }
+
+| lval PIPE_EQ expression SEMICOLON
+ { doBinopEq BOr $1 $3 }
+
+| lval CIRC_EQ expression SEMICOLON
+ { doBinopEq BXor $1 $3 }
+
+| lval INF_INF_EQ expression SEMICOLON
+ { doBinopEq Shiftlt $1 $3 }
+
+| lval SUP_SUP_EQ expression SEMICOLON
+ { doBinopEq Shiftrt $1 $3 }
+
+/* (* Would be nice to be able to condense the next three rules but we get
+ * into conflicts *)*/
+| lval EQ lval LPAREN arguments RPAREN SEMICOLON
+ { ((fun loc args ->
+ Call(Some ((fst $1) args), Lval ((fst $3) args),
+ (fst $5) args, loc)),
+
+ (fun i -> match i with
+ Call(Some l, Lval f, args, loc) -> begin
+ match (snd $1) l, (snd $3) f, (snd $5) args with
+ Some m1, Some m2, Some m3 ->
+ Some (m1 @ m2 @ m3)
+ | _, _, _ -> None
+ end
+ | _ -> None))
+ }
+
+| lval LPAREN arguments RPAREN SEMICOLON
+ { ((fun loc args ->
+ Call(None, Lval ((fst $1) args),
+ (fst $3) args, loc)),
+
+ (fun i -> match i with
+ Call(None, Lval f, args, loc) -> begin
+ match (snd $1) f, (snd $3) args with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+
+| arglo lval LPAREN arguments RPAREN SEMICOLON
+ { ((fun loc args ->
+ Call((fst $1) args, Lval ((fst $2) args),
+ (fst $4) args, loc)),
+
+ (fun i -> match i with
+ Call(lo, Lval f, args, loc) -> begin
+ match (snd $1) lo, (snd $2) f, (snd $4) args with
+ Some m1, Some m2, Some m3 ->
+ Some (m1 @ m2 @ m3)
+ | _, _, _ -> None
+ end
+ | _ -> None))
+ }
+;
+
+/* (* Separate this out to ensure that the counting or arguments is right *)*/
+arglo:
+ ARG_lo { let currentArg = $1 in
+ ((fun args ->
+ let res =
+ match getArg currentArg args with
+ Flo x -> x
+ | a -> wrongArgType currentArg "lval option" a
+ in
+ res),
+
+ (fun lo -> Some [ Flo lo ]))
+ }
+;
+arguments:
+ /* empty */ { ((fun args -> []),
+
+ (fun actuals -> match actuals with
+ [] -> Some []
+ | _ -> None))
+ }
+
+| arguments_ne { $1 }
+;
+
+arguments_ne:
+ expression { ((fun args -> [ (fst $1) args ]),
+
+ (fun actuals -> match actuals with
+ [ h ] -> (snd $1) h
+ | _ -> None))
+ }
+
+| ARG_E { let currentArg = $1 in
+ ((fun args ->
+ match getArg currentArg args with
+ FE el -> el
+ | a -> wrongArgType currentArg "arguments" a),
+
+ (fun actuals -> Some [ FE actuals ]))
+ }
+
+| expression COMMA arguments_ne
+ { ((fun args -> ((fst $1) args) :: ((fst $3) args)),
+
+ (fun actuals -> match actuals with
+ h :: rest -> begin
+ match (snd $1) h, (snd $3) rest with
+ Some m1, Some m2 -> Some (m1 @ m2)
+ | _, _ -> None
+ end
+ | _ -> None))
+ }
+;
+
+
+/*(******** STATEMENTS *********)*/
+stmt:
+ IF LPAREN expression RPAREN stmt %prec IF
+ { (fun mkTemp loc args ->
+ mkStmt (If((fst $3) args,
+ mkBlock [ $5 mkTemp loc args ],
+ mkBlock [], loc)))
+ }
+| IF LPAREN expression RPAREN stmt ELSE stmt
+ { (fun mkTemp loc args ->
+ mkStmt (If((fst $3) args,
+ mkBlock [ $5 mkTemp loc args ],
+ mkBlock [ $7 mkTemp loc args], loc)))
+ }
+| RETURN exp_opt SEMICOLON
+ { (fun mkTemp loc args ->
+ mkStmt (Return((fst $2) args, loc)))
+ }
+| BREAK SEMICOLON
+ { (fun mkTemp loc args ->
+ mkStmt (Break loc))
+ }
+| CONTINUE SEMICOLON
+ { (fun mkTemp loc args ->
+ mkStmt (Continue loc))
+ }
+| LBRACE stmt_list RBRACE
+ { (fun mkTemp loc args ->
+ let stmts = $2 mkTemp loc args in
+ mkStmt (Block (mkBlock (stmts))))
+ }
+| WHILE LPAREN expression RPAREN stmt
+ { (fun mkTemp loc args ->
+ let e = (fst $3) args in
+ let e =
+ if isPointerType(typeOf e) then
+ mkCast e !upointType
+ else e
+ in
+(*
+ mkStmt
+ (Loop (mkBlock [ mkStmt
+ (If(e,
+ mkBlock [],
+ mkBlock [ mkStmt
+ (Break loc) ],
+ loc));
+ $5 mkTemp loc args ],
+ loc, None, None))
+*)
+ mkStmt
+ (While (e, mkBlock [ $5 mkTemp loc args ], loc)))
+ }
+| instr_list { (fun mkTemp loc args ->
+ mkStmt (Instr ($1 loc args)))
+ }
+| ARG_s { let currentArg = $1 in
+ (fun mkTemp loc args ->
+ match getArg currentArg args with
+ Fs s -> s
+ | a -> wrongArgType currentArg "stmt" a) }
+;
+
+stmt_list:
+ /* empty */ { (fun mkTemp loc args -> []) }
+
+| ARG_S { let currentArg = $1 in
+ (fun mkTemp loc args ->
+ match getArg currentArg args with
+ | FS sl -> sl
+ | a -> wrongArgType currentArg "stmts" a)
+ }
+| stmt stmt_list
+ { (fun mkTemp loc args ->
+ let this = $1 mkTemp loc args in
+ this :: ($2 mkTemp loc args))
+ }
+/* (* We can also have a declaration *) */
+| type_spec attributes decl maybe_init SEMICOLON stmt_list
+ { (fun mkTemp loc args ->
+ let tal = (fst $2) args in
+ let ts = (fst $1) tal args in
+ let (n, t, _) = (fst $3) ts args in
+ let init = $4 args in
+ (* Before we proceed we must create the variable *)
+ let v = mkTemp n t in
+ (* Now we parse the rest *)
+ let rest = $6 mkTemp loc ((n, Fv v) :: args) in
+ (* Now we add the initialization instruction to the
+ * front *)
+ match init with
+ NoInit -> rest
+ | InitExp e ->
+ mkStmtOneInstr (Set((Var v, NoOffset), e, loc))
+ :: rest
+ | InitCall (f, args) ->
+ mkStmtOneInstr (Call(Some (Var v, NoOffset),
+ Lval f, args, loc))
+ :: rest
+
+ )
+ }
+;
+
+instr_list:
+ /*(* Set this rule to very low precedence to ensure that we shift as
+ many instructions as possible *)*/
+ instr %prec COMMA
+ { (fun loc args -> [ ((fst $1) loc args) ]) }
+| ARG_I { let currentArg = $1 in
+ (fun loc args ->
+ match getArg currentArg args with
+ | FI il -> il
+ | a -> wrongArgType currentArg "instrs" a)
+ }
+| instr instr_list
+ { (fun loc args ->
+ let this = (fst $1) loc args in
+ this :: ($2 loc args))
+ }
+;
+
+
+maybe_init:
+| { (fun args -> NoInit) }
+| EQ expression { (fun args -> InitExp ((fst $2) args)) }
+| EQ lval LPAREN arguments RPAREN
+ { (fun args ->
+ InitCall((fst $2) args, (fst $4) args)) }
+;
+%%
+
+
+
+
+
+
+
diff --git a/cil/src/frontc/cabs.ml b/cil/src/frontc/cabs.ml
new file mode 100644
index 0000000..78ac02f
--- /dev/null
+++ b/cil/src/frontc/cabs.ml
@@ -0,0 +1,396 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** This file was originally part of Hugues Casee's frontc 2.0, and has been
+ * extensively changed since.
+**
+** 1.0 3.22.99 Hugues Cassé First version.
+** 2.0 George Necula 12/12/00: Many extensions
+ **)
+
+(*
+** Types
+*)
+
+type cabsloc = {
+ lineno : int;
+ filename: string;
+ byteno: int;
+}
+
+let cabslu = {lineno = -10;
+ filename = "cabs loc unknown";
+ byteno = -10;}
+
+(* clexer puts comments here *)
+let commentsGA = GrowArray.make 100 (GrowArray.Elem(cabslu,"",false))
+
+type typeSpecifier = (* Merge all specifiers into one type *)
+ Tvoid (* Type specifier ISO 6.7.2 *)
+ | Tchar
+ | Tshort
+ | Tint
+ | Tlong
+ | Tint64
+ | Tfloat
+ | Tdouble
+ | Tsigned
+ | Tunsigned
+ | Tnamed of string
+ (* each of the following three kinds of specifiers contains a field
+ * or item list iff it corresponds to a definition (as opposed to
+ * a forward declaration or simple reference to the type); they
+ * also have a list of __attribute__s that appeared between the
+ * keyword and the type name (definitions only) *)
+ | Tstruct of string * field_group list option * attribute list
+ | Tunion of string * field_group list option * attribute list
+ | Tenum of string * enum_item list option * attribute list
+ | TtypeofE of expression (* GCC __typeof__ *)
+ | TtypeofT of specifier * decl_type (* GCC __typeof__ *)
+
+and storage =
+ NO_STORAGE | AUTO | STATIC | EXTERN | REGISTER
+
+and funspec =
+ INLINE | VIRTUAL | EXPLICIT
+
+and cvspec =
+ CV_CONST | CV_VOLATILE | CV_RESTRICT
+
+(* Type specifier elements. These appear at the start of a declaration *)
+(* Everywhere they appear in this file, they appear as a 'spec_elem list', *)
+(* which is not interpreted by cabs -- rather, this "word soup" is passed *)
+(* on to the compiler. Thus, we can represent e.g. 'int long float x' even *)
+(* though the compiler will of course choke. *)
+and spec_elem =
+ SpecTypedef
+ | SpecCV of cvspec (* const/volatile *)
+ | SpecAttr of attribute (* __attribute__ *)
+ | SpecStorage of storage
+ | SpecInline
+ | SpecType of typeSpecifier
+ | SpecPattern of string (* specifier pattern variable *)
+
+(* decided to go ahead and replace 'spec_elem list' with specifier *)
+and specifier = spec_elem list
+
+
+(* Declarator type. They modify the base type given in the specifier. Keep
+ * them in the order as they are printed (this means that the top level
+ * constructor for ARRAY and PTR is the inner-level in the meaning of the
+ * declared type) *)
+and decl_type =
+ | JUSTBASE (* Prints the declared name *)
+ | PARENTYPE of attribute list * decl_type * attribute list
+ (* Prints "(attrs1 decl attrs2)".
+ * attrs2 are attributes of the
+ * declared identifier and it is as
+ * if they appeared at the very end
+ * of the declarator. attrs1 can
+ * contain attributes for the
+ * identifier or attributes for the
+ * enclosing type. *)
+ | ARRAY of decl_type * attribute list * expression
+ (* Prints "decl [ attrs exp ]".
+ * decl is never a PTR. *)
+ | PTR of attribute list * decl_type (* Prints "* attrs decl" *)
+ | PROTO of decl_type * single_name list * bool
+ (* Prints "decl (args[, ...])".
+ * decl is never a PTR.*)
+
+(* The base type and the storage are common to all names. Each name might
+ * contain type or storage modifiers *)
+(* e.g.: int x, y; *)
+and name_group = specifier * name list
+
+(* The optional expression is the bitfield *)
+and field_group = specifier * (name * expression option) list
+
+(* like name_group, except the declared variables are allowed to have initializers *)
+(* e.g.: int x=1, y=2; *)
+and init_name_group = specifier * init_name list
+
+(* The decl_type is in the order in which they are printed. Only the name of
+ * the declared identifier is pulled out. The attributes are those that are
+ * printed after the declarator *)
+(* e.g: in "int *x", "*x" is the declarator; "x" will be pulled out as *)
+(* the string, and decl_type will be PTR([], JUSTBASE) *)
+and name = string * decl_type * attribute list * cabsloc
+
+(* A variable declarator ("name") with an initializer *)
+and init_name = name * init_expression
+
+(* Single names are for declarations that cannot come in groups, like
+ * function parameters and functions *)
+and single_name = specifier * name
+
+
+and enum_item = string * expression * cabsloc
+
+(*
+** Declaration definition (at toplevel)
+*)
+and definition =
+ FUNDEF of single_name * block * cabsloc * cabsloc
+ | DECDEF of init_name_group * cabsloc (* global variable(s), or function prototype *)
+ | TYPEDEF of name_group * cabsloc
+ | ONLYTYPEDEF of specifier * cabsloc
+ | GLOBASM of string * cabsloc
+ | PRAGMA of expression * cabsloc
+ | LINKAGE of string * cabsloc * definition list (* extern "C" { ... } *)
+ (* toplevel form transformer, from the first definition to the *)
+ (* second group of definitions *)
+ | TRANSFORMER of definition * definition list * cabsloc
+ (* expression transformer: source and destination *)
+ | EXPRTRANSFORMER of expression * expression * cabsloc
+
+
+(* the string is a file name, and then the list of toplevel forms *)
+and file = string * definition list
+
+
+(*
+** statements
+*)
+
+(* A block contains a list of local label declarations ( GCC's ({ __label__
+ * l1, l2; ... }) ) , a list of definitions and a list of statements *)
+and block =
+ { blabels: string list;
+ battrs: attribute list;
+ bstmts: statement list
+ }
+
+(* GCC asm directives have lots of extra information to guide the optimizer *)
+and asm_details =
+ { aoutputs: (string * expression) list; (* constraints and expressions for outputs *)
+ ainputs: (string * expression) list; (* constraints and expressions for inputs *)
+ aclobbers: string list (* clobbered registers *)
+ }
+
+and statement =
+ NOP of cabsloc
+ | COMPUTATION of expression * cabsloc
+ | BLOCK of block * cabsloc
+ | SEQUENCE of statement * statement * cabsloc
+ | IF of expression * statement * statement * cabsloc
+ | WHILE of expression * statement * cabsloc
+ | DOWHILE of expression * statement * cabsloc
+ | FOR of for_clause * expression * expression * statement * cabsloc
+ | BREAK of cabsloc
+ | CONTINUE of cabsloc
+ | RETURN of expression * cabsloc
+ | SWITCH of expression * statement * cabsloc
+ | CASE of expression * statement * cabsloc
+ | CASERANGE of expression * expression * statement * cabsloc
+ | DEFAULT of statement * cabsloc
+ | LABEL of string * statement * cabsloc
+ | GOTO of string * cabsloc
+ | COMPGOTO of expression * cabsloc (* GCC's "goto *exp" *)
+ | DEFINITION of definition (*definition or declaration of a variable or type*)
+
+ | ASM of attribute list * (* typically only volatile and const *)
+ string list * (* template *)
+ asm_details option * (* extra details to guide GCC's optimizer *)
+ cabsloc
+
+ (** MS SEH *)
+ | TRY_EXCEPT of block * expression * block * cabsloc
+ | TRY_FINALLY of block * block * cabsloc
+
+and for_clause =
+ FC_EXP of expression
+ | FC_DECL of definition
+
+(*
+** Expressions
+*)
+and binary_operator =
+ ADD | SUB | MUL | DIV | MOD
+ | AND | OR
+ | BAND | BOR | XOR | SHL | SHR
+ | EQ | NE | LT | GT | LE | GE
+ | ASSIGN
+ | ADD_ASSIGN | SUB_ASSIGN | MUL_ASSIGN | DIV_ASSIGN | MOD_ASSIGN
+ | BAND_ASSIGN | BOR_ASSIGN | XOR_ASSIGN | SHL_ASSIGN | SHR_ASSIGN
+
+and unary_operator =
+ MINUS | PLUS | NOT | BNOT | MEMOF | ADDROF
+ | PREINCR | PREDECR | POSINCR | POSDECR
+
+and expression =
+ NOTHING
+ | UNARY of unary_operator * expression
+ | LABELADDR of string (* GCC's && Label *)
+ | BINARY of binary_operator * expression * expression
+ | QUESTION of expression * expression * expression
+
+ (* A CAST can actually be a constructor expression *)
+ | CAST of (specifier * decl_type) * init_expression
+
+ (* There is a special form of CALL in which the function called is
+ __builtin_va_arg and the second argument is sizeof(T). This
+ should be printed as just T *)
+ | CALL of expression * expression list
+ | COMMA of expression list
+ | CONSTANT of constant
+ | VARIABLE of string
+ | EXPR_SIZEOF of expression
+ | TYPE_SIZEOF of specifier * decl_type
+ | EXPR_ALIGNOF of expression
+ | TYPE_ALIGNOF of specifier * decl_type
+ | INDEX of expression * expression
+ | MEMBEROF of expression * string
+ | MEMBEROFPTR of expression * string
+ | GNU_BODY of block
+ | EXPR_PATTERN of string (* pattern variable, and name *)
+
+and constant =
+ | CONST_INT of string (* the textual representation *)
+ | CONST_FLOAT of string (* the textual representaton *)
+ | CONST_CHAR of int64 list
+ | CONST_WCHAR of int64 list
+ | CONST_STRING of string
+ | CONST_WSTRING of int64 list
+ (* ww: wstrings are stored as an int64 list at this point because
+ * we might need to feed the wide characters piece-wise into an
+ * array initializer (e.g., wchar_t foo[] = L"E\xabcd";). If that
+ * doesn't happen we will convert it to an (escaped) string before
+ * passing it to Cil. *)
+
+and init_expression =
+ | NO_INIT
+ | SINGLE_INIT of expression
+ | COMPOUND_INIT of (initwhat * init_expression) list
+
+and initwhat =
+ NEXT_INIT
+ | INFIELD_INIT of string * initwhat
+ | ATINDEX_INIT of expression * initwhat
+ | ATINDEXRANGE_INIT of expression * expression
+
+
+ (* Each attribute has a name and some
+ * optional arguments *)
+and attribute = string * expression list
+
+
+(*********** HELPER FUNCTIONS **********)
+
+let missingFieldDecl = ("___missing_field_name", JUSTBASE, [], cabslu)
+
+let rec isStatic = function
+ [] -> false
+ | (SpecStorage STATIC) :: _ -> true
+ | _ :: rest -> isStatic rest
+
+let rec isExtern = function
+ [] -> false
+ | (SpecStorage EXTERN) :: _ -> true
+ | _ :: rest -> isExtern rest
+
+let rec isInline = function
+ [] -> false
+ | SpecInline :: _ -> true
+ | _ :: rest -> isInline rest
+
+let rec isTypedef = function
+ [] -> false
+ | SpecTypedef :: _ -> true
+ | _ :: rest -> isTypedef rest
+
+
+let get_definitionloc (d : definition) : cabsloc =
+ match d with
+ | FUNDEF(_, _, l, _) -> l
+ | DECDEF(_, l) -> l
+ | TYPEDEF(_, l) -> l
+ | ONLYTYPEDEF(_, l) -> l
+ | GLOBASM(_, l) -> l
+ | PRAGMA(_, l) -> l
+ | TRANSFORMER(_, _, l) -> l
+ | EXPRTRANSFORMER(_, _, l) -> l
+ | LINKAGE (_, l, _) -> l
+
+let get_statementloc (s : statement) : cabsloc =
+begin
+ match s with
+ | NOP(loc) -> loc
+ | COMPUTATION(_,loc) -> loc
+ | BLOCK(_,loc) -> loc
+ | SEQUENCE(_,_,loc) -> loc
+ | IF(_,_,_,loc) -> loc
+ | WHILE(_,_,loc) -> loc
+ | DOWHILE(_,_,loc) -> loc
+ | FOR(_,_,_,_,loc) -> loc
+ | BREAK(loc) -> loc
+ | CONTINUE(loc) -> loc
+ | RETURN(_,loc) -> loc
+ | SWITCH(_,_,loc) -> loc
+ | CASE(_,_,loc) -> loc
+ | CASERANGE(_,_,_,loc) -> loc
+ | DEFAULT(_,loc) -> loc
+ | LABEL(_,_,loc) -> loc
+ | GOTO(_,loc) -> loc
+ | COMPGOTO (_, loc) -> loc
+ | DEFINITION d -> get_definitionloc d
+ | ASM(_,_,_,loc) -> loc
+ | TRY_EXCEPT(_, _, _, loc) -> loc
+ | TRY_FINALLY(_, _, loc) -> loc
+end
+
+
+let explodeStringToInts (s: string) : int64 list =
+ let rec allChars i acc =
+ if i < 0 then acc
+ else allChars (i - 1) (Int64.of_int (Char.code (String.get s i)) :: acc)
+ in
+ allChars (-1 + String.length s) []
+
+let valueOfDigit chr =
+ let int_value =
+ match chr with
+ '0'..'9' -> (Char.code chr) - (Char.code '0')
+ | 'a'..'z' -> (Char.code chr) - (Char.code 'a') + 10
+ | 'A'..'Z' -> (Char.code chr) - (Char.code 'A') + 10
+ | _ -> Errormsg.s (Errormsg.bug "not a digit") in
+ Int64.of_int int_value
+
+
+open Pretty
+let d_cabsloc () cl =
+ text cl.filename ++ text ":" ++ num cl.lineno
diff --git a/cil/src/frontc/cabs2cil.ml b/cil/src/frontc/cabs2cil.ml
new file mode 100644
index 0000000..31b65b5
--- /dev/null
+++ b/cil/src/frontc/cabs2cil.ml
@@ -0,0 +1,6238 @@
+(* MODIF: allow E.Error to propagate *)
+
+(* MODIF: for pointer comparison, avoid systematic cast to unsigned int *)
+
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+(* MODIF: Return statement no longer added when the body of the function
+ falls-through. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* Type check and elaborate ABS to CIL *)
+
+(* The references to ISO means ANSI/ISO 9899-1999 *)
+module A = Cabs
+module E = Errormsg
+module H = Hashtbl
+module IH = Inthash
+module AL = Alpha
+
+open Cabs
+open Pretty
+open Cil
+open Trace
+
+
+let mydebugfunction () =
+ E.s (error "mydebugfunction")
+
+let debugGlobal = false
+
+(** NDC added command line parameter **)
+(* Turn on tranformation that forces correct parameter evaluation order *)
+let forceRLArgEval = ref false
+
+(* Leave a certain global alone. Use a negative number to disable. *)
+let nocil: int ref = ref (-1)
+
+(* Indicates whether we're allowed to duplicate small chunks. *)
+let allowDuplication: bool ref = ref true
+
+(* ---------- source error message handling ------------- *)
+let lu = locUnknown
+let cabslu = {lineno = -10;
+ filename = "cabs lu";
+ byteno = -10;}
+
+
+(** Interface to the Cprint printer *)
+let withCprint (f: 'a -> unit) (x: 'a) : unit =
+ Cprint.commit (); Cprint.flush ();
+ let old = !Cprint.out in
+ Cprint.out := !E.logChannel;
+ f x;
+ Cprint.commit (); Cprint.flush ();
+ flush !Cprint.out;
+ Cprint.out := old
+
+
+(** Keep a list of the variable ID for the variables that were created to
+ * hold the result of function calls *)
+let callTempVars: unit IH.t = IH.create 13
+
+(* Keep a list of functions that were called without a prototype. *)
+let noProtoFunctions : bool IH.t = IH.create 13
+
+(* Check that s starts with the prefix p *)
+let prefix p s =
+ let lp = String.length p in
+ let ls = String.length s in
+ lp <= ls && String.sub s 0 lp = p
+
+(***** COMPUTED GOTO ************)
+
+(* The address of labels are small integers (starting from 0). A computed
+ * goto is replaced with a switch on the address of the label. We generate
+ * only one such switch and we'll jump to it from all computed gotos. To
+ * accomplish this we'll add a local variable to store the target of the
+ * goto. *)
+
+(* The local variable in which to put the detination of the goto and the
+ * statement where to jump *)
+let gotoTargetData: (varinfo * stmt) option ref = ref None
+
+(* The "addresses" of labels *)
+let gotoTargetHash: (string, int) H.t = H.create 13
+let gotoTargetNextAddr: int ref = ref 0
+
+
+(********** TRANSPARENT UNION ******)
+(* Check if a type is a transparent union, and return the first field if it
+ * is *)
+let isTransparentUnion (t: typ) : fieldinfo option =
+ match unrollType t with
+ TComp (comp, _) when not comp.cstruct ->
+ (* Turn transparent unions into the type of their first field *)
+ if hasAttribute "transparent_union" (typeAttrs t) then begin
+ match comp.cfields with
+ f :: _ -> Some f
+ | _ -> E.s (unimp "Empty transparent union: %s" (compFullName comp))
+ end else
+ None
+ | _ -> None
+
+(* When we process an argument list, remember the argument index which has a
+ * transparent union type, along with the original type. We need this to
+ * process function definitions *)
+let transparentUnionArgs : (int * typ) list ref = ref []
+
+let debugLoc = false
+let convLoc (l : cabsloc) =
+ if debugLoc then
+ ignore (E.log "convLoc at %s: line %d, btye %d\n" l.filename l.lineno l.byteno);
+ {line = l.lineno; file = l.filename; byte = l.byteno;}
+
+
+let isOldStyleVarArgName n =
+ if !msvcMode then n = "va_alist"
+ else n = "__builtin_va_alist"
+
+let isOldStyleVarArgTypeName n =
+ if !msvcMode then n = "va_list" || n = "__ccured_va_list"
+ else n = "__builtin_va_alist_t"
+
+(* Weimer
+ * multi-character character constants
+ * In MSCV, this code works:
+ *
+ * long l1 = 'abcd'; // note single quotes
+ * char * s = "dcba";
+ * long * lptr = ( long * )s;
+ * long l2 = *lptr;
+ * assert(l1 == l2);
+ *
+ * We need to change a multi-character character literal into the
+ * appropriate integer constant. However, the plot sickens: we
+ * must also be able to handle things like 'ab\nd' (value = * "d\nba")
+ * and 'abc' (vale = *"cba").
+ *
+ * First we convert 'AB\nD' into the list [ 65 ; 66 ; 10 ; 68 ], then we
+ * multiply and add to get the desired value.
+ *)
+
+(* Given a character constant (like 'a' or 'abc') as a list of 64-bit
+ * values, turn it into a CIL constant. Multi-character constants are
+ * treated as multi-digit numbers with radix given by the bit width of
+ * the specified type (either char or wchar_t). *)
+let reduce_multichar typ : int64 list -> int64 =
+ let radix = bitsSizeOf typ in
+ List.fold_left
+ (fun acc -> Int64.add (Int64.shift_left acc radix))
+ Int64.zero
+
+let interpret_character_constant char_list =
+ let value = reduce_multichar charType char_list in
+ if value < (Int64.of_int 256) then
+ (* ISO C 6.4.4.4.10: single-character constants have type int *)
+ (CChr(Char.chr (Int64.to_int value))), intType
+ else begin
+ let orig_rep = None (* Some("'" ^ (String.escaped str) ^ "'") *) in
+ if value <= (Int64.of_int32 Int32.max_int) then
+ (CInt64(value,IULong,orig_rep)),(TInt(IULong,[]))
+ else
+ (CInt64(value,IULongLong,orig_rep)),(TInt(IULongLong,[]))
+ end
+
+(*** EXPRESSIONS *************)
+
+ (* We collect here the program *)
+let theFile : global list ref = ref []
+let theFileTypes : global list ref = ref []
+
+let initGlobals () = theFile := []; theFileTypes := []
+
+
+let cabsPushGlobal (g: global) =
+ pushGlobal g ~types:theFileTypes ~variables:theFile
+
+(* Keep track of some variable ids that must be turned into definitions. We
+ * do this when we encounter what appears a definition of a global but
+ * without initializer. We leave it a declaration because maybe down the road
+ * we see another definition with an initializer. But if we don't see any
+ * then we turn the last such declaration into a definition without
+ * initializer *)
+let mustTurnIntoDef: bool IH.t = IH.create 117
+
+(* Globals that have already been defined. Indexed by the variable name. *)
+let alreadyDefined: (string, location) H.t = H.create 117
+
+(* Globals that were created due to static local variables. We chose their
+ * names to be distinct from any global encountered at the time. But we might
+ * see a global with conflicting name later in the file. *)
+let staticLocals: (string, varinfo) H.t = H.create 13
+
+
+(* Typedefs. We chose their names to be distinct from any global encounterd
+ * at the time. But we might see a global with conflicting name later in the
+ * file *)
+let typedefs: (string, typeinfo) H.t = H.create 13
+
+let popGlobals () =
+ let rec revonto (tail: global list) = function
+ [] -> tail
+
+ | GVarDecl (vi, l) :: rest
+ when vi.vstorage != Extern && IH.mem mustTurnIntoDef vi.vid ->
+ IH.remove mustTurnIntoDef vi.vid;
+ revonto (GVar (vi, {init = None}, l) :: tail) rest
+
+ | x :: rest -> revonto (x :: tail) rest
+ in
+ revonto (revonto [] !theFile) !theFileTypes
+
+
+(********* ENVIRONMENTS ***************)
+
+(* The environment is kept in two distinct data structures. A hash table maps
+ * each original variable name into a varinfo (for variables, or an
+ * enumeration tag, or a type). (Note that the varinfo might contain an
+ * alpha-converted name different from that of the lookup name.) The Ocaml
+ * hash tables can keep multiple mappings for a single key. Each time the
+ * last mapping is returned and upon deletion the old mapping is restored. To
+ * keep track of local scopes we also maintain a list of scopes (represented
+ * as lists). *)
+type envdata =
+ EnvVar of varinfo (* The name refers to a variable
+ * (which could also be a function) *)
+ | EnvEnum of exp * typ (* The name refers to an enumeration
+ * tag for which we know the value
+ * and the host type *)
+ | EnvTyp of typ (* The name is of the form "struct
+ * foo", or "union foo" or "enum foo"
+ * and refers to a type. Note that
+ * the name of the actual type might
+ * be different from foo due to alpha
+ * conversion *)
+ | EnvLabel of string (* The name refers to a label. This
+ * is useful for GCC's locally
+ * declared labels. The lookup name
+ * for this category is "label foo" *)
+
+let env : (string, envdata * location) H.t = H.create 307
+(* We also keep a global environment. This is always a subset of the env *)
+let genv : (string, envdata * location) H.t = H.create 307
+
+ (* In the scope we keep the original name, so we can remove them from the
+ * hash table easily *)
+type undoScope =
+ UndoRemoveFromEnv of string
+ | UndoResetAlphaCounter of location AL.alphaTableData ref *
+ location AL.alphaTableData
+ | UndoRemoveFromAlphaTable of string
+
+let scopes : undoScope list ref list ref = ref []
+
+let isAtTopLevel () =
+ !scopes = []
+
+
+(* When you add to env, you also add it to the current scope *)
+let addLocalToEnv (n: string) (d: envdata) =
+(* ignore (E.log "%a: adding local %s to env\n" d_loc !currentLoc n); *)
+ H.add env n (d, !currentLoc);
+ (* If we are in a scope, then it means we are not at top level. Add the
+ * name to the scope *)
+ (match !scopes with
+ [] -> begin
+ match d with
+ EnvVar _ ->
+ E.s (E.bug "addLocalToEnv: not in a scope when adding %s!" n)
+ | _ -> () (* We might add types *)
+ end
+ | s :: _ ->
+ s := (UndoRemoveFromEnv n) :: !s)
+
+
+let addGlobalToEnv (k: string) (d: envdata) : unit =
+(* ignore (E.log "%a: adding global %s to env\n" d_loc !currentLoc k); *)
+ H.add env k (d, !currentLoc);
+ (* Also add it to the global environment *)
+ H.add genv k (d, !currentLoc)
+
+
+
+(* Create a new name based on a given name. The new name is formed from a
+ * prefix (obtained from the given name as the longest prefix that ends with
+ * a non-digit), followed by a '_' and then by a positive integer suffix. The
+ * first argument is a table mapping name prefixes with the largest suffix
+ * used so far for that prefix. The largest suffix is one when only the
+ * version without suffix has been used. *)
+let alphaTable : (string, location AL.alphaTableData ref) H.t = H.create 307
+ (* vars and enum tags. For composite types we have names like "struct
+ * foo" or "union bar" *)
+
+(* To keep different name scopes different, we add prefixes to names
+ * specifying the kind of name: the kind can be one of "" for variables or
+ * enum tags, "struct" for structures and unions (they share the name space),
+ * "enum" for enumerations, or "type" for types *)
+let kindPlusName (kind: string)
+ (origname: string) : string =
+ if kind = "" then origname else
+ kind ^ " " ^ origname
+
+
+let stripKind (kind: string) (kindplusname: string) : string =
+ let l = 1 + String.length kind in
+ if l > 1 then
+ String.sub kindplusname l (String.length kindplusname - l)
+ else
+ kindplusname
+
+let newAlphaName (globalscope: bool) (* The name should have global scope *)
+ (kind: string)
+ (origname: string) : string * location =
+ let lookupname = kindPlusName kind origname in
+ (* If we are in a scope then it means that we are alpha-converting a local
+ * name. Go and add stuff to reset the state of the alpha table but only to
+ * the top-most scope (that of the enclosing function) *)
+ let rec findEnclosingFun = function
+ [] -> (* At global scope *)()
+ | [s] -> begin
+ let prefix = AL.getAlphaPrefix lookupname in
+ try
+ let countref = H.find alphaTable prefix in
+ s := (UndoResetAlphaCounter (countref, !countref)) :: !s
+ with Not_found ->
+ s := (UndoRemoveFromAlphaTable prefix) :: !s
+ end
+ | _ :: rest -> findEnclosingFun rest
+ in
+ if not globalscope then
+ findEnclosingFun !scopes;
+ let newname, oldloc =
+ AL.newAlphaName alphaTable None lookupname !currentLoc in
+ stripKind kind newname, oldloc
+
+
+
+
+let explodeString (nullterm: bool) (s: string) : char list =
+ let rec allChars i acc =
+ if i < 0 then acc
+ else allChars (i - 1) ((String.get s i) :: acc)
+ in
+ allChars (-1 + String.length s)
+ (if nullterm then [Char.chr 0] else [])
+
+(*** In order to process GNU_BODY expressions we must record that a given
+ *** COMPUTATION is interesting *)
+let gnu_body_result : (A.statement * ((exp * typ) option ref)) ref
+ = ref (A.NOP cabslu, ref None)
+
+(*** When we do statements we need to know the current return type *)
+let currentReturnType : typ ref = ref (TVoid([]))
+let currentFunctionFDEC: fundec ref = ref dummyFunDec
+
+
+let lastStructId = ref 0
+let anonStructName (k: string) (suggested: string) =
+ incr lastStructId;
+ "__anon" ^ k ^ (if suggested <> "" then "_" ^ suggested else "")
+ ^ "_" ^ (string_of_int (!lastStructId))
+
+
+let constrExprId = ref 0
+
+
+let startFile () =
+ H.clear env;
+ H.clear genv;
+ H.clear alphaTable;
+ lastStructId := 0
+
+
+
+let enterScope () =
+ scopes := (ref []) :: !scopes
+
+ (* Exit a scope and clean the environment. We do not yet delete from
+ * the name table *)
+let exitScope () =
+ let this, rest =
+ match !scopes with
+ car :: cdr -> car, cdr
+ | [] -> E.s (error "Not in a scope")
+ in
+ scopes := rest;
+ let rec loop = function
+ [] -> ()
+ | UndoRemoveFromEnv n :: t ->
+ H.remove env n; loop t
+ | UndoRemoveFromAlphaTable n :: t -> H.remove alphaTable n; loop t
+ | UndoResetAlphaCounter (vref, oldv) :: t ->
+ vref := oldv;
+ loop t
+ in
+ loop !this
+
+(* Lookup a variable name. Return also the location of the definition. Might
+ * raise Not_found *)
+let lookupVar (n: string) : varinfo * location =
+ match H.find env n with
+ (EnvVar vi), loc -> vi, loc
+ | _ -> raise Not_found
+
+let lookupGlobalVar (n: string) : varinfo * location =
+ match H.find genv n with
+ (EnvVar vi), loc -> vi, loc
+ | _ -> raise Not_found
+
+let docEnv () =
+ let acc : (string * (envdata * location)) list ref = ref [] in
+ let doone () = function
+ EnvVar vi, l ->
+ dprintf "Var(%s,global=%b) (at %a)" vi.vname vi.vglob d_loc l
+ | EnvEnum (tag, typ), l -> dprintf "Enum (at %a)" d_loc l
+ | EnvTyp t, l -> text "typ"
+ | EnvLabel l, _ -> text ("label " ^ l)
+ in
+ H.iter (fun k d -> acc := (k, d) :: !acc) env;
+ docList ~sep:line (fun (k, d) -> dprintf " %s -> %a" k doone d) () !acc
+
+
+
+(* Add a new variable. Do alpha-conversion if necessary *)
+let alphaConvertVarAndAddToEnv (addtoenv: bool) (vi: varinfo) : varinfo =
+(*
+ ignore (E.log "%t: alphaConvert(addtoenv=%b) %s" d_thisloc addtoenv vi.vname);
+*)
+ (* Announce the name to the alpha conversion table *)
+ let newname, oldloc = newAlphaName (addtoenv && vi.vglob) "" vi.vname in
+ (* Make a copy of the vi if the name has changed. Never change the name for
+ * global variables *)
+ let newvi =
+ if vi.vname = newname then
+ vi
+ else begin
+ if vi.vglob then begin
+ (* Perhaps this is because we have seen a static local which happened
+ * to get the name that we later want to use for a global. *)
+ try
+ let static_local_vi = H.find staticLocals vi.vname in
+ H.remove staticLocals vi.vname;
+ (* Use the new name for the static local *)
+ static_local_vi.vname <- newname;
+ (* And continue using the last one *)
+ vi
+ with Not_found -> begin
+ (* Or perhaps we have seen a typedef which stole our name. This is
+ possible because typedefs use the same name space *)
+ try
+ let typedef_ti = H.find typedefs vi.vname in
+ H.remove typedefs vi.vname;
+ (* Use the new name for the typedef instead *)
+ typedef_ti.tname <- newname;
+ (* And continue using the last name *)
+ vi
+ with Not_found ->
+ E.s (E.error "It seems that we would need to rename global %s (to %s) because of previous occurrence at %a"
+ vi.vname newname d_loc oldloc);
+ end
+ end else begin
+ (* We have changed the name of a local variable. Can we try to detect
+ * if the other variable was also local in the same scope? Not for
+ * now. *)
+ copyVarinfo vi newname
+ end
+ end
+ in
+ (* Store all locals in the slocals (in reversed order). We'll reverse them
+ * and take out the formals at the end of the function *)
+ if not vi.vglob then
+ !currentFunctionFDEC.slocals <- newvi :: !currentFunctionFDEC.slocals;
+
+ (if addtoenv then
+ if vi.vglob then
+ addGlobalToEnv vi.vname (EnvVar newvi)
+ else
+ addLocalToEnv vi.vname (EnvVar newvi));
+(*
+ ignore (E.log " new=%s\n" newvi.vname);
+*)
+(* ignore (E.log "After adding %s alpha table is: %a\n"
+ newvi.vname docAlphaTable alphaTable); *)
+ newvi
+
+
+(* Strip the "const" from the type. It is unfortunate that const variables
+ * can only be set in initialization. Once we decided to move all
+ * declarations to the top of the functions, we have no way of setting a
+ * "const" variable. Furthermore, if the type of the variable is an array or
+ * a struct we must recursively strip the "const" from fields and array
+ * elements. *)
+let rec stripConstLocalType (t: typ) : typ =
+ let dc a =
+ if hasAttribute "const" a then
+ dropAttribute "const" a
+ else a
+ in
+ match t with
+ | TPtr (bt, a) ->
+ (* We want to be able to detect by pointer equality if the type has
+ * changed. So, don't realloc the type unless necessary. *)
+ let a' = dc a in if a != a' then TPtr(bt, a') else t
+ | TInt (ik, a) ->
+ let a' = dc a in if a != a' then TInt(ik, a') else t
+ | TFloat(fk, a) ->
+ let a' = dc a in if a != a' then TFloat(fk, a') else t
+ | TNamed (ti, a) ->
+ (* We must go and drop the consts from the typeinfo as well ! *)
+ let t' = stripConstLocalType ti.ttype in
+ if t != t' then begin
+ (* ignore (warn "Stripping \"const\" from typedef %s\n" ti.tname); *)
+ ti.ttype <- t'
+ end;
+ let a' = dc a in if a != a' then TNamed(ti, a') else t
+
+ | TEnum (ei, a) ->
+ let a' = dc a in if a != a' then TEnum(ei, a') else t
+
+ | TArray(bt, leno, a) ->
+ (* We never assign to the array. So, no need to change the const. But
+ * we must change it on the base type *)
+ let bt' = stripConstLocalType bt in
+ if bt' != bt then TArray(bt', leno, a) else t
+
+ | TComp(ci, a) ->
+ (* Must change both this structure as well as its fields *)
+ List.iter
+ (fun f ->
+ let t' = stripConstLocalType f.ftype in
+ if t' != f.ftype then begin
+ ignore (warnOpt "Stripping \"const\" from field %s of %s\n"
+ f.fname (compFullName ci));
+ f.ftype <- t'
+ end)
+ ci.cfields;
+ let a' = dc a in if a != a' then TComp(ci, a') else t
+
+ (* We never assign functions either *)
+ | TFun(rt, args, va, a) -> t
+ | TVoid _ -> E.s (bug "cabs2cil: stripConstLocalType: void")
+ | TBuiltin_va_list a ->
+ let a' = dc a in if a != a' then TBuiltin_va_list a' else t
+
+
+let constFoldTypeVisitor = object (self)
+ inherit nopCilVisitor
+ method vtype t: typ visitAction =
+ match t with
+ TArray(bt, Some len, a) ->
+ let len' = constFold true len in
+ ChangeDoChildrenPost (
+ TArray(bt, Some len', a),
+ (fun x -> x)
+ )
+ | _ -> DoChildren
+end
+
+(* Const-fold any expressions that appear as array lengths in this type *)
+let constFoldType (t:typ) : typ =
+ visitCilType constFoldTypeVisitor t
+
+
+
+(* Create a new temporary variable *)
+let newTempVar typ =
+ if !currentFunctionFDEC == dummyFunDec then
+ E.s (bug "newTempVar called outside a function");
+(* ignore (E.log "stripConstLocalType(%a) for temporary\n" d_type typ); *)
+ let t' = stripConstLocalType typ in
+ (* Start with the name "tmp". The alpha converter will fix it *)
+ let vi = makeVarinfo false "tmp" t' in
+ alphaConvertVarAndAddToEnv false vi (* Do not add to the environment *)
+(*
+ { vname = "tmp"; (* addNewVar will make the name fresh *)
+ vid = newVarId "tmp" false;
+ vglob = false;
+ vtype = t';
+ vdecl = locUnknown;
+ vinline = false;
+ vattr = [];
+ vaddrof = false;
+ vreferenced = false; (* sm *)
+ vstorage = NoStorage;
+ }
+*)
+
+let mkAddrOfAndMark ((b, off) as lval) : exp =
+ (* Mark the vaddrof flag if b is a variable *)
+ (match b with
+ Var vi -> vi.vaddrof <- true
+ | _ -> ());
+ mkAddrOf lval
+
+(* Call only on arrays *)
+let mkStartOfAndMark ((b, off) as lval) : exp =
+ (* Mark the vaddrof flag if b is a variable *)
+ (match b with
+ Var vi -> vi.vaddrof <- true
+ | _ -> ());
+ let res = StartOf lval in
+ res
+
+
+
+ (* Keep a set of self compinfo for composite types *)
+let compInfoNameEnv : (string, compinfo) H.t = H.create 113
+let enumInfoNameEnv : (string, enuminfo) H.t = H.create 113
+
+
+let lookupTypeNoError (kind: string)
+ (n: string) : typ * location =
+ let kn = kindPlusName kind n in
+ match H.find env kn with
+ EnvTyp t, l -> t, l
+ | _ -> raise Not_found
+
+let lookupType (kind: string)
+ (n: string) : typ * location =
+ try
+ lookupTypeNoError kind n
+ with Not_found ->
+ E.s (error "Cannot find type %s (kind:%s)\n" n kind)
+
+(* Create the self ref cell and add it to the map. Return also an indication
+ * if this is a new one. *)
+let createCompInfo (iss: bool) (n: string) : compinfo * bool =
+ (* Add to the self cell set *)
+ let key = (if iss then "struct " else "union ") ^ n in
+ try
+ H.find compInfoNameEnv key, false (* Only if not already in *)
+ with Not_found -> begin
+ (* Create a compinfo. This will have "cdefined" false. *)
+ let res = mkCompInfo iss n (fun _ -> []) [] in
+ H.add compInfoNameEnv key res;
+ res, true
+ end
+
+(* Create the self ref cell and add it to the map. Return an indication
+ * whether this is a new one. *)
+let createEnumInfo (n: string) : enuminfo * bool =
+ (* Add to the self cell set *)
+ try
+ H.find enumInfoNameEnv n, false (* Only if not already in *)
+ with Not_found -> begin
+ (* Create a enuminfo *)
+ let enum = { ename = n; eitems = [];
+ eattr = []; ereferenced = false; } in
+ H.add enumInfoNameEnv n enum;
+ enum, true
+ end
+
+
+ (* kind is either "struct" or "union" or "enum" and n is a name *)
+let findCompType (kind: string) (n: string) (a: attributes) =
+ let makeForward () =
+ (* This is a forward reference, either because we have not seen this
+ * struct already or because we want to create a version with different
+ * attributes *)
+ if kind = "enum" then
+ let enum, isnew = createEnumInfo n in
+ if isnew then
+ cabsPushGlobal (GEnumTagDecl (enum, !currentLoc));
+ TEnum (enum, a)
+ else
+ let iss = if kind = "struct" then true else false in
+ let self, isnew = createCompInfo iss n in
+ if isnew then
+ cabsPushGlobal (GCompTagDecl (self, !currentLoc));
+ TComp (self, a)
+ in
+ try
+ let old, _ = lookupTypeNoError kind n in (* already defined *)
+ let olda = typeAttrs old in
+ if Util.equals olda a then old else makeForward ()
+ with Not_found -> makeForward ()
+
+
+(* A simple visitor that searchs a statement for labels *)
+class canDropStmtClass pRes = object
+ inherit nopCilVisitor
+
+ method vstmt s =
+ if s.labels != [] then
+ (pRes := false; SkipChildren)
+ else
+ if !pRes then DoChildren else SkipChildren
+
+ method vinst _ = SkipChildren
+ method vexpr _ = SkipChildren
+
+end
+let canDropStatement (s: stmt) : bool =
+ let pRes = ref true in
+ let vis = new canDropStmtClass pRes in
+ ignore (visitCilStmt vis s);
+ !pRes
+
+(**** Occasionally we see structs with no name and no fields *)
+
+
+module BlockChunk =
+ struct
+ type chunk = {
+ stmts: stmt list;
+ postins: instr list; (* Some instructions to append at
+ * the ends of statements (in
+ * reverse order) *)
+ (* A list of case statements visible at the
+ * outer level *)
+ cases: (label * stmt) list
+ }
+
+ let d_chunk () (c: chunk) =
+ dprintf "@[{ @[%a@] };@?%a@]"
+ (docList ~sep:(chr ';') (d_stmt ())) c.stmts
+ (docList ~sep:(chr ';') (d_instr ())) (List.rev c.postins)
+
+ let empty =
+ { stmts = []; postins = []; cases = []; }
+
+ let isEmpty (c: chunk) =
+ c.postins == [] && c.stmts == []
+
+ let isNotEmpty (c: chunk) = not (isEmpty c)
+
+ let i2c (i: instr) =
+ { empty with postins = [i] }
+
+ (* Occasionally, we'll have to push postins into the statements *)
+ let pushPostIns (c: chunk) : stmt list =
+ if c.postins = [] then c.stmts
+ else
+ let rec toLast = function
+ [{skind=Instr il} as s] as stmts ->
+ s.skind <- Instr (il @ (List.rev c.postins));
+ stmts
+
+ | [] -> [mkStmt (Instr (List.rev c.postins))]
+
+ | a :: rest -> a :: toLast rest
+ in
+ compactStmts (toLast c.stmts)
+
+
+ let c2block (c: chunk) : block =
+ { battrs = [];
+ bstmts = pushPostIns c;
+ }
+
+ (* Add an instruction at the end. Never refer to this instruction again
+ * after you call this *)
+ let (+++) (c: chunk) (i : instr) =
+ {c with postins = i :: c.postins}
+
+ (* Append two chunks. Never refer to the original chunks after you call
+ * this. And especially never share c2 with somebody else *)
+ let (@@) (c1: chunk) (c2: chunk) =
+ { stmts = compactStmts (pushPostIns c1 @ c2.stmts);
+ postins = c2.postins;
+ cases = c1.cases @ c2.cases;
+ }
+
+ let skipChunk = empty
+
+ let returnChunk (e: exp option) (l: location) : chunk =
+ { stmts = [ mkStmt (Return(e, l)) ];
+ postins = [];
+ cases = []
+ }
+
+ let ifChunk (be: exp) (l: location) (t: chunk) (e: chunk) : chunk =
+
+ { stmts = [ mkStmt(If(be, c2block t, c2block e, l))];
+ postins = [];
+ cases = t.cases @ e.cases;
+ }
+
+ (* We can duplicate a chunk if it has a few simple statements, and if
+ * it does not have cases *)
+ let duplicateChunk (c: chunk) = (* raises Failure if you should not
+ * duplicate this chunk *)
+ if not !allowDuplication then
+ raise (Failure "cannot duplicate: disallowed by user");
+ if c.cases != [] then raise (Failure "cannot duplicate: has cases") else
+ let pCount = ref (List.length c.postins) in
+ { stmts =
+ List.map
+ (fun s ->
+ if s.labels != [] then
+ raise (Failure "cannot duplicate: has labels");
+(*
+ (match s.skind with
+ If _ | Switch _ | (*Loop _*)
+ While _ | DoWhile _ | For _ | Block _ ->
+ raise (Failure "cannot duplicate: complex stmt")
+ | Instr il ->
+ pCount := !pCount + List.length il
+ | _ -> incr pCount);
+ if !pCount > 5 then raise (Failure ("cannot duplicate: too many instr"));
+*)
+ (* We can just copy it because there is nothing to share here.
+ * Except maybe for the ref cell in Goto but it is Ok to share
+ * that, I think *)
+ { s with sid = s.sid}) c.stmts;
+ postins = c.postins; (* There is no shared stuff in instructions *)
+ cases = []
+ }
+(*
+ let duplicateChunk (c: chunk) =
+ if isEmpty c then c else raise (Failure ("cannot duplicate: isNotEmpty"))
+*)
+ (* We can drop a chunk if it does not have labels inside *)
+ let canDrop (c: chunk) =
+ List.for_all canDropStatement c.stmts
+
+(*
+ let loopChunk (body: chunk) : chunk =
+ (* Make the statement *)
+ let loop = mkStmt (Loop (c2block body, !currentLoc, None, None)) in
+ { stmts = [ loop (* ; n *) ];
+ postins = [];
+ cases = body.cases;
+ }
+*)
+
+ let whileChunk (e: exp) (body: chunk) : chunk =
+ let loop = mkStmt (While (e, c2block body, !currentLoc)) in
+
+ { stmts = [ loop ];
+ postins = [];
+ cases = body.cases;
+ }
+
+ let doWhileChunk (e: exp) (body: chunk) : chunk =
+ let loop = mkStmt (DoWhile (e, c2block body, !currentLoc)) in
+
+ { stmts = [ loop ];
+ postins = [];
+ cases = body.cases;
+ }
+
+ let forChunk (bInit: chunk) (e: exp) (bIter: chunk)
+ (body: chunk) : chunk =
+ let loop = mkStmt (For (c2block bInit, e, c2block bIter,
+ c2block body, !currentLoc)) in
+
+ { stmts = [ loop ];
+ postins = [];
+ cases = body.cases;
+ }
+
+ let breakChunk (l: location) : chunk =
+ { stmts = [ mkStmt (Break l) ];
+ postins = [];
+ cases = [];
+ }
+
+ let continueChunk (l: location) : chunk =
+ { stmts = [ mkStmt (Continue l) ];
+ postins = [];
+ cases = []
+ }
+
+ (* Keep track of the gotos *)
+ let backPatchGotos : (string, stmt ref list ref) H.t = H.create 17
+ let addGoto (lname: string) (bref: stmt ref) : unit =
+ let gotos =
+ try
+ H.find backPatchGotos lname
+ with Not_found -> begin
+ let gotos = ref [] in
+ H.add backPatchGotos lname gotos;
+ gotos
+ end
+ in
+ gotos := bref :: !gotos
+
+ (* Keep track of the labels *)
+ let labelStmt : (string, stmt) H.t = H.create 17
+ let initLabels () =
+ H.clear backPatchGotos;
+ H.clear labelStmt
+
+ let resolveGotos () =
+ H.iter
+ (fun lname gotos ->
+ try
+ let dest = H.find labelStmt lname in
+ List.iter (fun gref -> gref := dest) !gotos
+ with Not_found -> begin
+ E.s (error "Label %s not found\n" lname)
+ end)
+ backPatchGotos
+
+ (* Get the first statement in a chunk. Might need to change the
+ * statements in the chunk *)
+ let getFirstInChunk (c: chunk) : stmt * stmt list =
+ (* Get the first statement and add the label to it *)
+ match c.stmts with
+ s :: _ -> s, c.stmts
+ | [] -> (* Add a statement *)
+ let n = mkEmptyStmt () in
+ n, n :: c.stmts
+
+ let consLabel (l: string) (c: chunk) (loc: location)
+ (in_original_program_text : bool) : chunk =
+ (* Get the first statement and add the label to it *)
+ let labstmt, stmts' = getFirstInChunk c in
+ (* Add the label *)
+ labstmt.labels <- Label (l, loc, in_original_program_text) ::
+ labstmt.labels;
+ H.add labelStmt l labstmt;
+ if c.stmts == stmts' then c else {c with stmts = stmts'}
+
+ let s2c (s:stmt) : chunk =
+ { stmts = [ s ];
+ postins = [];
+ cases = [];
+ }
+
+ let gotoChunk (ln: string) (l: location) : chunk =
+ let gref = ref dummyStmt in
+ addGoto ln gref;
+ { stmts = [ mkStmt (Goto (gref, l)) ];
+ postins = [];
+ cases = [];
+ }
+
+ let caseRangeChunk (el: exp list) (l: location) (next: chunk) =
+ let fst, stmts' = getFirstInChunk next in
+ let labels = List.map (fun e -> Case (e, l)) el in
+ let cases = List.map (fun l -> (l, fst)) labels in
+ fst.labels <- labels @ fst.labels;
+ { next with stmts = stmts'; cases = cases @ next.cases}
+
+ let defaultChunk (l: location) (next: chunk) =
+ let fst, stmts' = getFirstInChunk next in
+ let lb = Default l in
+ fst.labels <- lb :: fst.labels;
+ { next with stmts = stmts'; cases = (lb, fst) :: next.cases}
+
+
+ let switchChunk (e: exp) (body: chunk) (l: location) =
+ (* Make the statement *)
+ let switch = mkStmt (Switch (e, c2block body,
+ List.map (fun (_, s) -> s) body.cases,
+ l)) in
+ { stmts = [ switch (* ; n *) ];
+ postins = [];
+ cases = [];
+ }
+
+ let mkFunctionBody (c: chunk) : block =
+ resolveGotos (); initLabels ();
+ if c.cases <> [] then
+ E.s (error "Switch cases not inside a switch statement\n");
+ c2block c
+
+ end
+
+open BlockChunk
+
+
+(************ Labels ***********)
+(*
+(* Since we turn dowhile and for loops into while we need to take care in
+ * processing the continue statement. For each loop that we enter we place a
+ * marker in a list saying what kinds of loop it is. When we see a continue
+ * for a Non-while loop we must generate a label for the continue *)
+type loopstate =
+ While
+ | NotWhile of string ref
+
+let continues : loopstate list ref = ref []
+
+let startLoop iswhile =
+ continues := (if iswhile then While else NotWhile (ref "")) :: !continues
+*)
+
+(* We need to take care while processing the continue statement...
+ * For each loop that we enter we place a marker in a list saying what
+ * chunk of code we must duplicate before each continue statement
+ * in order to preserve the semantics. *)
+type loopMarker =
+ | DuplicateBeforeContinue of chunk
+ | ContinueUnchanged
+
+let continues : loopMarker list ref = ref []
+
+let startLoop lstate =
+ continues := lstate :: !continues
+
+let continueDuplicateChunk (l: location) : chunk =
+ match !continues with
+ | [] -> E.s (error "continue not in a loop")
+ | DuplicateBeforeContinue c :: _ -> c @@ continueChunk l
+ | ContinueUnchanged :: _ -> continueChunk l
+
+(* Sometimes we need to create new label names *)
+let newLabelName (base: string) = fst (newAlphaName false "label" base)
+
+(*
+let continueOrLabelChunk (l: location) : chunk =
+ match !continues with
+ [] -> E.s (error "continue not in a loop")
+ | While :: _ -> continueChunk l
+ | NotWhile lr :: _ ->
+ if !lr = "" then begin
+ lr := newLabelName "__Cont"
+ end;
+ gotoChunk !lr l
+
+let consLabContinue (c: chunk) =
+ match !continues with
+ [] -> E.s (error "labContinue not in a loop")
+ | While :: rest -> c
+ | NotWhile lr :: rest -> if !lr = "" then c else consLabel !lr c !currentLoc false
+*)
+
+let exitLoop () =
+ match !continues with
+ [] -> E.s (error "exit Loop not in a loop")
+ | _ :: rest -> continues := rest
+
+
+(* In GCC we can have locally declared labels. *)
+let genNewLocalLabel (l: string) =
+ (* Call the newLabelName to register the label name in the alpha conversion
+ * table. *)
+ let l' = newLabelName l in
+ (* Add it to the environment *)
+ addLocalToEnv (kindPlusName "label" l) (EnvLabel l');
+ l'
+
+let lookupLabel (l: string) =
+ try
+ match H.find env (kindPlusName "label" l) with
+ EnvLabel l', _ -> l'
+ | _ -> raise Not_found
+ with Not_found ->
+ l
+
+
+(** ALLOCA ***)
+let allocaFun () =
+ let name =
+ if !msvcMode then "alloca"
+ (* Use __builtin_alloca where possible, because this can be used
+ even when gcc is invoked with -fno-builtin *)
+ else "__builtin_alloca"
+ in
+ let fdec = emptyFunction name in
+ fdec.svar.vtype <-
+ TFun(voidPtrType, Some [ ("len", !typeOfSizeOf, []) ], false, []);
+ fdec.svar
+
+(* Maps local variables that are variable sized arrays to the expression that
+ * denotes their length *)
+let varSizeArrays : exp IH.t = IH.create 17
+
+(**** EXP actions ***)
+type expAction =
+ ADrop (* Drop the result. Only the
+ * side-effect is interesting *)
+ | ASet of lval * typ (* Put the result in a given lval,
+ * provided it matches the type. The
+ * type is the type of the lval. *)
+ | AExp of typ option (* Return the exp as usual.
+ * Optionally we can specify an
+ * expected type. This is useful for
+ * constants. The expected type is
+ * informational only, we do not
+ * guarantee that the converted
+ * expression has that type.You must
+ * use a doCast afterwards to make
+ * sure. *)
+ | AExpLeaveArrayFun (* Do it like an expression, but do
+ * not convert arrays of functions
+ * into pointers *)
+
+
+(*** Result of compiling conditional expressions *)
+type condExpRes =
+ CEExp of chunk * exp (* Do a chunk and then an expression *)
+ | CEAnd of condExpRes * condExpRes
+ | CEOr of condExpRes * condExpRes
+ | CENot of condExpRes
+
+(******** CASTS *********)
+let integralPromotion (t : typ) : typ = (* c.f. ISO 6.3.1.1 *)
+ match unrollType t with
+ (* We assume that an IInt can hold even an IUShort *)
+ TInt ((IShort|IUShort|IChar|ISChar|IUChar), a) -> TInt(IInt, a)
+ | TInt _ -> t
+ | TEnum (_, a) -> TInt(IInt, a)
+ | t -> E.s (error "integralPromotion: not expecting %a" d_type t)
+
+
+let arithmeticConversion (* c.f. ISO 6.3.1.8 *)
+ (t1: typ)
+ (t2: typ) : typ =
+ let checkToInt _ = () in (* dummies for now *)
+ let checkToFloat _ = () in
+ match unrollType t1, unrollType t2 with
+ TFloat(FLongDouble, _), _ -> checkToFloat t2; t1
+ | _, TFloat(FLongDouble, _) -> checkToFloat t1; t2
+ | TFloat(FDouble, _), _ -> checkToFloat t2; t1
+ | _, TFloat (FDouble, _) -> checkToFloat t1; t2
+ | TFloat(FFloat, _), _ -> checkToFloat t2; t1
+ | _, TFloat (FFloat, _) -> checkToFloat t1; t2
+ | _, _ -> begin
+ let t1' = integralPromotion t1 in
+ let t2' = integralPromotion t2 in
+ match unrollType t1', unrollType t2' with
+ TInt(IULongLong, _), _ -> checkToInt t2'; t1'
+ | _, TInt(IULongLong, _) -> checkToInt t1'; t2'
+
+ (* We assume a long long is always larger than a long *)
+ | TInt(ILongLong, _), _ -> checkToInt t2'; t1'
+ | _, TInt(ILongLong, _) -> checkToInt t1'; t2'
+
+ | TInt(IULong, _), _ -> checkToInt t2'; t1'
+ | _, TInt(IULong, _) -> checkToInt t1'; t2'
+
+
+ | TInt(ILong,_), TInt(IUInt,_)
+ when bitsSizeOf t1' <= bitsSizeOf t2' -> TInt(IULong,[])
+ | TInt(IUInt,_), TInt(ILong,_)
+ when bitsSizeOf t2' <= bitsSizeOf t1' -> TInt(IULong,[])
+
+ | TInt(ILong, _), _ -> checkToInt t2'; t1'
+ | _, TInt(ILong, _) -> checkToInt t1'; t2'
+
+ | TInt(IUInt, _), _ -> checkToInt t2'; t1'
+ | _, TInt(IUInt, _) -> checkToInt t1'; t2'
+
+ | TInt(IInt, _), TInt (IInt, _) -> t1'
+
+ | _, _ -> E.s (error "arithmeticConversion")
+ end
+
+
+(* Specify whether the cast is from the source code *)
+let rec castTo ?(fromsource=false)
+ (ot : typ) (nt : typ) (e : exp) : (typ * exp ) =
+(*
+ ignore (E.log "%t: castTo:%s %a->%a\n"
+ d_thisloc
+ (if fromsource then "(source)" else "")
+ d_type ot d_type nt);
+*)
+ if not fromsource && Util.equals (typeSig ot) (typeSig nt) then
+ (* Do not put the cast if it is not necessary, unless it is from the
+ * source. *)
+ (ot, e)
+ else begin
+ let result = (nt,
+ if !insertImplicitCasts || fromsource then mkCastT e ot nt else e) in
+(*
+ ignore (E.log "castTo: ot=%a nt=%a\n result is %a\n"
+ d_type ot d_type nt
+ d_plainexp (snd result));
+*)
+ (* Now see if we can have a cast here *)
+ match ot, nt with
+ TNamed(r, _), _ -> castTo ~fromsource:fromsource r.ttype nt e
+ | _, TNamed(r, _) -> castTo ~fromsource:fromsource ot r.ttype e
+ | TInt(ikindo,_), TInt(ikindn,_) ->
+ (* We used to ignore attributes on integer-integer casts. Not anymore *)
+ (* if ikindo = ikindn then (nt, e) else *)
+ result
+
+ | TPtr (told, _), TPtr(tnew, _) -> result
+
+ | TInt _, TPtr _ -> result
+
+ | TPtr _, TInt _ -> result
+
+ | TArray _, TPtr _ -> result
+
+ | TArray(t1,_,_), TArray(t2,None,_) when Util.equals (typeSig t1) (typeSig t2) -> (nt, e)
+
+ | TPtr _, TArray(_,_,_) -> (nt, e)
+
+ | TEnum _, TInt _ -> result
+ | TFloat _, (TInt _|TEnum _) -> result
+ | (TInt _|TEnum _), TFloat _ -> result
+ | TFloat _, TFloat _ -> result
+ | TInt _, TEnum _ -> result
+ | TEnum _, TEnum _ -> result
+
+ | TEnum _, TPtr _ -> result
+ | TBuiltin_va_list _, (TInt _ | TPtr _) ->
+ result
+
+ | (TInt _ | TPtr _), TBuiltin_va_list _ ->
+ ignore (warnOpt "Casting %a to __builtin_va_list" d_type ot);
+ result
+
+ | TPtr _, TEnum _ ->
+ ignore (warnOpt "Casting a pointer into an enumeration type");
+ result
+
+ (* The expression is evaluated for its side-effects *)
+ | (TInt _ | TEnum _ | TPtr _ ), TVoid _ ->
+ (ot, e)
+
+ (* Even casts between structs are allowed when we are only
+ * modifying some attributes *)
+ | TComp (comp1, a1), TComp (comp2, a2) when comp1.ckey = comp2.ckey ->
+ (nt, e)
+
+ (** If we try to pass a transparent union value to a function
+ * expecting a transparent union argument, the argument type would
+ * have been changed to the type of the first argument, and we'll
+ * see a cast from a union to the type of the first argument. Turn
+ * that into a field access *)
+ | TComp(tunion, a1), nt -> begin
+ match isTransparentUnion ot with
+ None -> E.s (error "castTo %a -> %a@!" d_type ot d_type nt)
+ | Some fstfield -> begin
+ (* We do it now only if the expression is an lval *)
+ let e' =
+ match e with
+ Lval lv ->
+ Lval (addOffsetLval (Field(fstfield, NoOffset)) lv)
+ | _ -> E.s (unimp "castTo: transparent union expression is not an lval: %a\n" d_exp e)
+ in
+ (* Continue casting *)
+ castTo ~fromsource:fromsource fstfield.ftype nt e'
+ end
+ end
+ | _ -> E.s (error "cabs2cil: castTo %a -> %a@!" d_type ot d_type nt)
+ end
+
+
+(* A cast that is used for conditional expressions. Pointers are Ok *)
+let checkBool (ot : typ) (e : exp) : bool =
+ match unrollType ot with
+ TInt _ -> true
+ | TPtr _ -> true
+ | TEnum _ -> true
+ | TFloat _ -> true
+ | _ -> E.s (error "castToBool %a" d_type ot)
+
+(* Given an expression that is being coerced to bool,
+ is it a nonzero constant? *)
+let rec isConstTrue (e:exp): bool =
+ match e with
+ | Const(CInt64 (n,_,_)) -> n <> Int64.zero
+ | Const(CChr c) -> 0 <> Char.code c
+ | Const(CStr _ | CWStr _) -> true
+ | Const(CReal(f, _, _)) -> f <> 0.0;
+ | CastE(_, e) -> isConstTrue e
+ | _ -> false
+
+(* Given an expression that is being coerced to bool, is it zero?
+ This is a more general version of Cil.isZero, which only handles integers.
+ On constant expressions, either isConstTrue or isConstFalse will hold. *)
+let rec isConstFalse (e:exp): bool =
+ match e with
+ | Const(CInt64 (n,_,_)) -> n = Int64.zero
+ | Const(CChr c) -> 0 = Char.code c
+ | Const(CReal(f, _, _)) -> f = 0.0;
+ | CastE(_, e) -> isConstFalse e
+ | _ -> false
+
+
+
+(* We have our own version of addAttributes that does not allow duplicates *)
+let cabsAddAttributes al0 (al: attributes) : attributes =
+ if al0 == [] then al else
+ List.fold_left
+ (fun acc (Attr(an, _) as a) ->
+ (* See if the attribute is already in there *)
+ match filterAttributes an acc with
+ [] -> addAttribute a acc (* Nothing with that name *)
+ | a' :: _ ->
+ if Util.equals a a' then
+ acc (* Already in *)
+ else begin
+ ignore (warnOpt
+ "Duplicate attribute %a along with %a"
+ d_attr a d_attr a');
+ (* let acc' = dropAttribute an acc in *)
+ (** Keep both attributes *)
+ addAttribute a acc
+ end)
+ al
+ al0
+
+let cabsTypeAddAttributes a0 t =
+ begin
+ match a0 with
+ | [] ->
+ (* no attributes, keep same type *)
+ t
+ | _ ->
+ (* anything else: add a0 to existing attributes *)
+ let add (a: attributes) = cabsAddAttributes a0 a in
+ match t with
+ TVoid a -> TVoid (add a)
+ | TInt (ik, a) ->
+ (* Here we have to watch for the mode attribute *)
+(* sm: This stuff is to handle a GCC extension where you can request integers*)
+(* of specific widths using the "mode" attribute syntax; for example: *)
+(* typedef int int8_t __attribute__ ((__mode__ ( __QI__ ))) ; *)
+(* The cryptic "__QI__" defines int8_t to be 8 bits wide, instead of the *)
+(* 32 bits you'd guess if you didn't know about "mode". The relevant *)
+(* testcase is test/small2/mode_sizes.c, and it was inspired by my *)
+(* /usr/include/sys/types.h. *)
+(* *)
+(* A consequence of this handling is that we throw away the mode *)
+(* attribute, which we used to go out of our way to avoid printing anyway.*)
+ let ik', a0' =
+ (* Go over the list of new attributes and come back with a
+ * filtered list and a new integer kind *)
+ List.fold_left
+ (fun (ik', a0') a0one ->
+ match a0one with
+ Attr("mode", [ACons(mode,[])]) -> begin
+ (trace "gccwidth" (dprintf "I see mode %s applied to an int type\n"
+ mode (* #$@!#@ ML! d_type t *) ));
+ (* the cases below encode the 32-bit assumption.. *)
+ match (ik', mode) with
+ | (IInt, "__QI__") -> (IChar, a0')
+ | (IInt, "__byte__") -> (IChar, a0')
+ | (IInt, "__HI__") -> (IShort, a0')
+ | (IInt, "__SI__") -> (IInt, a0') (* same as t *)
+ | (IInt, "__word__") -> (IInt, a0')
+ | (IInt, "__pointer__") -> (IInt, a0')
+ | (IInt, "__DI__") -> (ILongLong, a0')
+
+ | (IUInt, "__QI__") -> (IUChar, a0')
+ | (IUInt, "__byte__") -> (IUChar, a0')
+ | (IUInt, "__HI__") -> (IUShort, a0')
+ | (IUInt, "__SI__") -> (IUInt, a0')
+ | (IUInt, "__word__") -> (IUInt, a0')
+ | (IUInt, "__pointer__")-> (IUInt, a0')
+ | (IUInt, "__DI__") -> (IULongLong, a0')
+
+ | _ ->
+ (ignore (error "GCC width mode %s applied to unexpected type, or unexpected mode"
+ mode));
+ (ik', a0one :: a0')
+
+ end
+ | _ -> (ik', a0one :: a0'))
+ (ik, [])
+ a0
+ in
+ TInt (ik', cabsAddAttributes a0' a)
+
+ | TFloat (fk, a) -> TFloat (fk, add a)
+ | TEnum (enum, a) -> TEnum (enum, add a)
+ | TPtr (t, a) -> TPtr (t, add a)
+ | TArray (t, l, a) -> TArray (t, l, add a)
+ | TFun (t, args, isva, a) -> TFun(t, args, isva, add a)
+ | TComp (comp, a) -> TComp (comp, add a)
+ | TNamed (t, a) -> TNamed (t, add a)
+ | TBuiltin_va_list a -> TBuiltin_va_list (add a)
+ end
+
+
+(* Do types *)
+ (* Combine the types. Raises the Failure exception with an error message.
+ * isdef says whether the new type is for a definition *)
+type combineWhat =
+ CombineFundef (* The new definition is for a function definition. The old
+ * is for a prototype *)
+ | CombineFunarg (* Comparing a function argument type with an old prototype
+ * arg *)
+ | CombineFunret (* Comparing the return of a function with that from an old
+ * prototype *)
+ | CombineOther
+
+(* We sometimes want to succeed in combining two structure types that are
+ * identical except for the names of the structs. We keep a list of types
+ * that are known to be equal *)
+let isomorphicStructs : (string * string, bool) H.t = H.create 15
+
+let rec combineTypes (what: combineWhat) (oldt: typ) (t: typ) : typ =
+ match oldt, t with
+ | TVoid olda, TVoid a -> TVoid (cabsAddAttributes olda a)
+ | TInt (oldik, olda), TInt (ik, a) ->
+ let combineIK oldk k =
+ if oldk = k then oldk else
+ (* GCC allows a function definition to have a more precise integer
+ * type than a prototype that says "int" *)
+ if not !msvcMode && oldk = IInt && bitsSizeOf t <= 32
+ && (what = CombineFunarg || what = CombineFunret) then
+ k
+ else
+ raise (Failure "different integer types")
+ in
+ TInt (combineIK oldik ik, cabsAddAttributes olda a)
+ | TFloat (oldfk, olda), TFloat (fk, a) ->
+ let combineFK oldk k =
+ if oldk = k then oldk else
+ (* GCC allows a function definition to have a more precise integer
+ * type than a prototype that says "double" *)
+ if not !msvcMode && oldk = FDouble && k = FFloat
+ && (what = CombineFunarg || what = CombineFunret) then
+ k
+ else
+ raise (Failure "different floating point types")
+ in
+ TFloat (combineFK oldfk fk, cabsAddAttributes olda a)
+ | TEnum (_, olda), TEnum (ei, a) ->
+ TEnum (ei, cabsAddAttributes olda a)
+
+ (* Strange one. But seems to be handled by GCC *)
+ | TEnum (oldei, olda) , TInt(IInt, a) -> TEnum(oldei,
+ cabsAddAttributes olda a)
+ (* Strange one. But seems to be handled by GCC *)
+ | TInt(IInt, olda), TEnum (ei, a) -> TEnum(ei, cabsAddAttributes olda a)
+
+
+ | TComp (oldci, olda) , TComp (ci, a) ->
+ if oldci.cstruct <> ci.cstruct then
+ raise (Failure "different struct/union types");
+ let comb_a = cabsAddAttributes olda a in
+ if oldci.cname = ci.cname then
+ TComp (oldci, comb_a)
+ else
+ (* Now maybe they are actually the same *)
+ if H.mem isomorphicStructs (oldci.cname, ci.cname) then
+ (* We know they are the same *)
+ TComp (oldci, comb_a)
+ else begin
+ (* If one has 0 fields (undefined) while the other has some fields
+ * we accept it *)
+ let oldci_nrfields = List.length oldci.cfields in
+ let ci_nrfields = List.length ci.cfields in
+ if oldci_nrfields = 0 then
+ TComp (ci, comb_a)
+ else if ci_nrfields = 0 then
+ TComp (oldci, comb_a)
+ else begin
+ (* Make sure that at least they have the same number of fields *)
+ if oldci_nrfields <> ci_nrfields then begin
+(*
+ ignore (E.log "different number of fields: %s had %d and %s had %d\n"
+ oldci.cname oldci_nrfields
+ ci.cname ci_nrfields);
+*)
+ raise (Failure "different structs(number of fields)");
+ end;
+ (* Assume they are the same *)
+ H.add isomorphicStructs (oldci.cname, ci.cname) true;
+ H.add isomorphicStructs (ci.cname, oldci.cname) true;
+ (* Check that the fields are isomorphic and watch for Failure *)
+ (try
+ List.iter2 (fun oldf f ->
+ if oldf.fbitfield <> f.fbitfield then
+ raise (Failure "different structs(bitfield info)");
+ if oldf.fattr <> f.fattr then
+ raise (Failure "different structs(field attributes)");
+ (* Make sure the types are compatible *)
+ ignore (combineTypes CombineOther oldf.ftype f.ftype);
+ ) oldci.cfields ci.cfields
+ with Failure _ as e -> begin
+ (* Our assumption was wrong. Forget the isomorphism *)
+ ignore (E.log "\tFailed in our assumption that %s and %s are isomorphic\n"
+ oldci.cname ci.cname);
+ H.remove isomorphicStructs (oldci.cname, ci.cname);
+ H.remove isomorphicStructs (ci.cname, oldci.cname);
+ raise e
+ end);
+ (* We get here if we succeeded *)
+ TComp (oldci, comb_a)
+ end
+ end
+
+ | TArray (oldbt, oldsz, olda), TArray (bt, sz, a) ->
+ let newbt = combineTypes CombineOther oldbt bt in
+ let newsz =
+ match oldsz, sz with
+ None, Some _ -> sz
+ | Some _, None -> oldsz
+ | None, None -> sz
+ | Some oldsz', Some sz' ->
+ (* They are not structurally equal. But perhaps they are equal if
+ * we evaluate them. Check first machine independent comparison *)
+ let checkEqualSize (machdep: bool) =
+ Util.equals (constFold machdep oldsz')
+ (constFold machdep sz')
+ in
+ if checkEqualSize false then
+ oldsz
+ else if checkEqualSize true then begin
+ ignore (warn "Array type comparison succeeds only based on machine-dependent constant evaluation: %a and %a\n"
+ d_exp oldsz' d_exp sz');
+ oldsz
+ end else
+ raise (Failure "different array lengths")
+
+ in
+ TArray (newbt, newsz, cabsAddAttributes olda a)
+
+ | TPtr (oldbt, olda), TPtr (bt, a) ->
+ TPtr (combineTypes CombineOther oldbt bt, cabsAddAttributes olda a)
+
+ | TFun (_, _, _, [Attr("missingproto",_)]), TFun _ -> t
+
+ | TFun (oldrt, oldargs, oldva, olda), TFun (rt, args, va, a) ->
+ let newrt = combineTypes
+ (if what = CombineFundef then CombineFunret else CombineOther)
+ oldrt rt
+ in
+ if oldva != va then
+ raise (Failure "diferent vararg specifiers");
+ (* If one does not have arguments, believe the one with the
+ * arguments *)
+ let newargs =
+ if oldargs = None then args else
+ if args = None then oldargs else
+ let oldargslist = argsToList oldargs in
+ let argslist = argsToList args in
+ if List.length oldargslist <> List.length argslist then
+ raise (Failure "different number of arguments")
+ else begin
+ (* Go over the arguments and update the old ones with the
+ * adjusted types *)
+ Some
+ (List.map2
+ (fun (on, ot, oa) (an, at, aa) ->
+ (* Update the names. Always prefer the new name. This is
+ * very important if the prototype uses different names than
+ * the function definition. *)
+ let n = if an <> "" then an else on in
+ let t =
+ combineTypes
+ (if what = CombineFundef then
+ CombineFunarg else CombineOther)
+ ot at
+ in
+ let a = addAttributes oa aa in
+ (n, t, a))
+ oldargslist argslist)
+ end
+ in
+ TFun (newrt, newargs, oldva, cabsAddAttributes olda a)
+
+ | TNamed (oldt, olda), TNamed (t, a) when oldt.tname = t.tname ->
+ TNamed (oldt, cabsAddAttributes olda a)
+
+ | TBuiltin_va_list olda, TBuiltin_va_list a ->
+ TBuiltin_va_list (cabsAddAttributes olda a)
+
+ (* Unroll first the new type *)
+ | _, TNamed (t, a) ->
+ let res = combineTypes what oldt t.ttype in
+ cabsTypeAddAttributes a res
+
+ (* And unroll the old type as well if necessary *)
+ | TNamed (oldt, a), _ ->
+ let res = combineTypes what oldt.ttype t in
+ cabsTypeAddAttributes a res
+
+ | _ -> raise (Failure "different type constructors")
+
+
+(* Create and cache varinfo's for globals. Starts with a varinfo but if the
+ * global has been declared already it might come back with another varinfo.
+ * Returns the varinfo to use (might be the old one), and an indication
+ * whether the variable exists already in the environment *)
+let makeGlobalVarinfo (isadef: bool) (vi: varinfo) : varinfo * bool =
+ try (* See if already defined, in the global environment. We could also
+ * look it up in the whole environment but in that case we might see a
+ * local. This can happen when we declare an extern variable with
+ * global scope but we are in a local scope. *)
+ let oldvi, oldloc = lookupGlobalVar vi.vname in
+ (* It was already defined. We must reuse the varinfo. But clean up the
+ * storage. *)
+ let newstorage = (** See 6.2.2 *)
+ match oldvi.vstorage, vi.vstorage with
+ (* Extern and something else is that thing *)
+ | Extern, other
+ | other, Extern -> other
+
+ | NoStorage, other
+ | other, NoStorage -> other
+
+
+ | _ ->
+ if vi.vstorage != oldvi.vstorage then
+ ignore (warn
+ "Inconsistent storage specification for %s. Previous declaration: %a"
+ vi.vname d_loc oldloc);
+ vi.vstorage
+ in
+ oldvi.vinline <- oldvi.vinline || vi.vinline;
+ oldvi.vstorage <- newstorage;
+ (* Union the attributes *)
+ oldvi.vattr <- cabsAddAttributes oldvi.vattr vi.vattr;
+ begin
+ try
+ oldvi.vtype <-
+ combineTypes
+ (if isadef then CombineFundef else CombineOther)
+ oldvi.vtype vi.vtype;
+ with Failure reason ->
+ ignore (E.log "old type = %a\n" d_plaintype oldvi.vtype);
+ ignore (E.log "new type = %a\n" d_plaintype vi.vtype);
+ E.s (error "Declaration of %s does not match previous declaration from %a (%s)."
+ vi.vname d_loc oldloc reason)
+ end;
+
+ (* Found an old one. Keep the location always from the definition *)
+ if isadef then begin
+ oldvi.vdecl <- vi.vdecl;
+ end;
+ oldvi, true
+
+ with Not_found -> begin (* A new one. *)
+ (* Announce the name to the alpha conversion table. This will not
+ * actually change the name of the vi. See the definition of
+ * alphaConvertVarAndAddToEnv *)
+ alphaConvertVarAndAddToEnv true vi, false
+ end
+
+let conditionalConversion (t2: typ) (t3: typ) : typ =
+ let tresult = (* ISO 6.5.15 *)
+ match unrollType t2, unrollType t3 with
+ (TInt _ | TEnum _ | TFloat _),
+ (TInt _ | TEnum _ | TFloat _) ->
+ arithmeticConversion t2 t3
+ | TComp (comp2,_), TComp (comp3,_)
+ when comp2.ckey = comp3.ckey -> t2
+ | TPtr(_, _), TPtr(TVoid _, _) -> t2
+ | TPtr(TVoid _, _), TPtr(_, _) -> t3
+ | TPtr _, TPtr _ when Util.equals (typeSig t2) (typeSig t3) -> t2
+ | TPtr _, TInt _ -> t2 (* most likely comparison with 0 *)
+ | TInt _, TPtr _ -> t3 (* most likely comparison with 0 *)
+
+ (* When we compare two pointers of diffent type, we combine them
+ * using the same algorithm when combining multiple declarations of
+ * a global *)
+ | (TPtr _) as t2', (TPtr _ as t3') -> begin
+ try combineTypes CombineOther t2' t3'
+ with Failure msg -> begin
+ ignore (warn "A.QUESTION: %a does not match %a (%s)"
+ d_type (unrollType t2) d_type (unrollType t3) msg);
+ t2 (* Just pick one *)
+ end
+ end
+ | _, _ -> E.s (error "A.QUESTION for invalid combination of types")
+ in
+ tresult
+
+(* Some utilitites for doing initializers *)
+
+let debugInit = false
+
+type preInit =
+ | NoInitPre
+ | SinglePre of exp
+ | CompoundPre of int ref (* the maximum used index *)
+ * preInit array ref (* an array with initializers *)
+
+(* Instructions on how to handle designators *)
+type handleDesignators =
+ | Handle (* Handle them yourself *)
+ | DoNotHandle (* Do not handle them your self *)
+ | HandleAsNext (* First behave as if you have a NEXT_INIT. Useful for going
+ * into nested designators *)
+ | HandleFirst (* Handle only the first designator *)
+
+(* Set an initializer *)
+let rec setOneInit (this: preInit)
+ (o: offset) (e: exp) : preInit =
+ match o with
+ NoOffset -> SinglePre e
+ | _ ->
+ let idx, (* Index in the current comp *)
+ restoff (* Rest offset *) =
+ match o with
+ | Index(Const(CInt64(i,_,_)), off) -> Int64.to_int i, off
+ | Field (f, off) ->
+ (* Find the index of the field *)
+ let rec loop (idx: int) = function
+ [] -> E.s (bug "Cannot find field %s" f.fname)
+ | f' :: _ when f'.fname = f.fname -> idx
+ | _ :: restf -> loop (idx + 1) restf
+ in
+ loop 0 f.fcomp.cfields, off
+ | _ -> E.s (bug "setOneInit: non-constant index")
+ in
+ let pMaxIdx, pArray =
+ match this with
+ NoInitPre -> (* No initializer so far here *)
+ ref idx, ref (Array.create (max 32 (idx + 1)) NoInitPre)
+
+ | CompoundPre (pMaxIdx, pArray) ->
+ if !pMaxIdx < idx then begin
+ pMaxIdx := idx;
+ (* Maybe we also need to grow the array *)
+ let l = Array.length !pArray in
+ if l <= idx then begin
+ let growBy = max (max 32 (idx + 1 - l)) (l / 2) in
+ let newarray = Array.make (growBy + idx) NoInitPre in
+ Array.blit !pArray 0 newarray 0 l;
+ pArray := newarray
+ end
+ end;
+ pMaxIdx, pArray
+ | SinglePre e ->
+ E.s (unimp "Index %d is already initialized" idx)
+ in
+ assert (idx >= 0 && idx < Array.length !pArray);
+ let this' = setOneInit !pArray.(idx) restoff e in
+ !pArray.(idx) <- this';
+ CompoundPre (pMaxIdx, pArray)
+
+
+(* collect a CIL initializer, given the original syntactic initializer
+ * 'preInit'; this returns a type too, since initialization of an array
+ * with unspecified size actually changes the array's type
+ * (ANSI C, 6.7.8, para 22) *)
+let rec collectInitializer
+ (this: preInit)
+ (thistype: typ) : (init * typ) =
+ if this = NoInitPre then (makeZeroInit thistype), thistype
+ else
+ match unrollType thistype, this with
+ | _ , SinglePre e -> SingleInit e, thistype
+ | TArray (bt, leno, at), CompoundPre (pMaxIdx, pArray) ->
+ let (len: int), newtype =
+ (* normal case: use array's declared length, newtype=thistype *)
+ match leno with
+ Some len -> begin
+ match constFold true len with
+ Const(CInt64(ni, _, _)) when ni >= 0L ->
+ (Int64.to_int ni), TArray(bt,leno,at)
+
+ | _ -> E.s (error "Array length is not a constant expression %a"
+ d_exp len)
+ end
+ | _ ->
+ (* unsized array case, length comes from initializers *)
+ (!pMaxIdx + 1,
+ TArray (bt, Some (integer (!pMaxIdx + 1)), at))
+ in
+ if !pMaxIdx >= len then
+ E.s (E.bug "collectInitializer: too many initializers(%d >= %d)\n"
+ !pMaxIdx len);
+ (* len could be extremely big. So omit the last initializers, if they
+ * are many (more than 16) *)
+(*
+ ignore (E.log "collectInitializer: len = %d, pMaxIdx= %d\n"
+ len !pMaxIdx); *)
+ let endAt =
+ if len - 1 > !pMaxIdx + 16 then
+ !pMaxIdx
+ else
+ len - 1
+ in
+ (* Make one zero initializer to be used next *)
+ let oneZeroInit = makeZeroInit bt in
+ let rec collect (acc: (offset * init) list) (idx: int) =
+ if idx = -1 then acc
+ else
+ let thisi =
+ if idx > !pMaxIdx then oneZeroInit
+ else (fst (collectInitializer !pArray.(idx) bt))
+ in
+ collect ((Index(integer idx, NoOffset), thisi) :: acc) (idx - 1)
+ in
+
+ CompoundInit (newtype, collect [] endAt), newtype
+
+ | TComp (comp, _), CompoundPre (pMaxIdx, pArray) when comp.cstruct ->
+ let rec collect (idx: int) = function
+ [] -> []
+ | f :: restf ->
+ if f.fname = missingFieldName then
+ collect (idx + 1) restf
+ else
+ let thisi =
+ if idx > !pMaxIdx then
+ makeZeroInit f.ftype
+ else
+ collectFieldInitializer !pArray.(idx) f
+ in
+ (Field(f, NoOffset), thisi) :: collect (idx + 1) restf
+ in
+ CompoundInit (thistype, collect 0 comp.cfields), thistype
+
+ | TComp (comp, _), CompoundPre (pMaxIdx, pArray) when not comp.cstruct ->
+ (* Find the field to initialize *)
+ let rec findField (idx: int) = function
+ [] -> E.s (bug "collectInitializer: union")
+ | _ :: rest when idx < !pMaxIdx && !pArray.(idx) = NoInitPre ->
+ findField (idx + 1) rest
+ | f :: _ when idx = !pMaxIdx ->
+ Field(f, NoOffset),
+ collectFieldInitializer !pArray.(idx) f
+ | _ -> E.s (error "Can initialize only one field for union")
+ in
+ if !msvcMode && !pMaxIdx != 0 then
+ ignore (warn "On MSVC we can initialize only the first field of a union");
+ CompoundInit (thistype, [ findField 0 comp.cfields ]), thistype
+
+ | _ -> E.s (unimp "collectInitializer")
+
+and collectFieldInitializer
+ (this: preInit)
+ (f: fieldinfo) : init =
+ (* collect, and rewrite type *)
+ let init,newtype = (collectInitializer this f.ftype) in
+ f.ftype <- newtype;
+ init
+
+
+type stackElem =
+ InArray of offset * typ * int * int ref (* offset of parent, base type,
+ * length, current index. If the
+ * array length is unspecified we
+ * use Int.max_int *)
+ | InComp of offset * compinfo * fieldinfo list (* offset of parent,
+ base comp, current fields *)
+
+
+(* A subobject is given by its address. The address is read from the end of
+ * the list (the bottom of the stack), starting with the current object *)
+type subobj = { mutable stack: stackElem list; (* With each stack element we
+ * store the offset of its
+ * PARENT *)
+ mutable eof: bool; (* The stack is empty and we reached the
+ * end *)
+ mutable soTyp: typ; (* The type of the subobject. Set using
+ * normalSubobj after setting stack. *)
+ mutable soOff: offset; (* The offset of the subobject. Set
+ * using normalSubobj after setting
+ * stack. *)
+ curTyp: typ; (* Type of current object. See ISO for
+ * the definition of the current object *)
+ curOff: offset; (* The offset of the current obj *)
+ host: varinfo; (* The host that we are initializing.
+ * For error messages *)
+ }
+
+
+(* Make a subobject iterator *)
+let rec makeSubobj
+ (host: varinfo)
+ (curTyp: typ)
+ (curOff: offset) =
+ let so =
+ { host = host; curTyp = curTyp; curOff = curOff;
+ stack = []; eof = false;
+ (* The next are fixed by normalSubobj *)
+ soTyp = voidType; soOff = NoOffset } in
+ normalSubobj so;
+ so
+
+ (* Normalize a stack so the we always point to a valid subobject. Do not
+ * descend into type *)
+and normalSubobj (so: subobj) : unit =
+ match so.stack with
+ [] -> so.soOff <- so.curOff; so.soTyp <- so.curTyp
+ (* The array is over *)
+ | InArray (parOff, bt, leno, current) :: rest ->
+ if leno = !current then begin (* The array is over *)
+ if debugInit then ignore (E.log "Past the end of array\n");
+ so.stack <- rest;
+ advanceSubobj so
+ end else begin
+ so.soTyp <- bt;
+ so.soOff <- addOffset (Index(integer !current, NoOffset)) parOff
+ end
+
+ (* The fields are over *)
+ | InComp (parOff, comp, nextflds) :: rest ->
+ if nextflds == [] then begin (* No more fields here *)
+ if debugInit then ignore (E.log "Past the end of structure\n");
+ so.stack <- rest;
+ advanceSubobj so
+ end else begin
+ let fst = List.hd nextflds in
+ so.soTyp <- fst.ftype;
+ so.soOff <- addOffset (Field(fst, NoOffset)) parOff
+ end
+
+ (* Advance to the next subobject. Always apply to a normalized object *)
+and advanceSubobj (so: subobj) : unit =
+ if so.eof then E.s (bug "advanceSubobj past end");
+ match so.stack with
+ | [] -> if debugInit then ignore (E.log "Setting eof to true\n");
+ so.eof <- true
+ | InArray (parOff, bt, leno, current) :: rest ->
+ if debugInit then ignore (E.log " Advancing to [%d]\n" (!current + 1));
+ (* so.stack <- InArray (parOff, bt, leno, current + 1) :: rest; *)
+ incr current;
+ normalSubobj so
+
+ (* The fields are over *)
+ | InComp (parOff, comp, nextflds) :: rest ->
+ if debugInit then
+ ignore (E.log "Advancing past .%s\n" (List.hd nextflds).fname);
+ let flds' = try List.tl nextflds with _ -> E.s (bug "advanceSubobj") in
+ so.stack <- InComp(parOff, comp, flds') :: rest;
+ normalSubobj so
+
+
+
+(* Find the fields to initialize in a composite. *)
+let fieldsToInit
+ (comp: compinfo)
+ (designator: string option)
+ : fieldinfo list =
+ (* Never look at anonymous fields *)
+ let flds1 =
+ List.filter (fun f -> f.fname <> missingFieldName) comp.cfields in
+ let flds2 =
+ match designator with
+ None -> flds1
+ | Some fn ->
+ let rec loop = function
+ [] -> E.s (error "Cannot find designated field %s" fn)
+ | (f :: _) as nextflds when f.fname = fn -> nextflds
+ | _ :: rest -> loop rest
+ in
+ loop flds1
+ in
+ (* If it is a union we only initialize one field *)
+ match flds2 with
+ [] -> []
+ | (f :: rest) as toinit ->
+ if comp.cstruct then toinit else [f]
+
+
+let integerArrayLength (leno: exp option) : int =
+ match leno with
+ None -> max_int
+ | Some len -> begin
+ try lenOfArray leno
+ with LenOfArray ->
+ E.s (error "Initializing non-constant-length array\n length=%a\n"
+ d_exp len)
+ end
+
+(* sm: I'm sure something like this already exists, but ... *)
+let isNone (o : 'a option) : bool =
+ match o with
+ | None -> true
+ | Some _ -> false
+
+
+let annonCompFieldNameId = ref 0
+let annonCompFieldName = "__annonCompField"
+
+
+
+(* Utility ***)
+let rec replaceLastInList
+ (lst: A.expression list)
+ (how: A.expression -> A.expression) : A.expression list=
+ match lst with
+ [] -> []
+ | [e] -> [how e]
+ | h :: t -> h :: replaceLastInList t how
+
+
+
+
+
+let convBinOp (bop: A.binary_operator) : binop =
+ match bop with
+ A.ADD -> PlusA
+ | A.SUB -> MinusA
+ | A.MUL -> Mult
+ | A.DIV -> Div
+ | A.MOD -> Mod
+ | A.BAND -> BAnd
+ | A.BOR -> BOr
+ | A.XOR -> BXor
+ | A.SHL -> Shiftlt
+ | A.SHR -> Shiftrt
+ | A.EQ -> Eq
+ | A.NE -> Ne
+ | A.LT -> Lt
+ | A.LE -> Le
+ | A.GT -> Gt
+ | A.GE -> Ge
+ | _ -> E.s (error "convBinOp")
+
+(**** PEEP-HOLE optimizations ***)
+let afterConversion (c: chunk) : chunk =
+ (* Now scan the statements and find Instr blocks *)
+
+ (** We want to collapse sequences of the form "tmp = f(); v = tmp". This
+ * will help significantly with the handling of calls to malloc, where it
+ * is important to have the cast at the same place as the call *)
+ let collapseCallCast = function
+ Call(Some(Var vi, NoOffset), f, args, l),
+ Set(destlv, CastE (newt, Lval(Var vi', NoOffset)), _)
+ when (not vi.vglob &&
+ String.length vi.vname >= 3 &&
+ (* Watch out for the possibility that we have an implied cast in
+ * the call *)
+ (let tcallres =
+ match unrollType (typeOf f) with
+ TFun (rt, _, _, _) -> rt
+ | _ -> E.s (E.bug "Function call to a non-function")
+ in
+ Util.equals (typeSig tcallres) (typeSig vi.vtype) &&
+ Util.equals (typeSig newt) (typeSig (typeOfLval destlv))) &&
+ IH.mem callTempVars vi.vid &&
+ vi' == vi)
+ -> Some [Call(Some destlv, f, args, l)]
+ | i1,i2 -> None
+ in
+ (* First add in the postins *)
+ let sl = pushPostIns c in
+ peepHole2 collapseCallCast sl;
+ { c with stmts = sl; postins = [] }
+
+(***** Try to suggest a name for the anonymous structures *)
+let suggestAnonName (nl: A.name list) =
+ match nl with
+ [] -> ""
+ | (n, _, _, _) :: _ -> n
+
+
+(** Optional constant folding of binary operations *)
+let optConstFoldBinOp (machdep: bool) (bop: binop)
+ (e1: exp) (e2:exp) (t: typ) =
+ if !lowerConstants then
+ constFoldBinOp machdep bop e1 e2 t
+ else
+ BinOp(bop, e1, e2, t)
+
+(****** TYPE SPECIFIERS *******)
+let rec doSpecList (suggestedAnonName: string) (* This string will be part of
+ * the names for anonymous
+ * structures and enums *)
+ (specs: A.spec_elem list)
+ (* Returns the base type, the storage, whether it is inline and the
+ * (unprocessed) attributes *)
+ : typ * storage * bool * A.attribute list =
+ (* Do one element and collect the type specifiers *)
+ let isinline = ref false in (* If inline appears *)
+ (* The storage is placed here *)
+ let storage : storage ref = ref NoStorage in
+
+ (* Collect the attributes. Unfortunately, we cannot treat GCC
+ * __attributes__ and ANSI C const/volatile the same way, since they
+ * associate with structures differently. Specifically, ANSI
+ * qualifiers never apply to structures (ISO 6.7.3), whereas GCC
+ * attributes always do (GCC manual 4.30). Therefore, they are
+ * collected and processed separately. *)
+ let attrs : A.attribute list ref = ref [] in (* __attribute__, etc. *)
+ let cvattrs : A.cvspec list ref = ref [] in (* const/volatile *)
+
+ let doSpecElem (se: A.spec_elem)
+ (acc: A.typeSpecifier list)
+ : A.typeSpecifier list =
+ match se with
+ A.SpecTypedef -> acc
+ | A.SpecInline -> isinline := true; acc
+ | A.SpecStorage st ->
+ if !storage <> NoStorage then
+ E.s (error "Multiple storage specifiers");
+ let sto' =
+ match st with
+ A.NO_STORAGE -> NoStorage
+ | A.AUTO -> NoStorage
+ | A.REGISTER -> Register
+ | A.STATIC -> Static
+ | A.EXTERN -> Extern
+ in
+ storage := sto';
+ acc
+
+ | A.SpecCV cv -> cvattrs := cv :: !cvattrs; acc
+ | A.SpecAttr a -> attrs := a :: !attrs; acc
+ | A.SpecType ts -> ts :: acc
+ | A.SpecPattern _ -> E.s (E.bug "SpecPattern in cabs2cil input")
+ in
+ (* Now scan the list and collect the type specifiers. Preserve the order *)
+ let tspecs = List.fold_right doSpecElem specs [] in
+
+ let tspecs' =
+ (* GCC allows a named type that appears first to be followed by things
+ * like "short", "signed", "unsigned" or "long". *)
+ match tspecs with
+ A.Tnamed n :: (_ :: _ as rest) when not !msvcMode ->
+ (* If rest contains "short" or "long" then drop the Tnamed *)
+ if List.exists (function A.Tshort -> true
+ | A.Tlong -> true | _ -> false) rest then
+ rest
+ else
+ tspecs
+
+ | _ -> tspecs
+ in
+ (* Sort the type specifiers *)
+ let sortedspecs =
+ let order = function (* Don't change this *)
+ | A.Tvoid -> 0
+ | A.Tsigned -> 1
+ | A.Tunsigned -> 2
+ | A.Tchar -> 3
+ | A.Tshort -> 4
+ | A.Tlong -> 5
+ | A.Tint -> 6
+ | A.Tint64 -> 7
+ | A.Tfloat -> 8
+ | A.Tdouble -> 9
+ | _ -> 10 (* There should be at most one of the others *)
+ in
+ List.stable_sort (fun ts1 ts2 -> compare (order ts1) (order ts2)) tspecs'
+ in
+ let getTypeAttrs () : A.attribute list =
+ (* Partitions the attributes in !attrs.
+ Type attributes are removed from attrs and returned, so that they
+ can go into the type definition. Name attributes are left in attrs,
+ so they will be returned by doSpecAttr and used in the variable
+ declaration.
+ Testcase: small1/attr9.c *)
+ let an, af, at = cabsPartitionAttributes ~default:AttrType !attrs in
+ attrs := an; (* Save the name attributes for later *)
+ if af <> [] then
+ E.s (error "Invalid position for function type attributes.");
+ at
+ in
+
+ (* And now try to make sense of it. See ISO 6.7.2 *)
+ let bt =
+ match sortedspecs with
+ [A.Tvoid] -> TVoid []
+ | [A.Tchar] -> TInt(IChar, [])
+ | [A.Tsigned; A.Tchar] -> TInt(ISChar, [])
+ | [A.Tunsigned; A.Tchar] -> TInt(IUChar, [])
+
+ | [A.Tshort] -> TInt(IShort, [])
+ | [A.Tsigned; A.Tshort] -> TInt(IShort, [])
+ | [A.Tshort; A.Tint] -> TInt(IShort, [])
+ | [A.Tsigned; A.Tshort; A.Tint] -> TInt(IShort, [])
+
+ | [A.Tunsigned; A.Tshort] -> TInt(IUShort, [])
+ | [A.Tunsigned; A.Tshort; A.Tint] -> TInt(IUShort, [])
+
+ | [] -> TInt(IInt, [])
+ | [A.Tint] -> TInt(IInt, [])
+ | [A.Tsigned] -> TInt(IInt, [])
+ | [A.Tsigned; A.Tint] -> TInt(IInt, [])
+
+ | [A.Tunsigned] -> TInt(IUInt, [])
+ | [A.Tunsigned; A.Tint] -> TInt(IUInt, [])
+
+ | [A.Tlong] -> TInt(ILong, [])
+ | [A.Tsigned; A.Tlong] -> TInt(ILong, [])
+ | [A.Tlong; A.Tint] -> TInt(ILong, [])
+ | [A.Tsigned; A.Tlong; A.Tint] -> TInt(ILong, [])
+
+ | [A.Tunsigned; A.Tlong] -> TInt(IULong, [])
+ | [A.Tunsigned; A.Tlong; A.Tint] -> TInt(IULong, [])
+
+ | [A.Tlong; A.Tlong] -> TInt(ILongLong, [])
+ | [A.Tsigned; A.Tlong; A.Tlong] -> TInt(ILongLong, [])
+ | [A.Tlong; A.Tlong; A.Tint] -> TInt(ILongLong, [])
+ | [A.Tsigned; A.Tlong; A.Tlong; A.Tint] -> TInt(ILongLong, [])
+
+ | [A.Tunsigned; A.Tlong; A.Tlong] -> TInt(IULongLong, [])
+ | [A.Tunsigned; A.Tlong; A.Tlong; A.Tint] -> TInt(IULongLong, [])
+
+ (* int64 is to support MSVC *)
+ | [A.Tint64] -> TInt(ILongLong, [])
+ | [A.Tsigned; A.Tint64] -> TInt(ILongLong, [])
+
+ | [A.Tunsigned; A.Tint64] -> TInt(IULongLong, [])
+
+ | [A.Tfloat] -> TFloat(FFloat, [])
+ | [A.Tdouble] -> TFloat(FDouble, [])
+
+ | [A.Tlong; A.Tdouble] -> TFloat(FLongDouble, [])
+
+ (* Now the other type specifiers *)
+ | [A.Tnamed n] -> begin
+ if n = "__builtin_va_list" &&
+ Machdep.gccHas__builtin_va_list then begin
+ TBuiltin_va_list []
+ end else
+ let t =
+ match lookupType "type" n with
+ (TNamed _) as x, _ -> x
+ | typ -> E.s (error "Named type %s is not mapped correctly\n" n)
+ in
+ t
+ end
+
+ | [A.Tstruct (n, None, _)] -> (* A reference to a struct *)
+ if n = "" then E.s (error "Missing struct tag on incomplete struct");
+ findCompType "struct" n []
+ | [A.Tstruct (n, Some nglist, extraAttrs)] -> (* A definition of a struct *)
+ let n' =
+ if n <> "" then n else anonStructName "struct" suggestedAnonName in
+ (* Use the (non-cv, non-name) attributes in !attrs now *)
+ let a = extraAttrs @ (getTypeAttrs ()) in
+ makeCompType true n' nglist (doAttributes a)
+
+ | [A.Tunion (n, None, _)] -> (* A reference to a union *)
+ if n = "" then E.s (error "Missing union tag on incomplete union");
+ findCompType "union" n []
+ | [A.Tunion (n, Some nglist, extraAttrs)] -> (* A definition of a union *)
+ let n' =
+ if n <> "" then n else anonStructName "union" suggestedAnonName in
+ (* Use the attributes now *)
+ let a = extraAttrs @ (getTypeAttrs ()) in
+ makeCompType false n' nglist (doAttributes a)
+
+ | [A.Tenum (n, None, _)] -> (* Just a reference to an enum *)
+ if n = "" then E.s (error "Missing enum tag on incomplete enum");
+ findCompType "enum" n []
+
+ | [A.Tenum (n, Some eil, extraAttrs)] -> (* A definition of an enum *)
+ let n' =
+ if n <> "" then n else anonStructName "enum" suggestedAnonName in
+ (* make a new name for this enumeration *)
+ let n'', _ = newAlphaName true "enum" n' in
+
+ (* Create the enuminfo, or use one that was created already for a
+ * forward reference *)
+ let enum, _ = createEnumInfo n'' in
+ let a = extraAttrs @ (getTypeAttrs ()) in
+ enum.eattr <- doAttributes a;
+ let res = TEnum (enum, []) in
+
+ (* sm: start a scope for the enum tag values, since they *
+ * can refer to earlier tags *)
+ enterScope ();
+
+ (* as each name,value pair is determined, this is called *)
+ let rec processName kname (i: exp) loc rest = begin
+ (* add the name to the environment, but with a faked 'typ' field;
+ * we don't know the full type yet (since that includes all of the
+ * tag values), but we won't need them in here *)
+ addLocalToEnv kname (EnvEnum (i, res));
+
+ (* add this tag to the list so that it ends up in the real
+ * environment when we're finished *)
+ let newname, _ = newAlphaName true "" kname in
+
+ (kname, (newname, i, loc)) :: loop (increm i 1) rest
+ end
+
+ and loop i = function
+ [] -> []
+ | (kname, A.NOTHING, cloc) :: rest ->
+ (* use the passed-in 'i' as the value, since none specified *)
+ processName kname i (convLoc cloc) rest
+
+ | (kname, e, cloc) :: rest ->
+ (* constant-eval 'e' to determine tag value *)
+ let e' = getIntConstExp e in
+ let e' =
+ match isInteger (constFold true e') with
+ Some i -> if !lowerConstants then kinteger64 IInt i else e'
+ | _ -> E.s (error "Constant initializer %a not an integer" d_exp e')
+ in
+ processName kname e' (convLoc cloc) rest
+ in
+
+ (* sm: now throw away the environment we built for eval'ing the enum
+ * tags, so we can add to the new one properly *)
+ exitScope ();
+
+ let fields = loop zero eil in
+ (* Now set the right set of items *)
+ enum.eitems <- List.map (fun (_, x) -> x) fields;
+ (* Record the enum name in the environment *)
+ addLocalToEnv (kindPlusName "enum" n'') (EnvTyp res);
+ (* And define the tag *)
+ cabsPushGlobal (GEnumTag (enum, !currentLoc));
+ res
+
+
+ | [A.TtypeofE e] ->
+ let (c, e', t) = doExp false e AExpLeaveArrayFun in
+ let t' =
+ match e' with
+ StartOf(lv) -> typeOfLval lv
+ (* If this is a string literal, then we treat it as in sizeof*)
+ | Const (CStr s) -> begin
+ match typeOf e' with
+ TPtr(bt, _) -> (* This is the type of array elements *)
+ TArray(bt, Some (SizeOfStr s), [])
+ | _ -> E.s (bug "The typeOf a string is not a pointer type")
+ end
+ | _ -> t
+ in
+(*
+ ignore (E.log "typeof(%a) = %a\n" d_exp e' d_plaintype t');
+*)
+ t'
+
+ | [A.TtypeofT (specs, dt)] ->
+ let typ = doOnlyType specs dt in
+ typ
+
+ | _ ->
+ E.s (error "Invalid combination of type specifiers")
+ in
+ bt,!storage,!isinline,List.rev (!attrs @ (convertCVtoAttr !cvattrs))
+
+(* given some cv attributes, convert them into named attributes for
+ * uniform processing *)
+and convertCVtoAttr (src: A.cvspec list) : A.attribute list =
+ match src with
+ | [] -> []
+ | CV_CONST :: tl -> ("const",[]) :: (convertCVtoAttr tl)
+ | CV_VOLATILE :: tl -> ("volatile",[]) :: (convertCVtoAttr tl)
+ | CV_RESTRICT :: tl -> ("restrict",[]) :: (convertCVtoAttr tl)
+
+
+and makeVarInfoCabs
+ ~(isformal: bool)
+ ~(isglobal: bool)
+ (ldecl : location)
+ (bt, sto, inline, attrs)
+ (n,ndt,a)
+ : varinfo =
+ let vtype, nattr =
+ doType (AttrName false) bt (A.PARENTYPE(attrs, ndt, a)) in
+ if inline && not (isFunctionType vtype) then
+ ignore (error "inline for a non-function: %s" n);
+ let t =
+ if not isglobal && not isformal then begin
+ (* Sometimes we call this on the formal argument of a function with no
+ * arguments. Don't call stripConstLocalType in that case *)
+(* ignore (E.log "stripConstLocalType(%a) for %s\n" d_type vtype n); *)
+ stripConstLocalType vtype
+ end else
+ vtype
+ in
+ let vi = makeVarinfo isglobal n t in
+ vi.vstorage <- sto;
+ vi.vattr <- nattr;
+ vi.vdecl <- ldecl;
+
+ if false then
+ ignore (E.log "Created varinfo %s : %a\n" vi.vname d_type vi.vtype);
+
+ vi
+
+(* Process a local variable declaration and allow variable-sized arrays *)
+and makeVarSizeVarInfo (ldecl : location)
+ spec_res
+ (n,ndt,a)
+ : varinfo * chunk * exp * bool =
+ if not !msvcMode then
+ match isVariableSizedArray ndt with
+ None ->
+ makeVarInfoCabs ~isformal:false
+ ~isglobal:false
+ ldecl spec_res (n,ndt,a), empty, zero, false
+ | Some (ndt', se, len) ->
+ makeVarInfoCabs ~isformal:false
+ ~isglobal:false
+ ldecl spec_res (n,ndt',a), se, len, true
+ else
+ makeVarInfoCabs ~isformal:false
+ ~isglobal:false
+ ldecl spec_res (n,ndt,a), empty, zero, false
+
+and doAttr (a: A.attribute) : attribute list =
+ (* Strip the leading and trailing underscore *)
+ let stripUnderscore (n: string) : string =
+ let l = String.length n in
+ let rec start i =
+ if i >= l then
+ E.s (error "Invalid attribute name %s" n);
+ if String.get n i = '_' then start (i + 1) else i
+ in
+ let st = start 0 in
+ let rec finish i =
+ (* We know that we will stop at >= st >= 0 *)
+ if String.get n i = '_' then finish (i - 1) else i
+ in
+ let fin = finish (l - 1) in
+ String.sub n st (fin - st + 1)
+ in
+ match a with
+ | (s, []) -> [Attr (stripUnderscore s, [])]
+ | (s, el) ->
+
+ let rec attrOfExp (strip: bool)
+ ?(foldenum=true)
+ (a: A.expression) : attrparam =
+ match a with
+ A.VARIABLE n -> begin
+ let n' = if strip then stripUnderscore n else n in
+ (** See if this is an enumeration *)
+ try
+ if not foldenum then raise Not_found;
+
+ match H.find env n' with
+ EnvEnum (tag, _), _ -> begin
+ match isInteger (constFold true tag) with
+ Some i64 when !lowerConstants -> AInt (Int64.to_int i64)
+ | _ -> ACons(n', [])
+ end
+ | _ -> ACons (n', [])
+ with Not_found -> ACons(n', [])
+ end
+ | A.CONSTANT (A.CONST_STRING s) -> AStr s
+ | A.CONSTANT (A.CONST_INT str) -> AInt (int_of_string str)
+ | A.CALL(A.VARIABLE n, args) -> begin
+ let n' = if strip then stripUnderscore n else n in
+ let ae' = List.map ae args in
+ ACons(n', ae')
+ end
+ | A.EXPR_SIZEOF e -> ASizeOfE (ae e)
+ | A.TYPE_SIZEOF (bt, dt) -> ASizeOf (doOnlyType bt dt)
+ | A.EXPR_ALIGNOF e -> AAlignOfE (ae e)
+ | A.TYPE_ALIGNOF (bt, dt) -> AAlignOf (doOnlyType bt dt)
+ | A.BINARY(A.AND, aa1, aa2) ->
+ ABinOp(LAnd, ae aa1, ae aa2)
+ | A.BINARY(A.OR, aa1, aa2) ->
+ ABinOp(LOr, ae aa1, ae aa2)
+ | A.BINARY(abop, aa1, aa2) ->
+ ABinOp (convBinOp abop, ae aa1, ae aa2)
+ | A.UNARY(A.PLUS, aa) -> ae aa
+ | A.UNARY(A.MINUS, aa) -> AUnOp (Neg, ae aa)
+ | A.UNARY(A.BNOT, aa) -> AUnOp(BNot, ae aa)
+ | A.UNARY(A.NOT, aa) -> AUnOp(LNot, ae aa)
+ | A.MEMBEROF (e, s) -> ADot (ae e, s)
+ | _ ->
+ ignore (E.log "Invalid expression in attribute: ");
+ withCprint Cprint.print_expression a;
+ E.s (error "cabs2cil: invalid expression")
+
+ and ae (e: A.expression) = attrOfExp false e in
+
+ (* Sometimes we need to convert attrarg into attr *)
+ let arg2attr = function
+ | ACons (s, args) -> Attr (s, args)
+ | a ->
+ E.s (error "Invalid form of attribute: %a"
+ d_attrparam a);
+ in
+ if s = "__attribute__" then (* Just a wrapper for many attributes*)
+ List.map (fun e -> arg2attr (attrOfExp true ~foldenum:false e)) el
+ else if s = "__blockattribute__" then (* Another wrapper *)
+ List.map (fun e -> arg2attr (attrOfExp true ~foldenum:false e)) el
+ else if s = "__declspec" then
+ List.map (fun e -> arg2attr (attrOfExp false ~foldenum:false e)) el
+ else
+ [Attr(stripUnderscore s, List.map (attrOfExp ~foldenum:false false) el)]
+
+and doAttributes (al: A.attribute list) : attribute list =
+ List.fold_left (fun acc a -> cabsAddAttributes (doAttr a) acc) [] al
+
+(* A version of Cil.partitionAttributes that works on CABS attributes.
+ It would be better to use Cil.partitionAttributes instead to avoid
+ the extra doAttr conversions here, but that's hard to do in doSpecList.*)
+and cabsPartitionAttributes
+ ~(default:attributeClass)
+ (attrs: A.attribute list) :
+ A.attribute list * A.attribute list * A.attribute list =
+ let rec loop (n,f,t) = function
+ [] -> n, f, t
+ | a :: rest ->
+ let kind = match doAttr a with
+ [] -> default
+ | Attr(an, _)::_ ->
+ (try H.find attributeHash an with Not_found -> default)
+ in
+ match kind with
+ AttrName _ -> loop (a::n, f, t) rest
+ | AttrFunType _ ->
+ loop (n, a::f, t) rest
+ | AttrType -> loop (n, f, a::t) rest
+ in
+ loop ([], [], []) attrs
+
+
+
+and doType (nameortype: attributeClass) (* This is AttrName if we are doing
+ * the type for a name, or AttrType
+ * if we are doing this type in a
+ * typedef *)
+ (bt: typ) (* The base type *)
+ (dt: A.decl_type)
+ (* Returns the new type and the accumulated name (or type attribute
+ if nameoftype = AttrType) attributes *)
+ : typ * attribute list =
+
+ (* Now do the declarator type. But remember that the structure of the
+ * declarator type is as printed, meaning that it is the reverse of the
+ * right one *)
+ let rec doDeclType (bt: typ) (acc: attribute list) = function
+ A.JUSTBASE -> bt, acc
+ | A.PARENTYPE (a1, d, a2) ->
+ let a1' = doAttributes a1 in
+ let a1n, a1f, a1t = partitionAttributes AttrType a1' in
+ let a2' = doAttributes a2 in
+ let a2n, a2f, a2t = partitionAttributes nameortype a2' in
+(*
+ ignore (E.log "doType: %a @[a1n=%a@!a1f=%a@!a1t=%a@!a2n=%a@!a2f=%a@!a2t=%a@]@!" d_loc !currentLoc d_attrlist a1n d_attrlist a1f d_attrlist a1t d_attrlist a2n d_attrlist a2f d_attrlist a2t);
+*)
+ let bt' = cabsTypeAddAttributes a1t bt in
+(*
+ ignore (E.log "bt' = %a\n" d_type bt');
+*)
+ let bt'', a1fadded =
+ match unrollType bt with
+ TFun _ -> cabsTypeAddAttributes a1f bt', true
+ | _ -> bt', false
+ in
+ (* Now recurse *)
+ let restyp, nattr = doDeclType bt'' acc d in
+ (* Add some more type attributes *)
+ let restyp = cabsTypeAddAttributes a2t restyp in
+ (* See if we can add some more type attributes *)
+ let restyp' =
+ match unrollType restyp with
+ TFun _ ->
+ if a1fadded then
+ cabsTypeAddAttributes a2f restyp
+ else
+ cabsTypeAddAttributes a2f
+ (cabsTypeAddAttributes a1f restyp)
+ | TPtr ((TFun _ as tf), ap) when not !msvcMode ->
+ if a1fadded then
+ TPtr(cabsTypeAddAttributes a2f tf, ap)
+ else
+ TPtr(cabsTypeAddAttributes a2f
+ (cabsTypeAddAttributes a1f tf), ap)
+ | _ ->
+ if a1f <> [] && not a1fadded then
+ E.s (error "Invalid position for (prefix) function type attributes:%a"
+ d_attrlist a1f);
+ if a2f <> [] then
+ E.s (error "Invalid position for (post) function type attributes:%a"
+ d_attrlist a2f);
+ restyp
+ in
+(*
+ ignore (E.log "restyp' = %a\n" d_type restyp');
+*)
+ (* Now add the name attributes and return *)
+ restyp', cabsAddAttributes a1n (cabsAddAttributes a2n nattr)
+
+ | A.PTR (al, d) ->
+ let al' = doAttributes al in
+ let an, af, at = partitionAttributes AttrType al' in
+ (* Now recurse *)
+ let restyp, nattr = doDeclType (TPtr(bt, at)) acc d in
+ (* See if we can do anything with function type attributes *)
+ let restyp' =
+ match unrollType restyp with
+ TFun _ -> cabsTypeAddAttributes af restyp
+ | TPtr((TFun _ as tf), ap) ->
+ TPtr(cabsTypeAddAttributes af tf, ap)
+ | _ ->
+ if af <> [] then
+ E.s (error "Invalid position for function type attributes:%a"
+ d_attrlist af);
+ restyp
+ in
+ (* Now add the name attributes and return *)
+ restyp', cabsAddAttributes an nattr
+
+
+ | A.ARRAY (d, al, len) ->
+ let lo =
+ match len with
+ A.NOTHING -> None
+ | _ ->
+ let len' = doPureExp len in
+ let _, len'' = castTo (typeOf len') intType len' in
+ let elsz =
+ try (bitsSizeOf bt + 7) / 8
+ with _ -> 1 (** We get this if we cannot compute the size of
+ * one element. This can happen, when we define
+ * an extern, for example. We use 1 for now *)
+ in
+ (match constFold true len' with
+ Const(CInt64(i, _, _)) ->
+ if i < 0L then
+ E.s (error "Length of array is negative\n");
+ if Int64.mul i (Int64.of_int elsz) >= 0x80000000L then
+ E.s (error "Length of array is too large\n")
+
+
+ | l ->
+ if isConstant l then
+ (* e.g., there may be a float constant involved.
+ * We'll leave it to the user to ensure the length is
+ * non-negative, etc.*)
+ ignore(warn "Unable to do constant-folding on array length %a. Some CIL operations on this array may fail."
+ d_exp l)
+ else
+ E.s (error "Length of array is not a constant: %a\n"
+ d_exp l));
+ Some len''
+ in
+ let al' = doAttributes al in
+ doDeclType (TArray(bt, lo, al')) acc d
+
+ | A.PROTO (d, args, isva) ->
+ (* Start a scope for the parameter names *)
+ enterScope ();
+ (* Intercept the old-style use of varargs.h. On GCC this means that
+ * we have ellipsis and a last argument "builtin_va_alist:
+ * builtin_va_alist_t". On MSVC we do not have the ellipsis and we
+ * have a last argument "va_alist: va_list" *)
+ let args', isva' =
+ if args != [] && !msvcMode = not isva then begin
+ let newisva = ref isva in
+ let rec doLast = function
+ [([A.SpecType (A.Tnamed atn)], (an, A.JUSTBASE, [], _))]
+ when isOldStyleVarArgTypeName atn &&
+ isOldStyleVarArgName an -> begin
+ (* Turn it into a vararg *)
+ newisva := true;
+ (* And forget about this argument *)
+ []
+ end
+
+ | a :: rest -> a :: doLast rest
+ | [] -> []
+ in
+ let args' = doLast args in
+ (args', !newisva)
+ end else (args, isva)
+ in
+ (* Make the argument as for a formal *)
+ let doOneArg (s, (n, ndt, a, cloc)) : varinfo =
+ let s' = doSpecList n s in
+ let ndt' = match isVariableSizedArray ndt with
+ None -> ndt
+ | Some (ndt', se, len) ->
+ (* If this is a variable-sized array, we replace the array
+ type with a pointer type. This is the defined behavior
+ for array parameters, so we do not need to add this to
+ varSizeArrays, fix sizeofs, etc. *)
+ if isNotEmpty se then
+ E.s (error "array parameter: length not pure");
+ ndt'
+ in
+ let vi = makeVarInfoCabs ~isformal:true ~isglobal:false
+ (convLoc cloc) s' (n,ndt',a) in
+ (* Add the formal to the environment, so it can be referenced by
+ other formals (e.g. in an array type, although that will be
+ changed to a pointer later, or though typeof). *)
+ addLocalToEnv vi.vname (EnvVar vi);
+ vi
+ in
+ let targs : varinfo list option =
+ match List.map doOneArg args' with
+ | [] -> None (* No argument list *)
+ | [t] when isVoidType t.vtype ->
+ Some []
+ | l -> Some l
+ in
+ exitScope ();
+ (* Turn [] types into pointers in the arguments and the result type.
+ * Turn function types into pointers to respective. This simplifies
+ * our life a lot, and is what the standard requires. *)
+ let rec fixupArgumentTypes (argidx: int) (args: varinfo list) : unit =
+ match args with
+ [] -> ()
+ | a :: args' ->
+ (match unrollType a.vtype with
+ TArray(t,_,attr) -> a.vtype <- TPtr(t, attr)
+ | TFun _ -> a.vtype <- TPtr(a.vtype, [])
+ | TComp (comp, _) -> begin
+ match isTransparentUnion a.vtype with
+ None -> ()
+ | Some fstfield ->
+ transparentUnionArgs :=
+ (argidx, a.vtype) :: !transparentUnionArgs;
+ a.vtype <- fstfield.ftype;
+ end
+ | _ -> ());
+ fixupArgumentTypes (argidx + 1) args'
+ in
+ let args =
+ match targs with
+ None -> None
+ | Some argl ->
+ fixupArgumentTypes 0 argl;
+ Some (List.map (fun a -> (a.vname, a.vtype, a.vattr)) argl)
+ in
+ let tres =
+ match unrollType bt with
+ TArray(t,_,attr) -> TPtr(t, attr)
+ | _ -> bt
+ in
+ doDeclType (TFun (tres, args, isva', [])) acc d
+
+ in
+ doDeclType bt [] dt
+
+(* If this is a declarator for a variable size array then turn it into a
+ pointer type and a length *)
+and isVariableSizedArray (dt: A.decl_type)
+ : (A.decl_type * chunk * exp) option =
+ let res = ref None in
+ let rec findArray = function
+ ARRAY (JUSTBASE, al, lo) when lo != A.NOTHING ->
+ (* Try to compile the expression to a constant *)
+ let (se, e', _) = doExp true lo (AExp (Some intType)) in
+ if isNotEmpty se || not (isConstant e') then begin
+ res := Some (se, e');
+ PTR (al, JUSTBASE)
+ end else
+ ARRAY (JUSTBASE, al, lo)
+ | ARRAY (dt, al, lo) -> ARRAY (findArray dt, al, lo)
+ | PTR (al, dt) -> PTR (al, findArray dt)
+ | JUSTBASE -> JUSTBASE
+ | PARENTYPE (prea, dt, posta) -> PARENTYPE (prea, findArray dt, posta)
+ | PROTO (dt, f, a) -> PROTO (findArray dt, f, a)
+ in
+ let dt' = findArray dt in
+ match !res with
+ None -> None
+ | Some (se, e) -> Some (dt', se, e)
+
+and doOnlyType (specs: A.spec_elem list) (dt: A.decl_type) : typ =
+ let bt',sto,inl,attrs = doSpecList "" specs in
+ if sto <> NoStorage || inl then
+ E.s (error "Storage or inline specifier in type only");
+ let tres, nattr = doType AttrType bt' (A.PARENTYPE(attrs, dt, [])) in
+ if nattr <> [] then
+ E.s (error "Name attributes in only_type: %a"
+ d_attrlist nattr);
+ tres
+
+
+and makeCompType (isstruct: bool)
+ (n: string)
+ (nglist: A.field_group list)
+ (a: attribute list) =
+ (* Make a new name for the structure *)
+ let kind = if isstruct then "struct" else "union" in
+ let n', _ = newAlphaName true kind n in
+ (* Create the self cell for use in fields and forward references. Or maybe
+ * one exists already from a forward reference *)
+ let comp, _ = createCompInfo isstruct n' in
+ let doFieldGroup ((s: A.spec_elem list),
+ (nl: (A.name * A.expression option) list)) : 'a list =
+ (* Do the specifiers exactly once *)
+ let sugg = match nl with
+ [] -> ""
+ | ((n, _, _, _), _) :: _ -> n
+ in
+ let bt, sto, inl, attrs = doSpecList sugg s in
+ (* Do the fields *)
+ let makeFieldInfo
+ (((n,ndt,a,cloc) : A.name), (widtho : A.expression option))
+ : fieldinfo =
+ if sto <> NoStorage || inl then
+ E.s (error "Storage or inline not allowed for fields");
+ let ftype, nattr =
+ doType (AttrName false) bt (A.PARENTYPE(attrs, ndt, a)) in
+ (* check for fields whose type is an undefined struct. This rules
+ out circularity:
+ struct C1 { struct C2 c2; }; //This line is now an error.
+ struct C2 { struct C1 c1; int dummy; };
+ *)
+ (match unrollType ftype with
+ TComp (ci',_) when not ci'.cdefined ->
+ E.s (error "Type of field %s is an undefined struct.\n" n)
+ | _ -> ());
+ let width =
+ match widtho with
+ None -> None
+ | Some w -> begin
+ (match unrollType ftype with
+ TInt (ikind, a) -> ()
+ | TEnum _ -> ()
+ | _ -> E.s (error "Base type for bitfield is not an integer type"));
+ match isIntegerConstant w with
+ Some n -> Some n
+ | None -> E.s (error "bitfield width is not an integer constant")
+ end
+ in
+ (* If the field is unnamed and its type is a structure of union type
+ * then give it a distinguished name *)
+ let n' =
+ if n = missingFieldName then begin
+ match unrollType ftype with
+ TComp _ -> begin
+ incr annonCompFieldNameId;
+ annonCompFieldName ^ (string_of_int !annonCompFieldNameId)
+ end
+ | _ -> n
+ end else
+ n
+ in
+ { fcomp = comp;
+ fname = n';
+ ftype = ftype;
+ fbitfield = width;
+ fattr = nattr;
+ floc = convLoc cloc
+ }
+ in
+ List.map makeFieldInfo nl
+ in
+
+
+ let flds = List.concat (List.map doFieldGroup nglist) in
+ if comp.cfields <> [] then begin
+ (* This appears to be a multiply defined structure. This can happen from
+ * a construct like "typedef struct foo { ... } A, B;". This is dangerous
+ * because at the time B is processed some forward references in { ... }
+ * appear as backward references, which coild lead to circularity in
+ * the type structure. We do a thourough check and then we reuse the type
+ * for A *)
+ let fieldsSig fs = List.map (fun f -> typeSig f.ftype) fs in
+ if not (Util.equals (fieldsSig comp.cfields) (fieldsSig flds)) then
+ ignore (error "%s seems to be multiply defined" (compFullName comp))
+ end else
+ comp.cfields <- flds;
+
+(* ignore (E.log "makeComp: %s: %a\n" comp.cname d_attrlist a); *)
+ comp.cattr <- a;
+ let res = TComp (comp, []) in
+ (* This compinfo is defined, even if there are no fields *)
+ comp.cdefined <- true;
+ (* Create a typedef for this one *)
+ cabsPushGlobal (GCompTag (comp, !currentLoc));
+
+ (* There must be a self cell created for this already *)
+ addLocalToEnv (kindPlusName kind n) (EnvTyp res);
+ (* Now create a typedef with just this type *)
+ res
+
+and preprocessCast (specs: A.specifier)
+ (dt: A.decl_type)
+ (ie: A.init_expression)
+ : A.specifier * A.decl_type * A.init_expression =
+ let typ = doOnlyType specs dt in
+ (* If we are casting to a union type then we have to treat this as a
+ * constructor expression. This is to handle the gcc extension that allows
+ * cast from a type of a field to the type of the union *)
+ let ie' =
+ match unrollType typ, ie with
+ TComp (c, _), A.SINGLE_INIT _ when not c.cstruct ->
+ A.COMPOUND_INIT [(A.INFIELD_INIT ("___matching_field",
+ A.NEXT_INIT),
+ ie)]
+ | _, _ -> ie
+ in
+ (* Maybe specs contains an unnamed composite. Replace with the name so that
+ * when we do again the specs we get the right name *)
+ let specs1 =
+ match typ with
+ TComp (ci, _) ->
+ List.map
+ (function
+ A.SpecType (A.Tstruct ("", flds, [])) ->
+ A.SpecType (A.Tstruct (ci.cname, None, []))
+ | A.SpecType (A.Tunion ("", flds, [])) ->
+ A.SpecType (A.Tunion (ci.cname, None, []))
+ | s -> s) specs
+ | _ -> specs
+ in
+ specs1, dt, ie'
+
+and getIntConstExp (aexp) : exp =
+ let c, e, _ = doExp true aexp (AExp None) in
+ if not (isEmpty c) then
+ E.s (error "Constant expression %a has effects" d_exp e);
+ match e with
+ (* first, filter for those Const exps that are integers *)
+ | Const (CInt64 _ ) -> e
+ | Const (CEnum _) -> e
+ | Const (CChr i) -> Const(charConstToInt i)
+
+ (* other Const expressions are not ok *)
+ | Const _ -> E.s (error "Expected integer constant and got %a" d_exp e)
+
+ (* now, anything else that 'doExp true' returned is ok (provided
+ that it didn't yield side effects); this includes, in particular,
+ the various sizeof and alignof expression kinds *)
+ | _ -> e
+
+(* this is like 'isIntConstExp', but retrieves the actual integer
+ * the expression denotes; I have not extended it to work with
+ * sizeof/alignof since (for CCured) we can't const-eval those,
+ * and it's not clear whether they can be bitfield width specifiers
+ * anyway (since that's where this function is used) *)
+and isIntegerConstant (aexp) : int option =
+ match doExp true aexp (AExp None) with
+ (c, e, _) when isEmpty c -> begin
+ match isInteger e with
+ Some i64 -> Some (Int64.to_int i64)
+ | _ -> None
+ end
+ | _ -> None
+
+ (* Process an expression and in the process do some type checking,
+ * extract the effects as separate statements *)
+and doExp (asconst: bool) (* This expression is used as a constant *)
+ (e: A.expression)
+ (what: expAction) : (chunk * exp * typ) =
+ (* A subexpression of array type is automatically turned into StartOf(e).
+ * Similarly an expression of function type is turned into AddrOf. So
+ * essentially doExp should never return things of type TFun or TArray *)
+ let processArrayFun e t =
+ match e, unrollType t with
+ (Lval(lv) | CastE(_, Lval lv)), TArray(tbase, _, a) ->
+ mkStartOfAndMark lv, TPtr(tbase, a)
+ | (Lval(lv) | CastE(_, Lval lv)), TFun _ ->
+ mkAddrOfAndMark lv, TPtr(t, [])
+ | _, (TArray _ | TFun _) ->
+ E.s (error "Array or function expression is not lval: %a@!"
+ d_plainexp e)
+ | _ -> e, t
+ in
+ (* Before we return we call finishExp *)
+ let finishExp ?(newWhat=what)
+ (se: chunk) (e: exp) (t: typ) : chunk * exp * typ =
+ match newWhat with
+ ADrop -> (se, e, t)
+ | AExpLeaveArrayFun ->
+ (se, e, t) (* It is important that we do not do "processArrayFun" in
+ * this case. We exploit this when we process the typeOf
+ * construct *)
+ | AExp _ ->
+ let (e', t') = processArrayFun e t in
+(*
+ ignore (E.log "finishExp: e'=%a, t'=%a\n"
+ d_exp e' d_type t');
+*)
+ (se, e', t')
+
+ | ASet (lv, lvt) -> begin
+ (* See if the set was done already *)
+ match e with
+ Lval(lv') when lv == lv' ->
+ (se, e, t)
+ | _ ->
+ let (e', t') = processArrayFun e t in
+ let (t'', e'') = castTo t' lvt e' in
+(*
+ ignore (E.log "finishExp: e = %a\n e'' = %a\n" d_plainexp e d_plainexp e'');
+*)
+ (se +++ (Set(lv, e'', !currentLoc)), e'', t'')
+ end
+ in
+ let rec findField (n: string) (fidlist: fieldinfo list) : offset =
+ (* Depth first search for the field. This appears to be what GCC does.
+ * MSVC checks that there are no ambiguous field names, so it does not
+ * matter how we search *)
+ let rec search = function
+ [] -> NoOffset (* Did not find *)
+ | fid :: rest when fid.fname = n -> Field(fid, NoOffset)
+ | fid :: rest when prefix annonCompFieldName fid.fname -> begin
+ match unrollType fid.ftype with
+ TComp (ci, _) ->
+ let off = search ci.cfields in
+ if off = NoOffset then
+ search rest (* Continue searching *)
+ else
+ Field (fid, off)
+ | _ -> E.s (bug "unnamed field type is not a struct/union")
+ end
+ | _ :: rest -> search rest
+ in
+ let off = search fidlist in
+ if off = NoOffset then
+ E.s (error "Cannot find field %s" n);
+ off
+ in
+ try
+ match e with
+ | A.NOTHING when what = ADrop -> finishExp empty (integer 0) intType
+ | A.NOTHING ->
+ let res = Const(CStr "exp_nothing") in
+ finishExp empty res (typeOf res)
+
+ (* Do the potential lvalues first *)
+ | A.VARIABLE n -> begin
+ (* Look up in the environment *)
+ try
+ let envdata = H.find env n in
+ match envdata with
+ EnvVar vi, _ ->
+ (* if isconst &&
+ not (isFunctionType vi.vtype) &&
+ not (isArrayType vi.vtype)then
+ E.s (error "variable appears in constant"); *)
+ finishExp empty (Lval(var vi)) vi.vtype
+ | EnvEnum (tag, typ), _ ->
+ if !Cil.lowerConstants then
+ finishExp empty tag typ
+ else begin
+ let ei =
+ match unrollType typ with
+ TEnum(ei, _) -> ei
+ | _ -> assert false
+ in
+ finishExp empty (Const (CEnum(tag, n, ei))) typ
+ end
+
+ | _ -> raise Not_found
+ with Not_found -> begin
+ if isOldStyleVarArgName n then
+ E.s (error "Cannot resolve variable %s. This could be a CIL bug due to the handling of old-style variable argument functions.\n" n)
+ else
+ E.s (error "Cannot resolve variable %s.\n" n)
+ end
+ end
+ | A.INDEX (e1, e2) -> begin
+ (* Recall that doExp turns arrays into StartOf pointers *)
+ let (se1, e1', t1) = doExp false e1 (AExp None) in
+ let (se2, e2', t2) = doExp false e2 (AExp None) in
+ let se = se1 @@ se2 in
+ let (e1'', t1, e2'', tresult) =
+ (* Either e1 or e2 can be the pointer *)
+ match unrollType t1, unrollType t2 with
+ TPtr(t1e,_), (TInt _|TEnum _) -> e1', t1, e2', t1e
+ | (TInt _|TEnum _), TPtr(t2e,_) -> e2', t2, e1', t2e
+ | _ ->
+ E.s (error
+ "Expecting a pointer type in index:@! t1=%a@!t2=%a@!"
+ d_plaintype t1 d_plaintype t2)
+ in
+ (* We have to distinguish the construction based on the type of e1'' *)
+ let res =
+ match e1'' with
+ StartOf array -> (* A real array indexing operation *)
+ addOffsetLval (Index(e2'', NoOffset)) array
+ | _ -> (* Turn into *(e1 + e2) *)
+ mkMem (BinOp(IndexPI, e1'', e2'', t1)) NoOffset
+ in
+ (* Do some optimization of StartOf *)
+ finishExp se (Lval res) tresult
+
+ end
+ | A.UNARY (A.MEMOF, e) ->
+ if asconst then
+ ignore (warn "MEMOF in constant");
+ let (se, e', t) = doExp false e (AExp None) in
+ let tresult =
+ match unrollType t with
+ | TPtr(te, _) -> te
+ | _ -> E.s (error "Expecting a pointer type in *. Got %a@!"
+ d_plaintype t)
+ in
+ finishExp se
+ (Lval (mkMem e' NoOffset))
+ tresult
+
+ (* e.str = (& e + off(str)). If e = (be + beoff) then e.str = (be
+ * + beoff + off(str)) *)
+ | A.MEMBEROF (e, str) ->
+ (* member of is actually allowed if we only take the address *)
+ (* if isconst then
+ E.s (error "MEMBEROF in constant"); *)
+ let (se, e', t') = doExp false e (AExp None) in
+ let lv =
+ match e' with
+ Lval x -> x
+ | CastE(_, Lval x) -> x
+ | _ -> E.s (error "Expected an lval in MEMBEROF (field %s)" str)
+ in
+ let field_offset =
+ match unrollType t' with
+ TComp (comp, _) -> findField str comp.cfields
+ | _ -> E.s (error "expecting a struct with field %s" str)
+ in
+ let lv' = Lval(addOffsetLval field_offset lv) in
+ let field_type = typeOf lv' in
+ finishExp se lv' field_type
+
+ (* e->str = * (e + off(str)) *)
+ | A.MEMBEROFPTR (e, str) ->
+ if asconst then
+ ignore (warn "MEMBEROFPTR in constant");
+ let (se, e', t') = doExp false e (AExp None) in
+ let pointedt =
+ match unrollType t' with
+ TPtr(t1, _) -> t1
+ | TArray(t1,_,_) -> t1
+ | _ -> E.s (error "expecting a pointer to a struct")
+ in
+ let field_offset =
+ match unrollType pointedt with
+ TComp (comp, _) -> findField str comp.cfields
+ | x ->
+ E.s (error
+ "expecting a struct with field %s. Found %a. t1 is %a"
+ str d_type x d_type t')
+ in
+ let lv' = Lval (mkMem e' field_offset) in
+ let field_type = typeOf lv' in
+ finishExp se lv' field_type
+
+ | A.CONSTANT ct -> begin
+ let hasSuffix str =
+ let l = String.length str in
+ fun s ->
+ let ls = String.length s in
+ l >= ls && s = String.uppercase (String.sub str (l - ls) ls)
+ in
+ match ct with
+ A.CONST_INT str -> begin
+ let res = parseInt str in
+ finishExp empty res (typeOf res)
+ end
+
+(*
+ | A.CONST_WSTRING wstr ->
+ let len = List.length wstr in
+ let wchar_t = !wcharType in
+ (* We will make an array big enough to contain the wide
+ * characters and the wide-null terminator *)
+ let ws_t = TArray(wchar_t, Some (integer len), []) in
+ let ws =
+ makeGlobalVar ("wide_string" ^ string_of_int !lastStructId)
+ ws_t
+ in
+ ws.vstorage <- Static;
+ incr lastStructId;
+ (* Make the initializer. Idx is a wide_char index. *)
+ let rec loop (idx: int) (s: int64 list) =
+ match s with
+ [] -> []
+ | wc::rest ->
+ let wc_cilexp = Const (CInt64(wc, IInt, None)) in
+ (Index(integer idx, NoOffset),
+ SingleInit (mkCast wc_cilexp wchar_t))
+ :: loop (idx + 1) rest
+ in
+ (* Add the definition for the array *)
+ cabsPushGlobal (GVar(ws,
+ {init = Some (CompoundInit(ws_t,
+ loop 0 wstr))},
+ !currentLoc));
+ finishExp empty (StartOf(Var ws, NoOffset))
+ (TPtr(wchar_t, []))
+ *)
+
+ | A.CONST_WSTRING (ws: int64 list) ->
+ let res = Const(CWStr ((* intlist_to_wstring *) ws)) in
+ finishExp empty res (typeOf res)
+
+ | A.CONST_STRING s ->
+ (* Maybe we burried __FUNCTION__ in there *)
+ let s' =
+ try
+ let start = String.index s (Char.chr 0) in
+ let l = String.length s in
+ let tofind = (String.make 1 (Char.chr 0)) ^ "__FUNCTION__" in
+ let past = start + String.length tofind in
+ if past <= l &&
+ String.sub s start (String.length tofind) = tofind then
+ (if start > 0 then String.sub s 0 start else "") ^
+ !currentFunctionFDEC.svar.vname ^
+ (if past < l then String.sub s past (l - past) else "")
+ else
+ s
+ with Not_found -> s
+ in
+ let res = Const(CStr s') in
+ finishExp empty res (typeOf res)
+
+ | A.CONST_CHAR char_list ->
+ let a, b = (interpret_character_constant char_list) in
+ finishExp empty (Const a) b
+
+ | A.CONST_WCHAR char_list ->
+ (* matth: I can't see a reason for a list of more than one char
+ * here, since the kinteger64 below will take only the lower 16
+ * bits of value. ('abc' makes sense, because CHAR constants have
+ * type int, and so more than one char may be needed to represent
+ * the value. But L'abc' has type wchar, and so is equivalent to
+ * L'c'). But gcc allows L'abc', so I'll leave this here in case
+ * I'm missing some architecture dependent behavior. *)
+ let value = reduce_multichar !wcharType char_list in
+ let result = kinteger64 !wcharKind value in
+ finishExp empty result (typeOf result)
+
+ | A.CONST_FLOAT str -> begin
+ (* Maybe it ends in U or UL. Strip those *)
+ let l = String.length str in
+ let hasSuffix = hasSuffix str in
+ let baseint, kind =
+ if hasSuffix "L" then
+ String.sub str 0 (l - 1), FLongDouble
+ else if hasSuffix "F" then
+ String.sub str 0 (l - 1), FFloat
+ else if hasSuffix "D" then
+ String.sub str 0 (l - 1), FDouble
+ else
+ str, FDouble
+ in
+ try
+ finishExp empty
+ (Const(CReal(float_of_string baseint, kind,
+ Some str)))
+ (TFloat(kind,[]))
+ with e -> begin
+ ignore (E.log "float_of_string %s (%s)\n" str
+ (Printexc.to_string e));
+ let res = Const(CStr "booo CONS_FLOAT") in
+ finishExp empty res (typeOf res)
+ end
+ end
+ end
+
+ | A.TYPE_SIZEOF (bt, dt) ->
+ let typ = doOnlyType bt dt in
+ finishExp empty (SizeOf(typ)) !typeOfSizeOf
+
+ (* Intercept the sizeof("string") *)
+ | A.EXPR_SIZEOF (A.CONSTANT (A.CONST_STRING s)) -> begin
+ (* Process the string first *)
+ match doExp asconst (A.CONSTANT (A.CONST_STRING s)) (AExp None) with
+ _, Const(CStr s), _ ->
+ finishExp empty (SizeOfStr s) !typeOfSizeOf
+ | _ -> E.s (bug "cabs2cil: sizeOfStr")
+ end
+
+ | A.EXPR_SIZEOF e ->
+ (* Allow non-constants in sizeof *)
+ (* Do not convert arrays and functions into pointers. *)
+ let (se, e', t) = doExp false e AExpLeaveArrayFun in
+(*
+ ignore (E.log "sizeof: %a e'=%a, t=%a\n"
+ d_loc !currentLoc d_plainexp e' d_type t);
+*)
+ (* !!!! The book says that the expression is not evaluated, so we
+ * drop the potential side-effects
+ if isNotEmpty se then
+ ignore (warn "Warning: Dropping side-effect in EXPR_SIZEOF\n");
+*)
+ let size =
+ match e' with (* If we are taking the sizeof an
+ * array we must drop the StartOf *)
+ StartOf(lv) -> SizeOfE (Lval(lv))
+
+ (* Maybe we are taking the sizeof for a CStr. In that case we
+ * mean the pointer to the start of the string *)
+ | Const(CStr _) -> SizeOf (charPtrType)
+
+ (* Maybe we are taking the sizeof a variable-sized array *)
+ | Lval (Var vi, NoOffset) -> begin
+ try
+ IH.find varSizeArrays vi.vid
+ with Not_found -> SizeOfE e'
+ end
+ | _ -> SizeOfE e'
+ in
+ finishExp empty size !typeOfSizeOf
+
+ | A.TYPE_ALIGNOF (bt, dt) ->
+ let typ = doOnlyType bt dt in
+ finishExp empty (AlignOf(typ)) !typeOfSizeOf
+
+ | A.EXPR_ALIGNOF e ->
+ let (se, e', t) = doExp false e AExpLeaveArrayFun in
+ (* !!!! The book says that the expression is not evaluated, so we
+ * drop the potential side-effects
+ if isNotEmpty se then
+ ignore (warn "Warning: Dropping side-effect in EXPR_ALIGNOF\n");
+*)
+ let e'' =
+ match e' with (* If we are taking the alignof an
+ * array we must drop the StartOf *)
+ StartOf(lv) -> Lval(lv)
+
+ | _ -> e'
+ in
+ finishExp empty (AlignOfE(e'')) !typeOfSizeOf
+
+ | A.CAST ((specs, dt), ie) ->
+ let s', dt', ie' = preprocessCast specs dt ie in
+ (* We know now that we can do s' and dt' many times *)
+ let typ = doOnlyType s' dt' in
+ let what' =
+ match what with
+ AExp (Some _) -> AExp (Some typ)
+ | AExp None -> what
+ | ADrop | AExpLeaveArrayFun -> what
+ | ASet (lv, lvt) ->
+ (* If the cast from typ to lvt would be dropped, then we
+ * continue with a Set *)
+ if false && Util.equals (typeSig typ) (typeSig lvt) then
+ what
+ else
+ AExp None (* We'll create a temporary *)
+ in
+ (* Remember here if we have done the Set *)
+ let (se, e', t'), (needcast: bool) =
+ match ie' with
+ A.SINGLE_INIT e -> doExp asconst e what', true
+
+ | A.NO_INIT -> E.s (error "missing expression in cast")
+
+ | A.COMPOUND_INIT _ -> begin
+ (* Pretend that we are declaring and initializing a brand new
+ * variable *)
+ let newvar = "__constr_expr_" ^ string_of_int (!constrExprId) in
+ incr constrExprId;
+ let spec_res = doSpecList "" s' in
+ let se1 =
+ if !scopes == [] then begin
+ ignore (createGlobal spec_res
+ ((newvar, dt', [], cabslu), ie'));
+ empty
+ end else
+ createLocal spec_res ((newvar, dt', [], cabslu), ie')
+ in
+ (* Now pretend that e is just a reference to the newly created
+ * variable *)
+ let se, e', t' = doExp asconst (A.VARIABLE newvar) what' in
+ (* If typ is an array then the doExp above has already added a
+ * StartOf. We must undo that now so that it is done once by
+ * the finishExp at the end of this case *)
+ let e2, t2 =
+ match unrollType typ, e' with
+ TArray _, StartOf lv -> Lval lv, typ
+ | _, _ -> e', t'
+ in
+ (* If we are here, then the type t2 is guaranteed to match the
+ * type of the expression e2, so we do not need a cast. We have
+ * to worry about this because otherwise, we might need to cast
+ * between arrays or structures. *)
+ (se1 @@ se, e2, t2), false
+ end
+ in
+ let (t'', e'') =
+ match typ with
+ TVoid _ when what' = ADrop -> (t', e') (* strange GNU thing *)
+ | _ ->
+ (* Do this to check the cast, unless we are sure that we do not
+ * need the check. *)
+ let newtyp, newexp =
+ if needcast then
+ castTo ~fromsource:true t' typ e'
+ else
+ t', e'
+ in
+ newtyp, newexp
+ in
+ finishExp se e'' t''
+
+ | A.UNARY(A.MINUS, e) ->
+ let (se, e', t) = doExp asconst e (AExp None) in
+ if isIntegralType t then
+ let tres = integralPromotion t in
+ let e'' =
+ match e' with
+ | Const(CInt64(i, ik, _)) -> kinteger64 ik (Int64.neg i)
+ | _ -> UnOp(Neg, mkCastT e' t tres, tres)
+ in
+ finishExp se e'' tres
+ else
+ if isArithmeticType t then
+ finishExp se (UnOp(Neg,e',t)) t
+ else
+ E.s (error "Unary - on a non-arithmetic type")
+
+ | A.UNARY(A.BNOT, e) ->
+ let (se, e', t) = doExp asconst e (AExp None) in
+ if isIntegralType t then
+ let tres = integralPromotion t in
+ let e'' = UnOp(BNot, mkCastT e' t tres, tres) in
+ finishExp se e'' tres
+ else
+ E.s (error "Unary ~ on a non-integral type")
+
+ | A.UNARY(A.PLUS, e) -> doExp asconst e what
+
+
+ | A.UNARY(A.ADDROF, e) -> begin
+ match e with
+ A.COMMA el -> (* GCC extension *)
+ doExp false
+ (A.COMMA (replaceLastInList el (fun e -> A.UNARY(A.ADDROF, e))))
+ what
+ | A.QUESTION (e1, e2, e3) -> (* GCC extension *)
+ doExp false
+ (A.QUESTION (e1, A.UNARY(A.ADDROF, e2), A.UNARY(A.ADDROF, e3)))
+ what
+ | A.VARIABLE s when
+ isOldStyleVarArgName s
+ && (match !currentFunctionFDEC.svar.vtype with
+ TFun(_, _, true, _) -> true | _ -> false) ->
+ (* We are in an old-style variable argument function and we are
+ * taking the address of the argument that was removed while
+ * processing the function type. We compute the address based on
+ * the address of the last real argument *)
+ if !msvcMode then begin
+ let rec getLast = function
+ [] -> E.s (unimp "old-style variable argument function without real arguments")
+ | [a] -> a
+ | _ :: rest -> getLast rest
+ in
+ let last = getLast !currentFunctionFDEC.sformals in
+ let res = mkAddrOfAndMark (var last) in
+ let tres = typeOf res in
+ let tres', res' = castTo tres (TInt(IULong, [])) res in
+ (* Now we must add to this address to point to the next
+ * argument. Round up to a multiple of 4 *)
+ let sizeOfLast =
+ (((bitsSizeOf last.vtype) + 31) / 32) * 4
+ in
+ let res'' =
+ BinOp(PlusA, res', kinteger IULong sizeOfLast, tres')
+ in
+ finishExp empty res'' tres'
+ end else begin (* On GCC the only reliable way to do this is to
+ * call builtin_next_arg. If we take the address of
+ * a local we are going to get the address of a copy
+ * of the local ! *)
+
+ doExp asconst
+ (A.CALL (A.VARIABLE "__builtin_next_arg",
+ [A.CONSTANT (A.CONST_INT "0")]))
+ what
+ end
+
+ | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
+ A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
+ A.CAST (_, A.COMPOUND_INIT _)) -> begin
+ let (se, e', t) = doExp false e (AExp None) in
+ (* ignore (E.log "ADDROF on %a : %a\n" d_plainexp e'
+ d_plaintype t); *)
+ match e' with
+ ( Lval x | CastE(_, Lval x)) ->
+ finishExp se (mkAddrOfAndMark x) (TPtr(t, []))
+
+ | StartOf (lv) ->
+ let tres = TPtr(typeOfLval lv, []) in (* pointer to array *)
+ finishExp se (mkAddrOfAndMark lv) tres
+
+ (* Function names are converted into pointers to the function.
+ * Taking the address-of again does not change things *)
+ | AddrOf (Var v, NoOffset) when isFunctionType v.vtype ->
+ finishExp se e' t
+
+ | _ -> E.s (error "Expected lval for ADDROF. Got %a@!"
+ d_plainexp e')
+ end
+ | _ -> E.s (error "Unexpected operand for addrof")
+ end
+ | A.UNARY((A.PREINCR|A.PREDECR) as uop, e) -> begin
+ match e with
+ A.COMMA el -> (* GCC extension *)
+ doExp asconst
+ (A.COMMA (replaceLastInList el
+ (fun e -> A.UNARY(uop, e))))
+ what
+ | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
+ doExp asconst
+ (A.QUESTION (e1, A.UNARY(uop, e2q),
+ A.UNARY(uop, e3q)))
+ what
+
+ | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
+ A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
+ A.CAST _ (* A GCC extension *)) -> begin
+ let uop' = if uop = A.PREINCR then PlusA else MinusA in
+ if asconst then
+ ignore (warn "PREINCR or PREDECR in constant");
+ let (se, e', t) = doExp false e (AExp None) in
+ let lv =
+ match e' with
+ Lval x -> x
+ | CastE (_, Lval x) -> x (* A GCC extension. The operation is
+ * done at the cast type. The result
+ * is also of the cast type *)
+ | _ -> E.s (error "Expected lval for ++ or --")
+ in
+ let tresult, result = doBinOp uop' e' t one intType in
+ finishExp (se +++ (Set(lv, mkCastT result tresult t,
+ !currentLoc)))
+ e'
+ tresult (* Should this be t instead ??? *)
+ end
+ | _ -> E.s (error "Unexpected operand for prefix -- or ++")
+ end
+
+ | A.UNARY((A.POSINCR|A.POSDECR) as uop, e) -> begin
+ match e with
+ A.COMMA el -> (* GCC extension *)
+ doExp asconst
+ (A.COMMA (replaceLastInList el
+ (fun e -> A.UNARY(uop, e))))
+ what
+ | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
+ doExp asconst
+ (A.QUESTION (e1, A.UNARY(uop, e2q), A.UNARY(uop, e3q)))
+ what
+
+ | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
+ A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
+ A.CAST _ (* A GCC extension *) ) -> begin
+ if asconst then
+ ignore (warn "POSTINCR or POSTDECR in constant");
+ (* If we do not drop the result then we must save the value *)
+ let uop' = if uop = A.POSINCR then PlusA else MinusA in
+ let (se, e', t) = doExp false e (AExp None) in
+ let lv =
+ match e' with
+ Lval x -> x
+ | CastE (_, Lval x) -> x (* GCC extension. The addition must
+ * be be done at the cast type. The
+ * result of this is also of the cast
+ * type *)
+ | _ -> E.s (error "Expected lval for ++ or --")
+ in
+ let tresult, opresult = doBinOp uop' e' t one intType in
+ let se', result =
+ if what <> ADrop then
+ let tmp = newTempVar t in
+ se +++ (Set(var tmp, e', !currentLoc)), Lval(var tmp)
+ else
+ se, e'
+ in
+ finishExp
+ (se' +++ (Set(lv, mkCastT opresult tresult t,
+ !currentLoc)))
+ result
+ tresult (* Should this be t instead ??? *)
+ end
+ | _ -> E.s (error "Unexpected operand for suffix ++ or --")
+ end
+
+ | A.BINARY(A.ASSIGN, e1, e2) -> begin
+ match e1 with
+ A.COMMA el -> (* GCC extension *)
+ doExp asconst
+ (A.COMMA (replaceLastInList el
+ (fun e -> A.BINARY(A.ASSIGN, e, e2))))
+ what
+ | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
+ doExp asconst
+ (A.QUESTION (e1, A.BINARY(A.ASSIGN, e2q, e2),
+ A.BINARY(A.ASSIGN, e3q, e2)))
+ what
+ | A.CAST (t, A.SINGLE_INIT e) -> (* GCC extension *)
+ doExp asconst
+ (A.CAST (t,
+ A.SINGLE_INIT (A.BINARY(A.ASSIGN, e,
+ A.CAST (t, A.SINGLE_INIT e2)))))
+ what
+
+ | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
+ A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ ) -> begin
+ if asconst then ignore (warn "ASSIGN in constant");
+ let (se1, e1', lvt) = doExp false e1 (AExp None) in
+ let lv =
+ match e1' with
+ Lval x -> x
+ | _ -> E.s (error "Expected lval for assignment. Got %a\n"
+ d_plainexp e1')
+ in
+ let (se2, e'', t'') = doExp false e2 (ASet(lv, lvt)) in
+ finishExp (se1 @@ se2) e1' lvt
+ end
+ | _ -> E.s (error "Invalid left operand for ASSIGN")
+ end
+
+ | A.BINARY((A.ADD|A.SUB|A.MUL|A.DIV|A.MOD|A.BAND|A.BOR|A.XOR|
+ A.SHL|A.SHR|A.EQ|A.NE|A.LT|A.GT|A.GE|A.LE) as bop, e1, e2) ->
+ let bop' = convBinOp bop in
+ let (se1, e1', t1) = doExp asconst e1 (AExp None) in
+ let (se2, e2', t2) = doExp asconst e2 (AExp None) in
+ let tresult, result = doBinOp bop' e1' t1 e2' t2 in
+ finishExp (se1 @@ se2) result tresult
+
+ (* assignment operators *)
+ | A.BINARY((A.ADD_ASSIGN|A.SUB_ASSIGN|A.MUL_ASSIGN|A.DIV_ASSIGN|
+ A.MOD_ASSIGN|A.BAND_ASSIGN|A.BOR_ASSIGN|A.SHL_ASSIGN|
+ A.SHR_ASSIGN|A.XOR_ASSIGN) as bop, e1, e2) -> begin
+ match e1 with
+ A.COMMA el -> (* GCC extension *)
+ doExp asconst
+ (A.COMMA (replaceLastInList el
+ (fun e -> A.BINARY(bop, e, e2))))
+ what
+ | A.QUESTION (e1, e2q, e3q) -> (* GCC extension *)
+ doExp asconst
+ (A.QUESTION (e1, A.BINARY(bop, e2q, e2),
+ A.BINARY(bop, e3q, e2)))
+ what
+
+ | (A.VARIABLE _ | A.UNARY (A.MEMOF, _) | (* Regular lvalues *)
+ A.INDEX _ | A.MEMBEROF _ | A.MEMBEROFPTR _ |
+ A.CAST _ (* GCC extension *) ) -> begin
+ if asconst then
+ ignore (warn "op_ASSIGN in constant");
+ let bop' = match bop with
+ A.ADD_ASSIGN -> PlusA
+ | A.SUB_ASSIGN -> MinusA
+ | A.MUL_ASSIGN -> Mult
+ | A.DIV_ASSIGN -> Div
+ | A.MOD_ASSIGN -> Mod
+ | A.BAND_ASSIGN -> BAnd
+ | A.BOR_ASSIGN -> BOr
+ | A.XOR_ASSIGN -> BXor
+ | A.SHL_ASSIGN -> Shiftlt
+ | A.SHR_ASSIGN -> Shiftrt
+ | _ -> E.s (error "binary +=")
+ in
+ let (se1, e1', t1) = doExp false e1 (AExp None) in
+ let lv1 =
+ match e1' with
+ Lval x -> x
+ | CastE (_, Lval x) -> x (* GCC extension. The operation and
+ * the result are at the cast type *)
+ | _ -> E.s (error "Expected lval for assignment with arith")
+ in
+ let (se2, e2', t2) = doExp false e2 (AExp None) in
+ let tresult, result = doBinOp bop' e1' t1 e2' t2 in
+ (* We must cast the result to the type of the lv1, which may be
+ * different than t1 if lv1 was a Cast *)
+ let _, result' = castTo tresult (typeOfLval lv1) result in
+ (* The type of the result is the type of the left-hand side *)
+ finishExp (se1 @@ se2 +++
+ (Set(lv1, result', !currentLoc)))
+ e1'
+ t1
+ end
+ | _ -> E.s (error "Unexpected left operand for assignment with arith")
+ end
+
+
+ | A.BINARY((A.AND|A.OR), _, _) | A.UNARY(A.NOT, _) -> begin
+ let ce = doCondExp asconst e in
+ (* We must normalize the result to 0 or 1 *)
+ match ce with
+ CEExp (se, ((Const _) as c)) ->
+ finishExp se (if isConstTrue c then one else zero) intType
+ | CEExp (se, (UnOp(LNot, _, _) as e)) ->
+ (* already normalized to 0 or 1 *)
+ finishExp se e intType
+ | CEExp (se, e) ->
+ let e' =
+ let te = typeOf e in
+ let _, zte = castTo intType te zero in
+ BinOp(Ne, e, zte, te)
+ in
+ finishExp se e' intType
+ | _ ->
+ let tmp = var (newTempVar intType) in
+ finishExp (compileCondExp ce
+ (empty +++ (Set(tmp, integer 1,
+ !currentLoc)))
+ (empty +++ (Set(tmp, integer 0,
+ !currentLoc))))
+ (Lval tmp)
+ intType
+ end
+
+ | A.CALL(f, args) ->
+ if asconst then
+ ignore (warn "CALL in constant");
+ let (sf, f', ft') =
+ match f with (* Treat the VARIABLE case separate
+ * becase we might be calling a
+ * function that does not have a
+ * prototype. In that case assume it
+ * takes INTs as arguments *)
+ A.VARIABLE n -> begin
+ try
+ let vi, _ = lookupVar n in
+ (empty, Lval(var vi), vi.vtype) (* Found. Do not use
+ * finishExp. Simulate what =
+ * AExp None *)
+ with Not_found -> begin
+ ignore (warnOpt "Calling function %s without prototype." n);
+ let ftype = TFun(intType, None, false,
+ [Attr("missingproto",[])]) in
+ (* Add a prototype to the environment *)
+ let proto, _ =
+ makeGlobalVarinfo false (makeGlobalVar n ftype) in
+ (* Make it EXTERN *)
+ proto.vstorage <- Extern;
+ IH.add noProtoFunctions proto.vid true;
+ (* Add it to the file as well *)
+ cabsPushGlobal (GVarDecl (proto, !currentLoc));
+ (empty, Lval(var proto), ftype)
+ end
+ end
+ | _ -> doExp false f (AExp None)
+ in
+ (* Get the result type and the argument types *)
+ let (resType, argTypes, isvar, f'') =
+ match unrollType ft' with
+ TFun(rt,at,isvar,a) -> (rt,at,isvar,f')
+ | TPtr (t, _) -> begin
+ match unrollType t with
+ TFun(rt,at,isvar,a) -> (* Make the function pointer
+ * explicit *)
+ let f'' =
+ match f' with
+ AddrOf lv -> Lval(lv)
+ | _ -> Lval(mkMem f' NoOffset)
+ in
+ (rt,at,isvar, f'')
+ | x ->
+ E.s (error "Unexpected type of the called function %a: %a"
+ d_exp f' d_type x)
+ end
+ | x -> E.s (error "Unexpected type of the called function %a: %a"
+ d_exp f' d_type x)
+ in
+ let argTypesList = argsToList argTypes in
+ (* Drop certain qualifiers from the result type *)
+ let resType' = resType in
+ (* Before we do the arguments we try to intercept a few builtins. For
+ * these we have defined then with a different type, so we do not
+ * want to give warnings. We'll just leave the arguments of these
+ * functions alone*)
+ let isSpecialBuiltin =
+ match f'' with
+ Lval (Var fv, NoOffset) ->
+ fv.vname = "__builtin_stdarg_start" ||
+ fv.vname = "__builtin_va_arg" ||
+ fv.vname = "__builtin_va_start" ||
+ fv.vname = "__builtin_expect" ||
+ fv.vname = "__builtin_next_arg"
+ | _ -> false
+ in
+
+ (** If the "--forceRLArgEval" flag was used, make sure
+ we evaluate args right-to-left.
+ Added by Nathan Cooprider. **)
+ let force_right_to_left_evaluation (c, e, t) =
+ (* If chunk is empty then it is not already evaluated *)
+ (* constants don't need to be pulled out *)
+ if (!forceRLArgEval && (not (isConstant e)) &&
+ (not isSpecialBuiltin)) then
+ (* create a temporary *)
+ let tmp = newTempVar t in
+ (* create an instruction to give the e to the temporary *)
+ let i = Set(var tmp, e, !currentLoc) in
+ (* add the instruction to the chunk *)
+ (* change the expression to be the temporary *)
+ (c +++ i, (Lval(var tmp)), t)
+ else
+ (c, e, t)
+ in
+ (* Do the arguments. In REVERSE order !!! Both GCC and MSVC do this *)
+ let rec loopArgs
+ : (string * typ * attributes) list * A.expression list
+ -> (chunk * exp list) = function
+ | ([], []) -> (empty, [])
+
+ | args, [] ->
+ if not isSpecialBuiltin then
+ ignore (warnOpt
+ "Too few arguments in call to %a."
+ d_exp f');
+ (empty, [])
+
+ | ((_, at, _) :: atypes, a :: args) ->
+ let (ss, args') = loopArgs (atypes, args) in
+ (* Do not cast as part of translating the argument. We let
+ * the castTo to do this work. This was necessary for
+ * test/small1/union5, in which a transparent union is passed
+ * as an argument *)
+ let (sa, a', att) = force_right_to_left_evaluation
+ (doExp false a (AExp None)) in
+ let (_, a'') = castTo att at a' in
+ (ss @@ sa, a'' :: args')
+
+ | ([], args) -> (* No more types *)
+ if not isvar && argTypes != None && not isSpecialBuiltin then
+ (* Do not give a warning for functions without a prototype*)
+ ignore (warnOpt "Too many arguments in call to %a" d_exp f');
+ let rec loop = function
+ [] -> (empty, [])
+ | a :: args ->
+ let (ss, args') = loop args in
+ let (sa, a', at) = force_right_to_left_evaluation
+ (doExp false a (AExp None)) in
+ (ss @@ sa, a' :: args')
+ in
+ loop args
+ in
+ let (sargs, args') = loopArgs (argTypesList, args) in
+ (* Setup some pointer to the elements of the call. We may change
+ * these below *)
+ let prechunk: chunk ref = ref (sf @@ sargs) in (* comes before *)
+
+ (* Do we actually have a call, or an expression? *)
+ let piscall: bool ref = ref true in
+
+ let pf: exp ref = ref f'' in (* function to call *)
+ let pargs: exp list ref = ref args' in (* arguments *)
+ let pis__builtin_va_arg: bool ref = ref false in
+ let pwhat: expAction ref = ref what in (* what to do with result *)
+
+ let pres: exp ref = ref zero in (* If we do not have a call, this is
+ * the result *)
+ let prestype: typ ref = ref intType in
+
+ let rec dropCasts = function CastE (_, e) -> dropCasts e | e -> e in
+ (* Get the name of the last formal *)
+ let getNameLastFormal () : string =
+ match !currentFunctionFDEC.svar.vtype with
+ TFun(_, Some args, true, _) -> begin
+ match List.rev args with
+ (last_par_name, _, _) :: _ -> last_par_name
+ | _ -> ""
+ end
+ | _ -> ""
+ in
+
+ (* Try to intercept some builtins *)
+ (match !pf with
+ Lval(Var fv, NoOffset) -> begin
+ if fv.vname = "__builtin_va_arg" then begin
+ match !pargs with
+ marker :: SizeOf resTyp :: _ -> begin
+ (* Make a variable of the desired type *)
+ let destlv, destlvtyp =
+ match !pwhat with
+ ASet (lv, lvt) -> lv, lvt
+ | _ -> var (newTempVar resTyp), resTyp
+ in
+ pwhat := (ASet (destlv, destlvtyp));
+ pargs := [marker; SizeOf resTyp; AddrOf destlv];
+ pis__builtin_va_arg := true;
+ end
+ | _ ->
+ ignore (warn "Invalid call to %s\n" fv.vname);
+ end else if fv.vname = "__builtin_stdarg_start" then begin
+ match !pargs with
+ marker :: last :: [] -> begin
+ let isOk =
+ match dropCasts last with
+ Lval (Var lastv, NoOffset) ->
+ lastv.vname = getNameLastFormal ()
+ | _ -> false
+ in
+ if not isOk then
+ ignore (warn "The second argument in call to %s should be the last formal argument\n" fv.vname);
+
+ (* Check that "lastv" is indeed the last variable in the
+ * prototype and then drop it *)
+ pargs := [ marker ]
+ end
+ | _ ->
+ ignore (warn "Invalid call to %s\n" fv.vname);
+
+ (* We have to turn uses of __builtin_varargs_start into uses
+ * of __builtin_stdarg_start (because we have dropped the
+ * __builtin_va_alist argument from this function) *)
+
+ end else if fv.vname = "__builtin_varargs_start" then begin
+ (* Lookup the prototype for the replacement *)
+ let v, _ =
+ try lookupGlobalVar "__builtin_stdarg_start"
+ with Not_found -> E.s (bug "Cannot find __builtin_stdarg_start to replace %s\n" fv.vname)
+ in
+ pf := Lval (var v)
+ end else if fv.vname = "__builtin_next_arg" then begin
+ match !pargs with
+ last :: [] -> begin
+ let isOk =
+ match dropCasts last with
+ Lval (Var lastv, NoOffset) ->
+ lastv.vname = getNameLastFormal ()
+ | _ -> false
+ in
+ if not isOk then
+ ignore (warn "The argument in call to %s should be the last formal argument\n" fv.vname);
+
+ pargs := [ ]
+ end
+ | _ ->
+ ignore (warn "Invalid call to %s\n" fv.vname);
+ end else if fv.vname = "__builtin_constant_p" then begin
+ (* Drop the side-effects *)
+ prechunk := empty;
+
+ (* Constant-fold the argument and see if it is a constant *)
+ (match !pargs with
+ [ arg ] -> begin
+ match constFold true arg with
+ Const _ -> piscall := false;
+ pres := integer 1;
+ prestype := intType
+
+ | _ -> piscall := false;
+ pres := integer 0;
+ prestype := intType
+ end
+ | _ ->
+ ignore (warn "Invalid call to builtin_constant_p"));
+ end
+ end
+ | _ -> ());
+
+
+ (* Now we must finish the call *)
+ if !piscall then begin
+ let addCall (calldest: lval option) (res: exp) (t: typ) =
+ prechunk := !prechunk +++
+ (Call(calldest, !pf, !pargs, !currentLoc));
+ pres := res;
+ prestype := t
+ in
+ match !pwhat with
+ ADrop -> addCall None zero intType
+
+ (* Set to a variable of corresponding type *)
+ | ASet(lv, vtype) ->
+ (* Make an exception here for __builtin_va_arg *)
+ if !pis__builtin_va_arg then
+ addCall None (Lval(lv)) vtype
+ else
+ addCall (Some lv) (Lval(lv)) vtype
+
+ | _ -> begin
+ let tmp, restyp' =
+ match !pwhat with
+ AExp (Some t) -> newTempVar t, t
+ | _ -> newTempVar resType', resType'
+ in
+ (* Remember that this variable has been created for this
+ * specific call. We will use this in collapseCallCast and
+ * above in finishCall. *)
+ IH.add callTempVars tmp.vid ();
+ addCall (Some (var tmp)) (Lval(var tmp)) restyp'
+ end
+ end;
+
+ finishExp !prechunk !pres !prestype
+
+
+ | A.COMMA el ->
+ if asconst then
+ ignore (warn "COMMA in constant");
+ let rec loop sofar = function
+ [e] ->
+ let (se, e', t') = doExp false e what in (* Pass on the action *)
+ (sofar @@ se, e', t')
+(*
+ finishExp (sofar @@ se) e' t' (* does not hurt to do it twice.
+ * GN: it seems it does *)
+*)
+ | e :: rest ->
+ let (se, _, _) = doExp false e ADrop in
+ loop (sofar @@ se) rest
+ | [] -> E.s (error "empty COMMA expression")
+ in
+ loop empty el
+
+ | A.QUESTION (e1,e2,e3) when what = ADrop ->
+ if asconst then
+ ignore (warn "QUESTION with ADrop in constant");
+ let (se3,_,_) = doExp false e3 ADrop in
+ let se2 =
+ match e2 with
+ A.NOTHING -> skipChunk
+ | _ -> let (se2,_,_) = doExp false e2 ADrop in se2
+ in
+ finishExp (doCondition asconst e1 se2 se3) zero intType
+
+ | A.QUESTION (e1, e2, e3) -> begin (* what is not ADrop *)
+ (* Compile the conditional expression *)
+ let ce1 = doCondExp asconst e1 in
+ (* Now we must find the type of both branches, in order to compute
+ * the type of the result *)
+ let se2, e2'o (* is an option. None means use e1 *), t2 =
+ match e2 with
+ A.NOTHING -> begin (* The same as the type of e1 *)
+ match ce1 with
+ CEExp (_, e1') -> empty, None, typeOf e1' (* Do not promote
+ to bool *)
+ | _ -> empty, None, intType
+ end
+ | _ ->
+ let se2, e2', t2 = doExp asconst e2 (AExp None) in
+ se2, Some e2', t2
+ in
+ (* Do e3 for real *)
+ let se3, e3', t3 = doExp asconst e3 (AExp None) in
+ (* Compute the type of the result *)
+ let tresult = conditionalConversion t2 t3 in
+ match ce1 with
+ CEExp (se1, e1') when isConstFalse e1' && canDrop se2 ->
+ finishExp (se1 @@ se3) (snd (castTo t3 tresult e3')) tresult
+ | CEExp (se1, e1') when isConstTrue e1' && canDrop se3 ->
+ begin
+ match e2'o with
+ None -> (* use e1' *)
+ finishExp (se1 @@ se2) (snd (castTo t2 tresult e1')) tresult
+ | Some e2' ->
+ finishExp (se1 @@ se2) (snd (castTo t2 tresult e2')) tresult
+ end
+
+ | _ -> (* Use a conditional *) begin
+ match e2 with
+ A.NOTHING ->
+ let tmp = var (newTempVar tresult) in
+ let (se1, _, _) = doExp asconst e1 (ASet(tmp, tresult)) in
+ let (se3, _, _) = doExp asconst e3 (ASet(tmp, tresult)) in
+ finishExp (se1 @@ ifChunk (Lval(tmp)) lu
+ skipChunk se3)
+ (Lval(tmp))
+ tresult
+ | _ ->
+ let lv, lvt =
+ match what with
+ | ASet (lv, lvt) -> lv, lvt
+ | _ ->
+ let tmp = newTempVar tresult in
+ var tmp, tresult
+ in
+ (* Now do e2 and e3 for real *)
+ let (se2, _, _) = doExp asconst e2 (ASet(lv, lvt)) in
+ let (se3, _, _) = doExp asconst e3 (ASet(lv, lvt)) in
+ finishExp (doCondition asconst e1 se2 se3) (Lval(lv)) tresult
+ end
+
+(*
+ (* Do these only to collect the types *)
+ let se2, e2', t2' =
+ match e2 with
+ A.NOTHING -> (* A GNU thing. Use e1 as e2 *)
+ doExp isconst e1 (AExp None)
+ | _ -> doExp isconst e2 (AExp None) in
+ (* Do e3 for real *)
+ let se3, e3', t3' = doExp isconst e3 (AExp None) in
+ (* Compute the type of the result *)
+ let tresult = conditionalConversion e2' t2' e3' t3' in
+ if (isEmpty se2 || e2 = A.NOTHING)
+ && isEmpty se3 && isconst then begin
+ (* Use the Question. This allows Question in initializers without
+ * having to do constant folding *)
+ let se1, e1', t1 = doExp isconst e1 (AExp None) in
+ ignore (checkBool t1 e1');
+ let e2'' =
+ if e2 = A.NOTHING then
+ mkCastT e1' t1 tresult
+ else mkCastT e2' t2' tresult (* We know se2 is empty *)
+ in
+ let e3'' = mkCastT e3' t3' tresult in
+ let resexp =
+ match e1' with
+ Const(CInt64(i, _, _)) when i <> Int64.zero -> e2''
+ | Const(CInt64(z, _, _)) when z = Int64.zero -> e3''
+ | _ -> Question(e1', e2'', e3'')
+ in
+ finishExp se1 resexp tresult
+ end else begin (* Now use a conditional *)
+ match e2 with
+ A.NOTHING ->
+ let tmp = var (newTempVar tresult) in
+ let (se1, _, _) = doExp isconst e1 (ASet(tmp, tresult)) in
+ let (se3, _, _) = doExp isconst e3 (ASet(tmp, tresult)) in
+ finishExp (se1 @@ ifChunk (Lval(tmp)) lu
+ skipChunk se3)
+ (Lval(tmp))
+ tresult
+ | _ ->
+ let lv, lvt =
+ match what with
+ | ASet (lv, lvt) -> lv, lvt
+ | _ ->
+ let tmp = newTempVar tresult in
+ var tmp, tresult
+ in
+ (* Now do e2 and e3 for real *)
+ let (se2, _, _) = doExp isconst e2 (ASet(lv, lvt)) in
+ let (se3, _, _) = doExp isconst e3 (ASet(lv, lvt)) in
+ finishExp (doCondition isconst e1 se2 se3) (Lval(lv)) tresult
+ end
+*)
+ end
+
+ | A.GNU_BODY b -> begin
+ (* Find the last A.COMPUTATION and remember it. This one is invoked
+ * on the reversed list of statements. *)
+ let rec findLastComputation = function
+ s :: _ ->
+ let rec findLast = function
+ A.SEQUENCE (_, s, loc) -> findLast s
+ | CASE (_, s, _) -> findLast s
+ | CASERANGE (_, _, s, _) -> findLast s
+ | LABEL (_, s, _) -> findLast s
+ | (A.COMPUTATION _) as s -> s
+ | _ -> raise Not_found
+ in
+ findLast s
+ | [] -> raise Not_found
+ in
+ (* Save the previous data *)
+ let old_gnu = ! gnu_body_result in
+ let lastComp, isvoidbody =
+ match what with
+ ADrop -> (* We are dropping the result *)
+ A.NOP cabslu, true
+ | _ ->
+ try findLastComputation (List.rev b.A.bstmts), false
+ with Not_found ->
+ E.s (error "Cannot find COMPUTATION in GNU.body")
+ (* A.NOP cabslu, true *)
+ in
+ (* Prepare some data to be filled by doExp *)
+ let data : (exp * typ) option ref = ref None in
+ gnu_body_result := (lastComp, data);
+
+ let se = doBody b in
+
+ gnu_body_result := old_gnu;
+ match !data with
+ None when isvoidbody -> finishExp se zero voidType
+ | None -> E.s (bug "Cannot find COMPUTATION in GNU.body")
+ | Some (e, t) -> finishExp se e t
+ end
+
+ | A.LABELADDR l -> begin (* GCC's taking the address of a label *)
+ let l = lookupLabel l in (* To support locallly declared labels *)
+ let addrval =
+ try H.find gotoTargetHash l
+ with Not_found -> begin
+ let res = !gotoTargetNextAddr in
+ incr gotoTargetNextAddr;
+ H.add gotoTargetHash l res;
+ res
+ end
+ in
+ finishExp empty (mkCast (integer addrval) voidPtrType) voidPtrType
+ end
+
+ | A.EXPR_PATTERN _ -> E.s (E.bug "EXPR_PATTERN in cabs2cil input")
+
+ with e -> begin
+ ignore (E.log "error in doExp (%s)@!" (Printexc.to_string e));
+ E.hadErrors := true;
+ (i2c (dInstr (dprintf "booo_exp(%t)" d_thisloc) !currentLoc),
+ integer 0, intType)
+ end
+
+(* bop is always the arithmetic version. Change it to the appropriate pointer
+ * version if necessary *)
+and doBinOp (bop: binop) (e1: exp) (t1: typ) (e2: exp) (t2: typ) : typ * exp =
+ let doArithmetic () =
+ let tres = arithmeticConversion t1 t2 in
+ (* Keep the operator since it is arithmetic *)
+ tres,
+ optConstFoldBinOp false bop (mkCastT e1 t1 tres) (mkCastT e2 t2 tres) tres
+ in
+ let doArithmeticComp () =
+ let tres = arithmeticConversion t1 t2 in
+ (* Keep the operator since it is arithemtic *)
+ intType,
+ optConstFoldBinOp false bop
+ (mkCastT e1 t1 tres) (mkCastT e2 t2 tres) intType
+ in
+ let doIntegralArithmetic () =
+ let tres = unrollType (arithmeticConversion t1 t2) in
+ match tres with
+ TInt _ ->
+ tres,
+ optConstFoldBinOp false bop
+ (mkCastT e1 t1 tres) (mkCastT e2 t2 tres) tres
+ | _ -> E.s (error "%a operator on a non-integer type" d_binop bop)
+ in
+ let pointerComparison e1 t1 e2 t2 =
+ (* XL: Do not cast both sides -- what's the point? *)
+ intType,
+ optConstFoldBinOp false bop e1 e2 intType
+ in
+
+ match bop with
+ (Mult|Div) -> doArithmetic ()
+ | (Mod|BAnd|BOr|BXor) -> doIntegralArithmetic ()
+ | (Shiftlt|Shiftrt) -> (* ISO 6.5.7. Only integral promotions. The result
+ * has the same type as the left hand side *)
+ if !msvcMode then
+ (* MSVC has a bug. We duplicate it here *)
+ doIntegralArithmetic ()
+ else
+ let t1' = integralPromotion t1 in
+ let t2' = integralPromotion t2 in
+ t1',
+ optConstFoldBinOp false bop (mkCastT e1 t1 t1') (mkCastT e2 t2 t2') t1'
+
+ | (PlusA|MinusA)
+ when isArithmeticType t1 && isArithmeticType t2 -> doArithmetic ()
+ | (Eq|Ne|Lt|Le|Ge|Gt)
+ when isArithmeticType t1 && isArithmeticType t2 ->
+ doArithmeticComp ()
+ | PlusA when isPointerType t1 && isIntegralType t2 ->
+ t1,
+ optConstFoldBinOp false PlusPI e1
+ (mkCastT e2 t2 (integralPromotion t2)) t1
+ | PlusA when isIntegralType t1 && isPointerType t2 ->
+ t2,
+ optConstFoldBinOp false PlusPI e2
+ (mkCastT e1 t1 (integralPromotion t1)) t2
+ | MinusA when isPointerType t1 && isIntegralType t2 ->
+ t1,
+ optConstFoldBinOp false MinusPI e1
+ (mkCastT e2 t2 (integralPromotion t2)) t1
+ | MinusA when isPointerType t1 && isPointerType t2 ->
+ let commontype = t1 in
+ intType,
+ optConstFoldBinOp false MinusPP (mkCastT e1 t1 commontype)
+ (mkCastT e2 t2 commontype) intType
+ | (Le|Lt|Ge|Gt|Eq|Ne) when isPointerType t1 && isPointerType t2 ->
+ pointerComparison e1 t1 e2 t2
+ | (Eq|Ne) when isPointerType t1 && isZero e2 ->
+ pointerComparison e1 t1 (mkCastT zero !upointType t1) t1
+ | (Eq|Ne) when isPointerType t2 && isZero e1 ->
+ pointerComparison (mkCastT zero !upointType t2) t2 e2 t2
+
+
+ | (Eq|Ne|Le|Lt|Ge|Gt) when isPointerType t1 && isArithmeticType t2 ->
+ ignore (warnOpt "Comparison of pointer and non-pointer");
+ (* Cast both values to void * *)
+ doBinOp bop (mkCastT e1 t1 voidPtrType) voidPtrType
+ (mkCastT e2 t2 voidPtrType) voidPtrType
+ | (Eq|Ne|Le|Lt|Ge|Gt) when isArithmeticType t1 && isPointerType t2 ->
+ ignore (warnOpt "Comparison of pointer and non-pointer");
+ (* Cast both values to void * *)
+ doBinOp bop (mkCastT e1 t1 voidPtrType) voidPtrType
+ (mkCastT e2 t2 voidPtrType) voidPtrType
+
+ | _ -> E.s (error "doBinOp: %a\n" d_plainexp (BinOp(bop,e1,e2,intType)))
+
+(* Constant fold a conditional. This is because we want to avoid having
+ * conditionals in the initializers. So, we try very hard to avoid creating
+ * new statements. *)
+and doCondExp (asconst: bool) (** Try to evaluate the conditional expression
+ * to TRUE or FALSE, because it occurs in a
+ * constant *)
+ (e: A.expression) : condExpRes =
+ let rec addChunkBeforeCE (c0: chunk) = function
+ CEExp (c, e) -> CEExp (c0 @@ c, e)
+ | CEAnd (ce1, ce2) -> CEAnd (addChunkBeforeCE c0 ce1, ce2)
+ | CEOr (ce1, ce2) -> CEOr (addChunkBeforeCE c0 ce1, ce2)
+ | CENot ce1 -> CENot (addChunkBeforeCE c0 ce1)
+ in
+ let rec canDropCE = function
+ CEExp (c, e) -> canDrop c
+ | CEAnd (ce1, ce2) | CEOr (ce1, ce2) -> canDropCE ce1 && canDropCE ce2
+ | CENot (ce1) -> canDropCE ce1
+ in
+ match e with
+ A.BINARY (A.AND, e1, e2) -> begin
+ let ce1 = doCondExp asconst e1 in
+ let ce2 = doCondExp asconst e2 in
+ match ce1, ce2 with
+ CEExp (se1, ((Const _) as ci1)), _ ->
+ if isConstTrue ci1 then
+ addChunkBeforeCE se1 ce2
+ else
+ (* se2 might contain labels so we cannot always drop it *)
+ if canDropCE ce2 then
+ ce1
+ else
+ CEAnd (ce1, ce2)
+ | CEExp(se1, e1'), CEExp (se2, e2') when
+ !useLogicalOperators && isEmpty se1 && isEmpty se2 ->
+ CEExp (empty, BinOp(LAnd,
+ mkCast e1' intType,
+ mkCast e2' intType, intType))
+ | _ -> CEAnd (ce1, ce2)
+ end
+
+ | A.BINARY (A.OR, e1, e2) -> begin
+ let ce1 = doCondExp asconst e1 in
+ let ce2 = doCondExp asconst e2 in
+ match ce1, ce2 with
+ CEExp (se1, (Const(CInt64 _) as ci1)), _ ->
+ if isConstFalse ci1 then
+ addChunkBeforeCE se1 ce2
+ else
+ (* se2 might contain labels so we cannot drop it *)
+ if canDropCE ce2 then
+ ce1
+ else
+ CEOr (ce1, ce2)
+
+ | CEExp (se1, e1'), CEExp (se2, e2') when
+ !useLogicalOperators && isEmpty se1 && isEmpty se2 ->
+ CEExp (empty, BinOp(LOr, mkCast e1' intType,
+ mkCast e2' intType, intType))
+ | _ -> CEOr (ce1, ce2)
+ end
+
+ | A.UNARY(A.NOT, e1) -> begin
+ match doCondExp asconst e1 with
+ CEExp (se1, (Const _ as ci1)) ->
+ if isConstFalse ci1 then
+ CEExp (se1, one)
+ else
+ CEExp (se1, zero)
+ | CEExp (se1, e) when isEmpty se1 ->
+ let t = typeOf e in
+ if not ((isPointerType t) || (isArithmeticType t))then
+ E.s (error "Bad operand to !");
+ CEExp (empty, UnOp(LNot, e, intType))
+
+ | ce1 -> CENot ce1
+ end
+
+ | _ ->
+ let (se, e, t) = doExp asconst e (AExp None) in
+ ignore (checkBool t e);
+ CEExp (se, if !lowerConstants then constFold asconst e else e)
+
+and compileCondExp (ce: condExpRes) (st: chunk) (sf: chunk) : chunk =
+ match ce with
+ | CEAnd (ce1, ce2) ->
+ let (sf1, sf2) =
+ (* If sf is small then will copy it *)
+ try (sf, duplicateChunk sf)
+ with Failure _ ->
+ let lab = newLabelName "_L" in
+ (gotoChunk lab lu, consLabel lab sf !currentLoc false)
+ in
+ let st' = compileCondExp ce2 st sf1 in
+ let sf' = sf2 in
+ compileCondExp ce1 st' sf'
+
+ | CEOr (ce1, ce2) ->
+ let (st1, st2) =
+ (* If st is small then will copy it *)
+ try (st, duplicateChunk st)
+ with Failure _ ->
+ let lab = newLabelName "_L" in
+ (gotoChunk lab lu, consLabel lab st !currentLoc false)
+ in
+ let st' = st1 in
+ let sf' = compileCondExp ce2 st2 sf in
+ compileCondExp ce1 st' sf'
+
+ | CENot ce1 -> compileCondExp ce1 sf st
+
+ | CEExp (se, e) -> begin
+ match e with
+ Const(CInt64(i,_,_)) when i <> Int64.zero && canDrop sf -> se @@ st
+ | Const(CInt64(z,_,_)) when z = Int64.zero && canDrop st -> se @@ sf
+ | _ -> se @@ ifChunk e !currentLoc st sf
+ end
+
+
+(* A special case for conditionals *)
+and doCondition (isconst: bool) (* If we are in constants, we do our best to
+ * eliminate the conditional *)
+ (e: A.expression)
+ (st: chunk)
+ (sf: chunk) : chunk =
+ compileCondExp (doCondExp isconst e) st sf
+
+
+and doPureExp (e : A.expression) : exp =
+ let (se, e', _) = doExp true e (AExp None) in
+ if isNotEmpty se then
+ E.s (error "doPureExp: not pure");
+ e'
+
+and doInitializer
+ (vi: varinfo)
+ (inite: A.init_expression)
+ (* Return the accumulated chunk, the initializer and the new type (might be
+ * different for arrays) *)
+ : chunk * init * typ =
+
+ (* Setup the pre-initializer *)
+ let topPreInit = ref NoInitPre in
+ if debugInit then
+ ignore (E.log "\nStarting a new initializer for %s : %a\n"
+ vi.vname d_type vi.vtype);
+ let topSetupInit (o: offset) (e: exp) =
+ if debugInit then
+ ignore (E.log " set %a := %a\n" d_lval (Var vi, o) d_exp e);
+ let newinit = setOneInit !topPreInit o e in
+ if newinit != !topPreInit then topPreInit := newinit
+ in
+ let acc, restl =
+ let so = makeSubobj vi vi.vtype NoOffset in
+ doInit vi.vglob topSetupInit so empty [ (A.NEXT_INIT, inite) ]
+ in
+ if restl <> [] then
+ ignore (warn "Ignoring some initializers");
+ (* sm: we used to do array-size fixups here, but they only worked
+ * for toplevel array types; now, collectInitializer does the job,
+ * including for nested array types *)
+ let typ' = unrollType vi.vtype in
+ if debugInit then
+ ignore (E.log "Collecting the initializer for %s\n" vi.vname);
+ let (init, typ'') = collectInitializer !topPreInit typ' in
+ if debugInit then
+ ignore (E.log "Finished the initializer for %s\n init=%a\n typ=%a\n acc=%a\n"
+ vi.vname d_init init d_type typ' d_chunk acc);
+ acc, init, typ''
+
+
+
+(* Consume some initializers. Watch out here. Make sure we use only
+ * tail-recursion because these things can be big. *)
+and doInit
+ (isconst: bool)
+ (setone: offset -> exp -> unit) (* Use to announce an intializer *)
+ (so: subobj)
+ (acc: chunk)
+ (initl: (A.initwhat * A.init_expression) list)
+
+ (* Return the resulting chunk along with some unused initializers *)
+ : chunk * (A.initwhat * A.init_expression) list =
+
+ let whoami () = d_lval () (Var so.host, so.soOff) in
+
+ let initl1 =
+ match initl with
+ | (A.NEXT_INIT,
+ A.SINGLE_INIT (A.CAST ((s, dt), ie))) :: rest ->
+ let s', dt', ie' = preprocessCast s dt ie in
+ (A.NEXT_INIT, A.SINGLE_INIT (A.CAST ((s', dt'), ie'))) :: rest
+ | _ -> initl
+ in
+ (* Sometimes we have a cast in front of a compound (in GCC). This
+ * appears as a single initializer. Ignore the cast *)
+ let initl2 =
+ match initl1 with
+ (what,
+ A.SINGLE_INIT (A.CAST (_, A.COMPOUND_INIT ci))) :: rest ->
+ (what, A.COMPOUND_INIT ci) :: rest
+ | _ -> initl1
+ in
+ let allinitl = initl2 in
+
+ if debugInit then begin
+ ignore (E.log "doInit for %t %s (current %a). Looking at: " whoami
+ (if so.eof then "(eof)" else "")
+ d_lval (Var so.host, so.curOff));
+ (match allinitl with
+ [] -> ignore (E.log "[]")
+ | (what, ie) :: _ ->
+ withCprint
+ Cprint.print_init_expression (A.COMPOUND_INIT [(what, ie)]));
+ ignore (E.log "\n");
+ end;
+ match unrollType so.soTyp, allinitl with
+ _, [] -> acc, [] (* No more initializers return *)
+
+ (* No more subobjects *)
+ | _, (A.NEXT_INIT, _) :: _ when so.eof -> acc, allinitl
+
+
+ (* If we are at an array of characters and the initializer is a
+ * string literal (optionally enclosed in braces) then explode the
+ * string into characters *)
+ | TArray(bt, leno, _),
+ (A.NEXT_INIT,
+ (A.SINGLE_INIT(A.CONSTANT (A.CONST_STRING s))|
+ A.COMPOUND_INIT
+ [(A.NEXT_INIT,
+ A.SINGLE_INIT(A.CONSTANT
+ (A.CONST_STRING s)))])) :: restil
+ when (match unrollType bt with
+ TInt((IChar|IUChar|ISChar), _) -> true
+ | TInt _ ->
+ (*Base type is a scalar other than char. Maybe a wchar_t?*)
+ E.s (error "Using a string literal to initialize something other than a character array.\n")
+ | _ -> false (* OK, this is probably an array of strings. Handle *)
+ ) (* it with the other arrays below.*)
+ ->
+ let charinits =
+ let init c = A.NEXT_INIT, A.SINGLE_INIT(A.CONSTANT (A.CONST_CHAR [c]))
+ in
+ let collector =
+ (* ISO 6.7.8 para 14: final NUL added only if no size specified, or
+ * if there is room for it; btw, we can't rely on zero-init of
+ * globals, since this array might be a local variable *)
+ if ((isNone leno) or ((String.length s) < (integerArrayLength leno)))
+ then ref [init Int64.zero]
+ else ref []
+ in
+ for pos = String.length s - 1 downto 0 do
+ collector := init (Int64.of_int (Char.code (s.[pos]))) :: !collector
+ done;
+ !collector
+ in
+ (* Create a separate object for the array *)
+ let so' = makeSubobj so.host so.soTyp so.soOff in
+ (* Go inside the array *)
+ let leno = integerArrayLength leno in
+ so'.stack <- [InArray(so'.curOff, bt, leno, ref 0)];
+ normalSubobj so';
+ let acc', initl' = doInit isconst setone so' acc charinits in
+ if initl' <> [] then
+ ignore (warn "Too many initializers for character array %t" whoami);
+ (* Advance past the array *)
+ advanceSubobj so;
+ (* Continue *)
+ let res = doInit isconst setone so acc' restil in
+ res
+
+ (* If we are at an array of WIDE characters and the initializer is a
+ * WIDE string literal (optionally enclosed in braces) then explore
+ * the WIDE string into characters *)
+ (* [weimer] Wed Jan 30 15:38:05 PST 2002
+ * Despite what the compiler says, this match case is used and it is
+ * important. *)
+ | TArray(bt, leno, _),
+ (A.NEXT_INIT,
+ (A.SINGLE_INIT(A.CONSTANT (A.CONST_WSTRING s)) |
+ A.COMPOUND_INIT
+ [(A.NEXT_INIT,
+ A.SINGLE_INIT(A.CONSTANT
+ (A.CONST_WSTRING s)))])) :: restil
+ when(let bt' = unrollType bt in
+ match bt' with
+ (* compare bt to wchar_t, ignoring signed vs. unsigned *)
+ TInt _ when (bitsSizeOf bt') = (bitsSizeOf !wcharType) -> true
+ | TInt _ ->
+ (*Base type is a scalar other than wchar_t. Maybe a char?*)
+ E.s (error "Using a wide string literal to initialize something other than a wchar_t array.\n")
+ | _ -> false (* OK, this is probably an array of strings. Handle *)
+ ) (* it with the other arrays below.*)
+ ->
+ let maxWChar = (* (2**(bitsSizeOf !wcharType)) - 1 *)
+ Int64.sub (Int64.shift_left Int64.one (bitsSizeOf !wcharType))
+ Int64.one in
+ let charinits =
+ let init c =
+ if (compare c maxWChar > 0) then (* if c > maxWChar *)
+ E.s (error "cab2cil:doInit:character 0x%Lx too big." c);
+ A.NEXT_INIT,
+ A.SINGLE_INIT(A.CONSTANT (A.CONST_INT (Int64.to_string c)))
+ in
+ (List.map init s) @
+ (
+ (* ISO 6.7.8 para 14: final NUL added only if no size specified, or
+ * if there is room for it; btw, we can't rely on zero-init of
+ * globals, since this array might be a local variable *)
+ if ((isNone leno) or ((List.length s) < (integerArrayLength leno)))
+ then [init Int64.zero]
+ else [])
+(*
+ List.map
+ (fun c ->
+ if (compare c maxWChar > 0) then (* if c > maxWChar *)
+ E.s (error "cab2cil:doInit:character 0x%Lx too big." c)
+ else
+ (A.NEXT_INIT,
+ A.SINGLE_INIT(A.CONSTANT (A.CONST_INT (Int64.to_string c)))))
+ s
+*)
+ in
+ (* Create a separate object for the array *)
+ let so' = makeSubobj so.host so.soTyp so.soOff in
+ (* Go inside the array *)
+ let leno = integerArrayLength leno in
+ so'.stack <- [InArray(so'.curOff, bt, leno, ref 0)];
+ normalSubobj so';
+ let acc', initl' = doInit isconst setone so' acc charinits in
+ if initl' <> [] then
+ (* sm: see above regarding ISO 6.7.8 para 14, which is not implemented
+ * for wchar_t because, as far as I can tell, we don't even put in
+ * the automatic NUL (!) *)
+ ignore (warn "Too many initializers for wchar_t array %t" whoami);
+ (* Advance past the array *)
+ advanceSubobj so;
+ (* Continue *)
+ doInit isconst setone so acc' restil
+
+ (* If we are at an array and we see a single initializer then it must
+ * be one for the first element *)
+ | TArray(bt, leno, al), (A.NEXT_INIT, A.SINGLE_INIT oneinit) :: restil ->
+ (* Grab the length if there is one *)
+ let leno = integerArrayLength leno in
+ so.stack <- InArray(so.soOff, bt, leno, ref 0) :: so.stack;
+ normalSubobj so;
+ (* Start over with the fields *)
+ doInit isconst setone so acc allinitl
+
+ (* If we are at a composite and we see a single initializer of the same
+ * type as the composite then grab it all. If the type is not the same
+ * then we must go on and try to initialize the fields *)
+ | TComp (comp, _), (A.NEXT_INIT, A.SINGLE_INIT oneinit) :: restil ->
+ let se, oneinit', t' = doExp isconst oneinit (AExp None) in
+ if (match unrollType t' with
+ TComp (comp', _) when comp'.ckey = comp.ckey -> true
+ | _ -> false)
+ then begin
+ (* Initialize the whole struct *)
+ setone so.soOff oneinit';
+ (* Advance to the next subobject *)
+ advanceSubobj so;
+ doInit isconst setone so (acc @@ se) restil
+ end else begin (* Try to initialize fields *)
+ let toinit = fieldsToInit comp None in
+ so.stack <- InComp(so.soOff, comp, toinit) :: so.stack;
+ normalSubobj so;
+ doInit isconst setone so acc allinitl
+ end
+
+ (* A scalar with a single initializer *)
+ | _, (A.NEXT_INIT, A.SINGLE_INIT oneinit) :: restil ->
+ let se, oneinit', t' = doExp isconst oneinit (AExp(Some so.soTyp)) in
+(*
+ ignore (E.log "oneinit'=%a, t'=%a, so.soTyp=%a\n"
+ d_exp oneinit' d_type t' d_type so.soTyp);
+*)
+ setone so.soOff (mkCastT oneinit' t' so.soTyp);
+ (* Move on *)
+ advanceSubobj so;
+ doInit isconst setone so (acc @@ se) restil
+
+
+ (* An array with a compound initializer. The initializer is for the
+ * array elements *)
+ | TArray (bt, leno, _), (A.NEXT_INIT, A.COMPOUND_INIT initl) :: restil ->
+ (* Create a separate object for the array *)
+ let so' = makeSubobj so.host so.soTyp so.soOff in
+ (* Go inside the array *)
+ let leno = integerArrayLength leno in
+ so'.stack <- [InArray(so'.curOff, bt, leno, ref 0)];
+ normalSubobj so';
+ let acc', initl' = doInit isconst setone so' acc initl in
+ if initl' <> [] then
+ ignore (warn "Too many initializers for array %t" whoami);
+ (* Advance past the array *)
+ advanceSubobj so;
+ (* Continue *)
+ let res = doInit isconst setone so acc' restil in
+ res
+
+ (* We have a designator that tells us to select the matching union field.
+ * This is to support a GCC extension *)
+ | TComp(ci, _), [(A.NEXT_INIT,
+ A.COMPOUND_INIT [(A.INFIELD_INIT ("___matching_field",
+ A.NEXT_INIT),
+ A.SINGLE_INIT oneinit)])]
+ when not ci.cstruct ->
+ (* Do the expression to find its type *)
+ let _, _, t' = doExp isconst oneinit (AExp None) in
+ let tsig = typeSigWithAttrs (fun _ -> []) t' in
+ let rec findField = function
+ [] -> E.s (error "Cannot find matching union field in cast")
+ | fi :: rest
+ when Util.equals (typeSigWithAttrs (fun _ -> []) fi.ftype) tsig
+ -> fi
+ | _ :: rest -> findField rest
+ in
+ let fi = findField ci.cfields in
+ (* Change the designator and redo *)
+ doInit isconst setone so acc [(A.INFIELD_INIT (fi.fname, A.NEXT_INIT),
+ A.SINGLE_INIT oneinit)]
+
+
+ (* A structure with a composite initializer. We initialize the fields*)
+ | TComp (comp, _), (A.NEXT_INIT, A.COMPOUND_INIT initl) :: restil ->
+ (* Create a separate subobject iterator *)
+ let so' = makeSubobj so.host so.soTyp so.soOff in
+ (* Go inside the comp *)
+ so'.stack <- [InComp(so'.curOff, comp, fieldsToInit comp None)];
+ normalSubobj so';
+ let acc', initl' = doInit isconst setone so' acc initl in
+ if initl' <> [] then
+ ignore (warn "Too many initializers for structure");
+ (* Advance past the structure *)
+ advanceSubobj so;
+ (* Continue *)
+ doInit isconst setone so acc' restil
+
+ (* A scalar with a initializer surrounded by braces *)
+ | _, (A.NEXT_INIT, A.COMPOUND_INIT [(A.NEXT_INIT,
+ A.SINGLE_INIT oneinit)]) :: restil ->
+ let se, oneinit', t' = doExp isconst oneinit (AExp(Some so.soTyp)) in
+ setone so.soOff (mkCastT oneinit' t' so.soTyp);
+ (* Move on *)
+ advanceSubobj so;
+ doInit isconst setone so (acc @@ se) restil
+
+ | t, (A.NEXT_INIT, _) :: _ ->
+ E.s (unimp "doInit: unexpected NEXT_INIT for %a\n" d_type t);
+
+ (* We have a designator *)
+ | _, (what, ie) :: restil when what != A.NEXT_INIT ->
+ (* Process a designator and position to the designated subobject *)
+ let rec addressSubobj
+ (so: subobj)
+ (what: A.initwhat)
+ (acc: chunk) : chunk =
+ (* Always start from the current element *)
+ so.stack <- []; so.eof <- false;
+ normalSubobj so;
+ let rec address (what: A.initwhat) (acc: chunk) : chunk =
+ match what with
+ A.NEXT_INIT -> acc
+ | A.INFIELD_INIT (fn, whatnext) -> begin
+ match unrollType so.soTyp with
+ TComp (comp, _) ->
+ let toinit = fieldsToInit comp (Some fn) in
+ so.stack <- InComp(so.soOff, comp, toinit) :: so.stack;
+ normalSubobj so;
+ address whatnext acc
+
+ | _ -> E.s (error "Field designator %s not in a struct " fn)
+ end
+
+ | A.ATINDEX_INIT(idx, whatnext) -> begin
+ match unrollType so.soTyp with
+ TArray (bt, leno, _) ->
+ let ilen = integerArrayLength leno in
+ let nextidx', doidx =
+ let (doidx, idxe', _) =
+ doExp true idx (AExp(Some intType)) in
+ match constFold true idxe', isNotEmpty doidx with
+ Const(CInt64(x, _, _)), false -> Int64.to_int x, doidx
+ | _ -> E.s (error
+ "INDEX initialization designator is not a constant")
+ in
+ if nextidx' < 0 || nextidx' >= ilen then
+ E.s (error "INDEX designator is outside bounds");
+ so.stack <-
+ InArray(so.soOff, bt, ilen, ref nextidx') :: so.stack;
+ normalSubobj so;
+ address whatnext (acc @@ doidx)
+
+ | _ -> E.s (error "INDEX designator for a non-array")
+ end
+
+ | A.ATINDEXRANGE_INIT _ ->
+ E.s (bug "addressSubobj: INDEXRANGE")
+ in
+ address what acc
+ in
+ (* First expand the INDEXRANGE by making copies *)
+ let rec expandRange (top: A.initwhat -> A.initwhat) = function
+ | A.INFIELD_INIT (fn, whatnext) ->
+ expandRange (fun what -> top (A.INFIELD_INIT(fn, what))) whatnext
+ | A.ATINDEX_INIT (idx, whatnext) ->
+ expandRange (fun what -> top (A.ATINDEX_INIT(idx, what))) whatnext
+
+ | A.ATINDEXRANGE_INIT (idxs, idxe) ->
+ let (doidxs, idxs', _) =
+ doExp true idxs (AExp(Some intType)) in
+ let (doidxe, idxe', _) =
+ doExp true idxe (AExp(Some intType)) in
+ if isNotEmpty doidxs || isNotEmpty doidxe then
+ E.s (error "Range designators are not constants\n");
+ let first, last =
+ match constFold true idxs', constFold true idxe' with
+ Const(CInt64(s, _, _)),
+ Const(CInt64(e, _, _)) ->
+ Int64.to_int s, Int64.to_int e
+ | _ -> E.s (error
+ "INDEX_RANGE initialization designator is not a constant")
+ in
+ if first < 0 || first > last then
+ E.s (error
+ "start index larger than end index in range initializer");
+ let rec loop (i: int) =
+ if i > last then restil
+ else
+ (top (A.ATINDEX_INIT(A.CONSTANT(A.CONST_INT(string_of_int i)),
+ A.NEXT_INIT)), ie)
+ :: loop (i + 1)
+ in
+ doInit isconst setone so acc (loop first)
+
+ | A.NEXT_INIT -> (* We have not found any RANGE *)
+ let acc' = addressSubobj so what acc in
+ doInit isconst setone so (acc @@ acc')
+ ((A.NEXT_INIT, ie) :: restil)
+ in
+ expandRange (fun x -> x) what
+
+ | t, (what, ie) :: _ ->
+ E.s (bug "doInit: cases for t=%a" d_type t)
+
+
+(* Create and add to the file (if not already added) a global. Return the
+ * varinfo *)
+and createGlobal (specs : (typ * storage * bool * A.attribute list))
+ (((n,ndt,a,cloc), inite) : A.init_name) : varinfo =
+ try
+ if debugGlobal then
+ ignore (E.log "createGlobal: %s\n" n);
+ (* Make a first version of the varinfo *)
+ let vi = makeVarInfoCabs ~isformal:false
+ ~isglobal:true (convLoc cloc) specs (n,ndt,a) in
+ (* Add the variable to the environment before doing the initializer
+ * because it might refer to the variable itself *)
+ if isFunctionType vi.vtype then begin
+ if inite != A.NO_INIT then
+ E.s (error "Function declaration with initializer (%s)\n"
+ vi.vname);
+ (* sm: if it's a function prototype, and the storage class *)
+ (* isn't specified, make it 'extern'; this fixes a problem *)
+ (* with no-storage prototype and static definition *)
+ if vi.vstorage = NoStorage then
+ (*(trace "sm" (dprintf "adding extern to prototype of %s\n" n));*)
+ vi.vstorage <- Extern;
+ end;
+ let vi, alreadyInEnv = makeGlobalVarinfo (inite != A.NO_INIT) vi in
+(*
+ ignore (E.log "createGlobal %a: %s type=%a\n"
+ d_loc (convLoc cloc) vi.vname d_plaintype vi.vtype);
+*)
+ (* Do the initializer and complete the array type if necessary *)
+ let init : init option =
+ if inite = A.NO_INIT then
+ None
+ else
+ let se, ie', et = doInitializer vi inite in
+ (* Maybe we now have a better type *)
+ vi.vtype <- et;
+ if isNotEmpty se then
+ E.s (error "global initializer");
+ Some ie'
+ in
+
+ try
+ let oldloc = H.find alreadyDefined vi.vname in
+ if init != None then begin
+ E.s (error "Global %s was already defined at %a\n"
+ vi.vname d_loc oldloc);
+ end;
+ if debugGlobal then
+ ignore (E.log " global %s was already defined\n" vi.vname);
+ (* Do not declare it again *)
+ vi
+ with Not_found -> begin
+ (* Not already defined *)
+ if debugGlobal then
+ ignore (E.log " first definition for %s\n" vi.vname);
+ if init != None then begin
+ (* weimer: Sat Dec 8 17:43:34 2001
+ * MSVC NT Kernel headers include this lovely line:
+ * extern const GUID __declspec(selectany) \
+ * MOUNTDEV_MOUNTED_DEVICE_GUID = { 0x53f5630d, 0xb6bf, 0x11d0, { \
+ * 0x94, 0xf2, 0x00, 0xa0, 0xc9, 0x1e, 0xfb, 0x8b } };
+ * So we allow "extern" + "initializer" if "const" is
+ * around. *)
+ (* sm: As I read the ISO spec, in particular 6.9.2 and 6.7.8,
+ * "extern int foo = 3" is exactly equivalent to "int foo = 3";
+ * that is, if you put an initializer, then it is a definition,
+ * and "extern" is redundantly giving the name external linkage.
+ * gcc emits a warning, I guess because it is contrary to
+ * usual practice, but I think CIL warnings should be about
+ * semantic rather than stylistic issues, so I see no reason to
+ * even emit a warning. *)
+ if vi.vstorage = Extern then
+ vi.vstorage <- NoStorage; (* equivalent and canonical *)
+
+ H.add alreadyDefined vi.vname !currentLoc;
+ IH.remove mustTurnIntoDef vi.vid;
+ cabsPushGlobal (GVar(vi, {init = init}, !currentLoc));
+ vi
+ end else begin
+ if not (isFunctionType vi.vtype)
+ && not (IH.mem mustTurnIntoDef vi.vid) then
+ begin
+ IH.add mustTurnIntoDef vi.vid true
+ end;
+ if not alreadyInEnv then begin (* Only one declaration *)
+ (* If it has function type it is a prototype *)
+ cabsPushGlobal (GVarDecl (vi, !currentLoc));
+ vi
+ end else begin
+ if debugGlobal then
+ ignore (E.log " already in env %s\n" vi.vname);
+ vi
+ end
+ end
+ end
+ with e -> begin
+ ignore (E.log "error in createGlobal(%s: %a): %s\n" n
+ d_loc !currentLoc
+ (Printexc.to_string e));
+ cabsPushGlobal (dGlobal (dprintf "booo - error in global %s (%t)"
+ n d_thisloc) !currentLoc);
+ dummyFunDec.svar
+ end
+(*
+ ignore (E.log "Env after processing global %s is:@!%t@!"
+ n docEnv);
+ ignore (E.log "Alpha after processing global %s is:@!%t@!"
+ n docAlphaTable)
+*)
+
+(* Must catch the Static local variables. Make them global *)
+and createLocal ((_, sto, _, _) as specs)
+ ((((n, ndt, a, cloc) : A.name),
+ (inite: A.init_expression)) as init_name)
+ : chunk =
+ let loc = convLoc cloc in
+ (* Check if we are declaring a function *)
+ let rec isProto (dt: decl_type) : bool =
+ match dt with
+ | PROTO (JUSTBASE, _, _) -> true
+ | PROTO (x, _, _) -> isProto x
+ | PARENTYPE (_, x, _) -> isProto x
+ | ARRAY (x, _, _) -> isProto x
+ | PTR (_, x) -> isProto x
+ | _ -> false
+ in
+ match ndt with
+ (* Maybe we have a function prototype in local scope. Make it global. We
+ * do this even if the storage is Static *)
+ | _ when isProto ndt ->
+ let vi = createGlobal specs init_name in
+ (* Add it to the environment to shadow previous decls *)
+ addLocalToEnv n (EnvVar vi);
+ empty
+
+ | _ when sto = Static ->
+ if debugGlobal then
+ ignore (E.log "createGlobal (local static): %s\n" n);
+
+
+ (* Now alpha convert it to make sure that it does not conflict with
+ * existing globals or locals from this function. *)
+ let newname, _ = newAlphaName true "" n in
+ (* Make it global *)
+ let vi = makeVarInfoCabs ~isformal:false
+ ~isglobal:true
+ loc specs (newname, ndt, a) in
+ (* However, we have a problem if a real global appears later with the
+ * name that we have happened to choose for this one. Remember these names
+ * for later. *)
+ H.add staticLocals vi.vname vi;
+ (* Add it to the environment as a local so that the name goes out of
+ * scope properly *)
+ addLocalToEnv n (EnvVar vi);
+
+ (* Maybe this is an array whose length depends on something with local
+ scope, e.g. "static char device[ sizeof(local) ]".
+ Const-fold the type to fix this. *)
+ vi.vtype <- constFoldType vi.vtype;
+
+ let init : init option =
+ if inite = A.NO_INIT then
+ None
+ else begin
+ let se, ie', et = doInitializer vi inite in
+ (* Maybe we now have a better type *)
+ vi.vtype <- et;
+ if isNotEmpty se then
+ E.s (error "global static initializer");
+ (* Maybe the initializer refers to the function itself.
+ Push a prototype for the function, just in case. Hopefully,
+ if does not refer to the locals *)
+ cabsPushGlobal (GVarDecl (!currentFunctionFDEC.svar, !currentLoc));
+ Some ie'
+ end
+ in
+ cabsPushGlobal (GVar(vi, {init = init}, !currentLoc));
+ empty
+
+ (* Maybe we have an extern declaration. Make it a global *)
+ | _ when sto = Extern ->
+ let vi = createGlobal specs init_name in
+ (* Add it to the local environment to ensure that it shadows previous
+ * local variables *)
+ addLocalToEnv n (EnvVar vi);
+ empty
+
+ | _ ->
+ (* Make a variable of potentially variable size. If se0 <> empty then
+ * it is a variable size variable *)
+ let vi,se0,len,isvarsize =
+ makeVarSizeVarInfo loc specs (n, ndt, a) in
+
+ let vi = alphaConvertVarAndAddToEnv true vi in (* Replace vi *)
+ let se1 =
+ if isvarsize then begin (* Variable-sized array *)
+ ignore (warn "Variable-sized local variable %s" vi.vname);
+ (* Make a local variable to keep the length *)
+ let savelen =
+ makeVarInfoCabs
+ ~isformal:false
+ ~isglobal:false
+ loc
+ (TInt(IUInt, []), NoStorage, false, [])
+ ("__lengthof" ^ vi.vname,JUSTBASE, [])
+ in
+ (* Register it *)
+ let savelen = alphaConvertVarAndAddToEnv true savelen in
+ (* Compute the sizeof *)
+ let sizeof =
+ BinOp(Mult,
+ SizeOfE (Lval(Mem(Lval(var vi)), NoOffset)),
+ Lval (var savelen), !typeOfSizeOf) in
+ (* Register the length *)
+ IH.add varSizeArrays vi.vid sizeof;
+ (* There can be no initializer for this *)
+ if inite != A.NO_INIT then
+ E.s (error "Variable-sized array cannot have initializer");
+ se0 +++ (Set(var savelen, len, !currentLoc))
+ (* Initialize the variable *)
+ +++ (Call(Some(var vi), Lval(var (allocaFun ())),
+ [ sizeof ], !currentLoc))
+ end else empty
+ in
+ if inite = A.NO_INIT then
+ se1 (* skipChunk *)
+ else begin
+ let se4, ie', et = doInitializer vi inite in
+ (* Fix the length *)
+ (match vi.vtype, ie', et with
+ (* We have a length now *)
+ TArray(_,None, _), _, TArray(_, Some _, _) -> vi.vtype <- et
+ (* Initializing a local array *)
+ | TArray(TInt((IChar|IUChar|ISChar), _) as bt, None, a),
+ SingleInit(Const(CStr s)), _ ->
+ vi.vtype <- TArray(bt,
+ Some (integer (String.length s + 1)),
+ a)
+ | _, _, _ -> ());
+
+ (* Now create assignments instead of the initialization *)
+ se1 @@ se4 @@ (assignInit (Var vi, NoOffset) ie' et empty)
+ end
+
+and doAliasFun vtype (thisname:string) (othername:string)
+ (sname:single_name) (loc: cabsloc) : unit =
+ (* This prototype declares that name is an alias for
+ othername, which must be defined in this file *)
+(* E.log "%s is alias for %s at %a\n" thisname othername *)
+(* d_loc !currentLoc; *)
+ let rt, formals, isva, _ = splitFunctionType vtype in
+ if isva then E.s (error "%a: alias unsupported with varargs."
+ d_loc !currentLoc);
+ let args = List.map
+ (fun (n,_,_) -> A.VARIABLE n)
+ (argsToList formals) in
+ let call = A.CALL (A.VARIABLE othername, args) in
+ let stmt = if isVoidType rt then A.COMPUTATION(call, loc)
+ else A.RETURN(call, loc)
+ in
+ let body = { A.blabels = []; A.battrs = []; A.bstmts = [stmt] } in
+ let fdef = A.FUNDEF (sname, body, loc, loc) in
+ ignore (doDecl true fdef);
+ (* get the new function *)
+ let v,_ = try lookupGlobalVar thisname
+ with Not_found -> E.s (bug "error in doDecl") in
+ v.vattr <- dropAttribute "alias" v.vattr
+
+
+(* Do one declaration *)
+and doDecl (isglobal: bool) : A.definition -> chunk = function
+ | A.DECDEF ((s, nl), loc) ->
+ currentLoc := convLoc(loc);
+ (* Do the specifiers exactly once *)
+ let sugg =
+ match nl with
+ [] -> ""
+ | ((n, _, _, _), _) :: _ -> n
+ in
+ let spec_res = doSpecList sugg s in
+ (* Do all the variables and concatenate the resulting statements *)
+ let doOneDeclarator (acc: chunk) (name: init_name) =
+ let (n,ndt,a,l),_ = name in
+ if isglobal then begin
+ let bt,_,_,attrs = spec_res in
+ let vtype, nattr =
+ doType (AttrName false) bt (A.PARENTYPE(attrs, ndt, a)) in
+ (match filterAttributes "alias" nattr with
+ [] -> (* ordinary prototype. *)
+ ignore (createGlobal spec_res name)
+ (* E.log "%s is not aliased\n" name *)
+ | [Attr("alias", [AStr othername])] ->
+ if not (isFunctionType vtype) then begin
+ ignore (warn
+ "%a: CIL only supports attribute((alias)) for functions.\n"
+ d_loc !currentLoc);
+ ignore (createGlobal spec_res name)
+ end else
+ doAliasFun vtype n othername (s, (n,ndt,a,l)) loc
+ | _ -> E.s (error "Bad alias attribute at %a" d_loc !currentLoc));
+ acc
+ end else
+ acc @@ createLocal spec_res name
+ in
+ let res = List.fold_left doOneDeclarator empty nl in
+(*
+ ignore (E.log "after doDecl %a: res=%a\n"
+ d_loc !currentLoc d_chunk res);
+*)
+ res
+
+
+
+ | A.TYPEDEF (ng, loc) ->
+ currentLoc := convLoc(loc);
+ doTypedef ng; empty
+
+ | A.ONLYTYPEDEF (s, loc) ->
+ currentLoc := convLoc(loc);
+ doOnlyTypedef s; empty
+
+ | A.GLOBASM (s,loc) when isglobal ->
+ currentLoc := convLoc(loc);
+ cabsPushGlobal (GAsm (s, !currentLoc));
+ empty
+
+ | A.PRAGMA (a, loc) when isglobal -> begin
+ currentLoc := convLoc(loc);
+ match doAttr ("dummy", [a]) with
+ [Attr("dummy", [a'])] ->
+ let a'' =
+ match a' with
+ | ACons (s, args) -> Attr (s, args)
+ | _ -> E.s (error "Unexpected attribute in #pragma")
+ in
+ cabsPushGlobal (GPragma (a'', !currentLoc));
+ empty
+
+ | _ -> E.s (error "Too many attributes in pragma")
+ end
+ | A.TRANSFORMER (_, _, _) -> E.s (E.bug "TRANSFORMER in cabs2cil input")
+ | A.EXPRTRANSFORMER (_, _, _) ->
+ E.s (E.bug "EXPRTRANSFORMER in cabs2cil input")
+
+ (* If there are multiple definitions of extern inline, turn all but the
+ * first into a prototype *)
+ | A.FUNDEF (((specs,(n,dt,a,loc')) : A.single_name),
+ (body : A.block), loc, _)
+ when isglobal && isExtern specs && isInline specs
+ && (H.mem genv (n ^ "__extinline")) ->
+ currentLoc := convLoc(loc);
+ let othervi, _ = lookupVar (n ^ "__extinline") in
+ if othervi.vname = n then
+ (* The previous entry in the env is also an extern inline version
+ of n. *)
+ ignore (warn "Duplicate extern inline definition for %s ignored" n)
+ else begin
+ (* Otherwise, the previous entry is an ordinary function that
+ happens to be named __extinline. Renaming n to n__extinline
+ would confict with other, so report an error. *)
+ E.s (unimp("Trying to rename %s to\n %s__extinline, but %s__extinline"
+ ^^ " already exists in the env.\n \"__extinline\" is"
+ ^^ " reserved for CIL.\n") n n n)
+ end;
+ (* Treat it as a prototype *)
+ doDecl isglobal (A.DECDEF ((specs, [((n,dt,a,loc'), A.NO_INIT)]), loc))
+
+ | A.FUNDEF (((specs,(n,dt,a, _)) : A.single_name),
+ (body : A.block), loc1, loc2) when isglobal ->
+ begin
+ let funloc = convLoc loc1 in
+ let endloc = convLoc loc2 in
+(* ignore (E.log "Definition of %s at %a\n" n d_loc funloc); *)
+ currentLoc := funloc;
+ E.withContext
+ (fun _ -> dprintf "2cil: %s" n)
+ (fun _ ->
+ try
+ IH.clear callTempVars;
+
+ (* Make the fundec right away, and we'll populate it later. We
+ * need this throughout the code to create temporaries. *)
+ currentFunctionFDEC :=
+ { svar = makeGlobalVar "@tempname@" voidType;
+ slocals = []; (* For now we'll put here both the locals and
+ * the formals. Then "endFunction" will
+ * separate them *)
+ sformals = []; (* Not final yet *)
+ smaxid = 0;
+ sbody = dummyFunDec.sbody; (* Not final yet *)
+ smaxstmtid = None;
+ sallstmts = [];
+ };
+ !currentFunctionFDEC.svar.vdecl <- funloc;
+
+ constrExprId := 0;
+ (* Setup the environment. Add the formals to the locals. Maybe
+ * they need alpha-conv *)
+ enterScope (); (* Start the scope *)
+
+ IH.clear varSizeArrays;
+
+ (* Do not process transparent unions in function definitions.
+ * We'll do it later *)
+ transparentUnionArgs := [];
+
+ (* Fix the NAME and the STORAGE *)
+ let _ =
+ let bt,sto,inl,attrs = doSpecList n specs in
+ !currentFunctionFDEC.svar.vinline <- inl;
+
+ let ftyp, funattr =
+ doType (AttrName false) bt (A.PARENTYPE(attrs, dt, a)) in
+ !currentFunctionFDEC.svar.vtype <- ftyp;
+ !currentFunctionFDEC.svar.vattr <- funattr;
+
+ (* If this is the definition of an extern inline then we change
+ * its name, by adding the suffix __extinline. We also make it
+ * static *)
+ let n', sto' =
+ let n' = n ^ "__extinline" in
+ if inl && sto = Extern then
+ n', Static
+ else begin
+ (* Maybe this is the body of a previous extern inline. Then
+ * we must take that one out of the environment because it
+ * is not used from here on. This will also ensure that
+ * then we make this functions' varinfo we will not think
+ * it is a duplicate definition *)
+ (try
+ ignore (lookupVar n'); (* if this succeeds, n' is defined*)
+ let oldvi, _ = lookupVar n in
+ if oldvi.vname = n' then begin
+ (* oldvi is an extern inline function that has been
+ renamed to n ^ "__extinline". Remove it from the
+ environment. *)
+ H.remove env n; H.remove genv n;
+ H.remove env n'; H.remove genv n'
+ end
+ else
+ (* oldvi is not a renamed extern inline function, and
+ we should do nothing. The reason the lookup
+ of n' succeeded is probably because there's
+ an ordinary function that happens to be named,
+ n ^ "__extinline", probably as a result of a previous
+ pass through CIL. See small2/extinline.c*)
+ ()
+ with Not_found -> ());
+ n, sto
+ end
+ in
+ (* Now we have the name and the storage *)
+ !currentFunctionFDEC.svar.vname <- n';
+ !currentFunctionFDEC.svar.vstorage <- sto'
+ in
+
+ (* Add the function itself to the environment. Add it before
+ * you do the body because the function might be recursive. Add
+ * it also before you add the formals to the environment
+ * because there might be a formal with the same name as the
+ * function and we want it to take precedence. *)
+ (* Make a variable out of it and put it in the environment *)
+ !currentFunctionFDEC.svar <-
+ fst (makeGlobalVarinfo true !currentFunctionFDEC.svar);
+
+ (* If it is extern inline then we add it to the global
+ * environment for the original name as well. This will ensure
+ * that all uses of this function will refer to the renamed
+ * function *)
+ addGlobalToEnv n (EnvVar !currentFunctionFDEC.svar);
+
+ if H.mem alreadyDefined !currentFunctionFDEC.svar.vname then
+ E.s (error "There is a definition already for %s" n);
+
+(*
+ ignore (E.log "makefunvar:%s@! type=%a@! vattr=%a@!"
+ n d_type thisFunctionVI.vtype
+ d_attrlist thisFunctionVI.vattr);
+*)
+
+ (* makeGlobalVarinfo might have changed the type of the function
+ * (when combining it with the type of the prototype). So get the
+ * type only now. *)
+
+ (**** Process the TYPE and the FORMALS ***)
+ let _ =
+ let (returnType, formals_t, isvararg, funta) =
+ splitFunctionTypeVI !currentFunctionFDEC.svar
+ in
+ (* Record the returnType for doStatement *)
+ currentReturnType := returnType;
+
+
+ (* Create the formals and add them to the environment. *)
+ (* sfg: extract locations for the formals from dt *)
+ let doFormal (loc : location) (fn, ft, fa) =
+ let f = makeVarinfo false fn ft in
+ (f.vdecl <- loc;
+ f.vattr <- fa;
+ alphaConvertVarAndAddToEnv true f)
+ in
+ let rec doFormals fl' ll' =
+ begin
+ match (fl', ll') with
+ | [], _ -> []
+
+ | fl, [] -> (* no more locs available *)
+ List.map (doFormal !currentLoc) fl
+
+ | f::fl, (_,(_,_,_,l))::ll ->
+ (* sfg: these lets seem to be necessary to
+ * force the right order of evaluation *)
+ let f' = doFormal (convLoc l) f in
+ let fl' = doFormals fl ll in
+ f' :: fl'
+ end
+ in
+ let fmlocs = (match dt with PROTO(_, fml, _) -> fml | _ -> []) in
+ let formals = doFormals (argsToList formals_t) fmlocs in
+
+ (* Recreate the type based on the formals. *)
+ let ftype = TFun(returnType,
+ Some (List.map (fun f -> (f.vname,
+ f.vtype,
+ f.vattr)) formals),
+ isvararg, funta) in
+ (*
+ ignore (E.log "Funtype of %s: %a\n" n' d_type ftype);
+ *)
+ (* Now fix the names of the formals in the type of the function
+ * as well *)
+ !currentFunctionFDEC.svar.vtype <- ftype;
+ !currentFunctionFDEC.sformals <- formals;
+ in
+ (* Now change the type of transparent union args back to what it
+ * was so that the body type checks. We must do it this late
+ * because makeGlobalVarinfo from above might choke if we give
+ * the function a type containing transparent unions *)
+ let _ =
+ let rec fixbackFormals (idx: int) (args: varinfo list) : unit=
+ match args with
+ [] -> ()
+ | a :: args' ->
+ (* Fix the type back to a transparent union type *)
+ (try
+ let origtype = List.assq idx !transparentUnionArgs in
+ a.vtype <- origtype;
+ with Not_found -> ());
+ fixbackFormals (idx + 1) args'
+ in
+ fixbackFormals 0 !currentFunctionFDEC.sformals;
+ transparentUnionArgs := [];
+ in
+
+ (********** Now do the BODY *************)
+ let _ =
+ let stmts = doBody body in
+ (* Finish everything *)
+ exitScope ();
+
+ (* Now fill in the computed goto statement with cases. Do this
+ * before mkFunctionbody which resolves the gotos *)
+ (match !gotoTargetData with
+ Some (switchv, switch) ->
+ let switche, l =
+ match switch.skind with
+ Switch (switche, _, _, l) -> switche, l
+ | _ -> E.s(bug "the computed goto statement not a switch")
+ in
+ (* Build a default chunk that segfaults *)
+ let default =
+ defaultChunk
+ l
+ (i2c (Set ((Mem (mkCast (integer 0) intPtrType),
+ NoOffset),
+ integer 0, l)))
+ in
+ let bodychunk = ref default in
+ H.iter (fun lname laddr ->
+ bodychunk :=
+ caseRangeChunk
+ [integer laddr] l
+ (gotoChunk lname l @@ !bodychunk))
+ gotoTargetHash;
+ (* Now recreate the switch *)
+ let newswitch = switchChunk switche !bodychunk l in
+ (* We must still share the old switch statement since we
+ * have already inserted the goto's *)
+ let newswitchkind =
+ match newswitch.stmts with
+ [ s]
+ when newswitch.postins == [] && newswitch.cases == []->
+ s.skind
+ | _ -> E.s (bug "Unexpected result from switchChunk")
+ in
+ switch.skind <- newswitchkind
+
+ | None -> ());
+ (* Now finish the body and store it *)
+ !currentFunctionFDEC.sbody <- mkFunctionBody stmts;
+ (* Reset the global parameters *)
+ gotoTargetData := None;
+ H.clear gotoTargetHash;
+ gotoTargetNextAddr := 0;
+ in
+
+
+
+(*
+ ignore (E.log "endFunction %s at %t:@! sformals=%a@! slocals=%a@!"
+ !currentFunctionFDEC.svar.vname d_thisloc
+ (docList ~sep:(chr ',') (fun v -> text v.vname))
+ !currentFunctionFDEC.sformals
+ (docList ~sep:(chr ',') (fun v -> text v.vname))
+ !currentFunctionFDEC.slocals);
+*)
+
+ let rec dropFormals formals locals =
+ match formals, locals with
+ [], l -> l
+ | f :: formals, l :: locals ->
+ if f != l then
+ E.s (bug "formal %s is not in locals (found instead %s)"
+ f.vname l.vname);
+ dropFormals formals locals
+ | _ -> E.s (bug "Too few locals")
+ in
+ !currentFunctionFDEC.slocals
+ <- dropFormals !currentFunctionFDEC.sformals
+ (List.rev !currentFunctionFDEC.slocals);
+ setMaxId !currentFunctionFDEC;
+
+ (* Now go over the types of the formals and pull out the formals
+ * with transparent union type. Replace them with some shadow
+ * parameters and then add assignments *)
+ let _ =
+ let newformals, newbody =
+ List.fold_right (* So that the formals come out in order *)
+ (fun f (accform, accbody) ->
+ match isTransparentUnion f.vtype with
+ None -> (f :: accform, accbody)
+ | Some fstfield ->
+ (* A new shadow to be placed in the formals. Use
+ * makeTempVar to update smaxid and all others. *)
+ let shadow =
+ makeTempVar !currentFunctionFDEC fstfield.ftype in
+ (* Now take it out of the locals and replace it with
+ * the current formal. It is not worth optimizing this
+ * one. *)
+ !currentFunctionFDEC.slocals <-
+ f ::
+ (List.filter (fun x -> x.vid <> shadow.vid)
+ !currentFunctionFDEC.slocals);
+ (shadow :: accform,
+ mkStmt (Instr [Set ((Var f, Field(fstfield,
+ NoOffset)),
+ Lval (var shadow),
+ !currentLoc)]) :: accbody))
+ !currentFunctionFDEC.sformals
+ ([], !currentFunctionFDEC.sbody.bstmts)
+ in
+ !currentFunctionFDEC.sbody.bstmts <- newbody;
+ (* To make sure sharing with the type is proper *)
+ setFormals !currentFunctionFDEC newformals;
+ in
+
+ (* Now see whether we can fall through to the end of the function
+ * *)
+ (* weimer: Sat Dec 8 17:30:47 2001 MSVC NT kernel headers include
+ * functions like long convert(x) { __asm { mov eax, x \n cdq } }
+ * That set a return value via an ASM statement. As a result, I
+ * am changing this so a final ASM statement does not count as
+ * "fall through" for the purposes of this warning. *)
+ (* matth: But it's better to assume assembly will fall through,
+ * since most such blocks do. It's probably better to print an
+ * unnecessary warning than to break CIL's invariant that
+ * return statements are inserted properly. *)
+ let instrFallsThrough (i : instr) = match i with
+ Set _ -> true
+ | Call (None, Lval (Var e, NoOffset), _, _) ->
+ (* See if this is exit, or if it has the noreturn attribute *)
+ if e.vname = "exit" then false
+ else if hasAttribute "noreturn" e.vattr then false
+ else true
+ | Call _ -> true
+ | Asm _ -> true
+ in
+ let rec stmtFallsThrough (s: stmt) : bool =
+ match s.skind with
+ Instr(il) ->
+ List.fold_left (fun acc elt ->
+ acc && instrFallsThrough elt) true il
+ | Return _ | Break _ | Continue _ -> false
+ | Goto _ -> false
+ | If (_, b1, b2, _) ->
+ blockFallsThrough b1 || blockFallsThrough b2
+ | Switch (e, b, targets, _) ->
+ (* See if there is a "default" case *)
+ if not
+ (List.exists (fun s ->
+ List.exists (function Default _ -> true | _ -> false)
+ s.labels)
+ targets) then begin
+(*
+ ignore (E.log "Switch falls through because no default");
+
+*) true (* We fall through because there is no default *)
+ end else begin
+ (* We must examine all cases. If any falls through,
+ * then the switch falls through. *)
+ blockFallsThrough b || blockCanBreak b
+ end
+(*
+ | Loop (b, _, _, _) ->
+ (* A loop falls through if it can break. *)
+ blockCanBreak b
+*)
+ | While (_, b, _) -> blockCanBreak b
+ | DoWhile (_, b, _) -> blockCanBreak b
+ | For (_, _, _, b, _) -> blockCanBreak b
+ | Block b -> blockFallsThrough b
+ | TryFinally (b, h, _) -> blockFallsThrough h
+ | TryExcept (b, _, h, _) -> true (* Conservative *)
+ and blockFallsThrough b =
+ let rec fall = function
+ [] -> true
+ | s :: rest ->
+ if stmtFallsThrough s then begin
+(*
+ ignore (E.log "Stmt %a falls through\n" d_stmt s);
+*)
+ fall rest
+ end else begin
+(*
+ ignore (E.log "Stmt %a DOES NOT fall through\n"
+ d_stmt s);
+*)
+ (* If we are not falling thorough then maybe there
+ * are labels who are *)
+ labels rest
+ end
+ and labels = function
+ [] -> false
+ (* We have a label, perhaps we can jump here *)
+ | s :: rest when s.labels <> [] ->
+(*
+ ignore (E.log "invoking fall %a: %a\n"
+ d_loc !currentLoc d_stmt s);
+*)
+ fall (s :: rest)
+ | _ :: rest -> labels rest
+ in
+ let res = fall b.bstmts in
+(*
+ ignore (E.log "blockFallsThrough=%b %a\n" res d_block b);
+*)
+ res
+ (* will we leave this statement or block with a break command? *)
+ and stmtCanBreak (s: stmt) : bool =
+ match s.skind with
+ Instr _ | Return _ | Continue _ | Goto _ -> false
+ | Break _ -> true
+ | If (_, b1, b2, _) ->
+ blockCanBreak b1 || blockCanBreak b2
+ | Switch _ | (*Loop _*) While _ | DoWhile _ | For _ ->
+ (* switches and loops catch any breaks in their bodies *)
+ false
+ | Block b -> blockCanBreak b
+ | TryFinally (b, h, _) -> blockCanBreak b || blockCanBreak h
+ | TryExcept (b, _, h, _) -> blockCanBreak b || blockCanBreak h
+ and blockCanBreak b =
+ List.exists stmtCanBreak b.bstmts
+ in
+ if blockFallsThrough !currentFunctionFDEC.sbody then begin
+(*
+ let retval =
+ match unrollType !currentReturnType with
+ TVoid _ -> None
+ | (TInt _ | TEnum _ | TFloat _ | TPtr _) as rt ->
+ ignore (warn "Body of function %s falls-through. Adding a return statement\n" !currentFunctionFDEC.svar.vname);
+ Some (mkCastT zero intType rt)
+ | _ ->
+ ignore (warn "Body of function %s falls-through and cannot find an appropriate return value\n" !currentFunctionFDEC.svar.vname);
+ None
+ in
+ if not (hasAttribute "noreturn"
+ !currentFunctionFDEC.svar.vattr) then
+ !currentFunctionFDEC.sbody.bstmts <-
+ !currentFunctionFDEC.sbody.bstmts
+ @ [mkStmt (Return(retval, endloc))]
+*)
+ end;
+
+ (* ignore (E.log "The env after finishing the body of %s:\n%t\n"
+ n docEnv); *)
+ cabsPushGlobal (GFun (!currentFunctionFDEC, funloc));
+ empty
+ with E.Error as e -> raise e
+ | e -> begin
+ ignore (E.log "error in collectFunction %s: %s\n"
+ n (Printexc.to_string e));
+ cabsPushGlobal (GAsm("error in function " ^ n, !currentLoc));
+ empty
+ end)
+ () (* argument of E.withContext *)
+ end (* FUNDEF *)
+
+ | LINKAGE (n, loc, dl) ->
+ currentLoc := convLoc loc;
+ if n <> "C" then
+ ignore (warn "Encountered linkage specification \"%s\"" n);
+ if not isglobal then
+ E.s (error "Encountered linkage specification in local scope");
+ (* For now drop the linkage on the floor !!! *)
+ List.iter
+ (fun d ->
+ let s = doDecl isglobal d in
+ if isNotEmpty s then
+ E.s (bug "doDecl returns non-empty statement for global"))
+ dl;
+ empty
+
+ | _ -> E.s (error "unexpected form of declaration")
+
+and doTypedef ((specs, nl): A.name_group) =
+ try
+ (* Do the specifiers exactly once *)
+ let bt, sto, inl, attrs = doSpecList (suggestAnonName nl) specs in
+ if sto <> NoStorage || inl then
+ E.s (error "Storage or inline specifier not allowed in typedef");
+ let createTypedef ((n,ndt,a,loc) : A.name) =
+ (* E.s (error "doTypeDef") *)
+ try
+ let newTyp, tattr =
+ doType AttrType bt (A.PARENTYPE(attrs, ndt, a)) in
+ let newTyp' = cabsTypeAddAttributes tattr newTyp in
+ (* Create a new name for the type. Use the same name space as that of
+ * variables to avoid confusion between variable names and types. This
+ * is actually necessary in some cases. *)
+ let n', _ = newAlphaName true "" n in
+ let ti = { tname = n'; ttype = newTyp'; treferenced = false } in
+ (* Since we use the same name space, we might later hit a global with
+ * the same name and we would want to change the name of the global.
+ * It is better to change the name of the type instead. So, remember
+ * all types whose names have changed *)
+ H.add typedefs n' ti;
+ let namedTyp = TNamed(ti, []) in
+ (* Register the type. register it as local because we might be in a
+ * local context *)
+ addLocalToEnv (kindPlusName "type" n) (EnvTyp namedTyp);
+ cabsPushGlobal (GType (ti, !currentLoc))
+ with E.Error as e -> raise e
+ | e -> begin
+ ignore (E.log "Error on A.TYPEDEF (%s)\n"
+ (Printexc.to_string e));
+ cabsPushGlobal (GAsm ("booo_typedef:" ^ n, !currentLoc))
+ end
+ in
+ List.iter createTypedef nl
+ with E.Error as e -> raise e
+ | e -> begin
+ ignore (E.log "Error on A.TYPEDEF (%s)\n"
+ (Printexc.to_string e));
+ let fstname =
+ match nl with
+ [] -> "<missing name>"
+ | (n, _, _, _) :: _ -> n
+ in
+ cabsPushGlobal (GAsm ("booo_typedef: " ^ fstname, !currentLoc))
+ end
+
+and doOnlyTypedef (specs: A.spec_elem list) : unit =
+ try
+ let bt, sto, inl, attrs = doSpecList "" specs in
+ if sto <> NoStorage || inl then
+ E.s (error "Storage or inline specifier not allowed in typedef");
+ let restyp, nattr = doType AttrType bt (A.PARENTYPE(attrs,
+ A.JUSTBASE, [])) in
+ if nattr <> [] then
+ ignore (warn "Ignoring identifier attribute");
+ (* doSpec will register the type. *)
+ (* See if we are defining a composite or enumeration type, and in that
+ * case move the attributes from the defined type into the composite type
+ * *)
+ let isadef =
+ List.exists
+ (function
+ A.SpecType(A.Tstruct(_, Some _, _)) -> true
+ | A.SpecType(A.Tunion(_, Some _, _)) -> true
+ | A.SpecType(A.Tenum(_, Some _, _)) -> true
+ | _ -> false) specs
+ in
+ match restyp with
+ TComp(ci, al) ->
+ if isadef then begin
+ ci.cattr <- cabsAddAttributes ci.cattr al;
+ (* The GCompTag was already added *)
+ end else (* Add a GCompTagDecl *)
+ cabsPushGlobal (GCompTagDecl(ci, !currentLoc))
+ | TEnum(ei, al) ->
+ if isadef then begin
+ ei.eattr <- cabsAddAttributes ei.eattr al;
+ end else
+ cabsPushGlobal (GEnumTagDecl(ei, !currentLoc))
+ | _ ->
+ ignore (warn "Ignoring un-named typedef that does not introduce a struct or enumeration type\n")
+
+ with E.Error as e -> raise e
+ | e -> begin
+ ignore (E.log "Error on A.ONLYTYPEDEF (%s)\n"
+ (Printexc.to_string e));
+ cabsPushGlobal (GAsm ("booo_typedef", !currentLoc))
+ end
+
+and assignInit (lv: lval)
+ (ie: init)
+ (iet: typ)
+ (acc: chunk) : chunk =
+ match ie with
+ SingleInit e ->
+ let (_, e'') = castTo iet (typeOfLval lv) e in
+ acc +++ (Set(lv, e'', !currentLoc))
+ | CompoundInit (t, initl) ->
+ foldLeftCompound
+ ~doinit:(fun off i it acc ->
+ assignInit (addOffsetLval off lv) i it acc)
+ ~ct:t
+ ~initl:initl
+ ~acc:acc
+(*
+ | ArrayInit (bt, len, initl) ->
+ let idx = ref ( -1 ) in
+ List.fold_left
+ (fun acc i ->
+ assignInit (addOffsetLval (Index(integer !idx, NoOffset)) lv) i bt acc)
+ acc
+ initl
+*)
+ (* Now define the processors for body and statement *)
+and doBody (blk: A.block) : chunk =
+ enterScope ();
+ (* Rename the labels and add them to the environment *)
+ List.iter (fun l -> ignore (genNewLocalLabel l)) blk.blabels;
+ (* See if we have some attributes *)
+ let battrs = doAttributes blk.A.battrs in
+
+ let bodychunk =
+ afterConversion
+ (List.fold_left (* !!! @ evaluates its arguments backwards *)
+ (fun prev s -> let res = doStatement s in
+ prev @@ res)
+ empty
+ blk.A.bstmts)
+ in
+ exitScope ();
+
+
+ if battrs == [] then
+ bodychunk
+ else begin
+ let b = c2block bodychunk in
+ b.battrs <- battrs;
+ s2c (mkStmt (Block b))
+ end
+
+and doStatement (s : A.statement) : chunk =
+ try
+ match s with
+ A.NOP _ -> skipChunk
+ | A.COMPUTATION (e, loc) ->
+ currentLoc := convLoc loc;
+ let (lasts, data) = !gnu_body_result in
+ if lasts == s then begin (* This is the last in a GNU_BODY *)
+ let (s', e', t') = doExp false e (AExp None) in
+ data := Some (e', t'); (* Record the result *)
+ s'
+ end else
+ let (s', _, _) = doExp false e ADrop in
+ (* drop the side-effect free expression *)
+ (* And now do some peep-hole optimizations *)
+ s'
+
+ | A.BLOCK (b, loc) ->
+ currentLoc := convLoc loc;
+ doBody b
+
+ | A.SEQUENCE (s1, s2, loc) ->
+ (doStatement s1) @@ (doStatement s2)
+
+ | A.IF(e,st,sf,loc) ->
+ let st' = doStatement st in
+ let sf' = doStatement sf in
+ currentLoc := convLoc loc;
+ doCondition false e st' sf'
+
+ | A.WHILE(e,s,loc) ->
+(*
+ startLoop true;
+ let s' = doStatement s in
+ exitLoop ();
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ loopChunk ((doCondition false e skipChunk
+ (breakChunk loc'))
+ @@ s')
+*)
+ (** We need to convert A.WHILE(e,s) where e may have side effects
+ into Cil.While(e',s') where e' is side-effect free. *)
+
+ (* Let e == (sCond , eCond) with sCond a sequence of statements
+ and eCond a side-effect free expression. *)
+ let (sCond, eCond, _) = doExp false e (AExp None) in
+
+ (* Then doStatement(A.WHILE((sCond , eCond), s))
+ = sCond ; Cil.While(eCond, (doStatement(s) ; sCond))
+ where doStatement(A.CONTINUE) = (sCond ; Cil.Continue). *)
+
+ startLoop (DuplicateBeforeContinue sCond);
+ let s' = doStatement s in
+ exitLoop ();
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ sCond @@ (whileChunk eCond (s' @@ sCond))
+
+ | A.DOWHILE(e,s,loc) ->
+(*
+ startLoop false;
+ let s' = doStatement s in
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ let s'' =
+ consLabContinue (doCondition false e skipChunk (breakChunk loc'))
+ in
+ exitLoop ();
+ loopChunk (s' @@ s'')
+*)
+ (** We need to convert A.DOWHILE(e,s) where e may have side effects
+ into Cil.DoWhile(e',s') where e' is side-effect free. *)
+
+ (* Let e == (sCond , eCond) with sCond a sequence of statements
+ and eCond a side-effect free expression. *)
+ let (sCond, eCond, _) = doExp false e (AExp None) in
+
+ (* Then doStatement(A.DOWHILE((sCond , eCond), s))
+ = Cil.DoWhile(eCond, (doStatement(s) ; sCond))
+ where doStatement(A.CONTINUE) = (sCond ; Cil.Continue). *)
+
+ startLoop (DuplicateBeforeContinue sCond);
+ let s' = doStatement s in
+ exitLoop ();
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ doWhileChunk eCond (s' @@ sCond)
+
+ | A.FOR(fc1,e2,e3,s,loc) ->
+(*begin
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ enterScope (); (* Just in case we have a declaration *)
+ let (se1, _, _) =
+ match fc1 with
+ FC_EXP e1 -> doExp false e1 ADrop
+ | FC_DECL d1 -> (doDecl false d1, zero, voidType)
+ in
+ let (se3, _, _) = doExp false e3 ADrop in
+ startLoop false;
+ let s' = doStatement s in
+ currentLoc := loc';
+ let s'' = consLabContinue se3 in
+ exitLoop ();
+ let res =
+ match e2 with
+ A.NOTHING -> (* This means true *)
+ se1 @@ loopChunk (s' @@ s'')
+ | _ ->
+ se1 @@ loopChunk ((doCondition false e2 skipChunk (breakChunk loc'))
+ @@ s' @@ s'')
+ in
+ exitScope ();
+ res
+ end
+*)
+ (** We need to convert A.FOR(e1,e2,e3,s) where e1, e2 and e3 may
+ have side effects into Cil.For(bInit,e2',bIter,s') where e2'
+ is side-effect free. **)
+
+ (* Let e1 == bInit be a block of statements
+ Let e2 == (bCond , eCond) with bCond a block of statements
+ and eCond a side-effect free expression
+ Let e3 == bIter be a sequence of statements. *)
+ let (bInit, _, _) = match fc1 with
+ | FC_EXP e1 -> doExp false e1 ADrop
+ | FC_DECL d1 -> (doDecl false d1, zero, voidType) in
+ let (bCond, eCond, _) = doExp false e2 (AExp None) in
+ let eCond' = match eCond with
+ | Const(CStr "exp_nothing") -> Cil.one
+ | _ -> eCond in
+ let (bIter, _, _) = doExp false e3 ADrop in
+
+ (* Then doStatement(A.FOR(bInit, (bCond , eCond), bIter, s))
+ = Cil.For({bInit; bCond}, eCond', {bIter; bCond}, {doStatement(s)})
+ where doStatement(A.CONTINUE) = Cil.Continue. *)
+
+ startLoop ContinueUnchanged;
+ let s' = doStatement s in
+ exitLoop ();
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ (forChunk (bInit @@ bCond) eCond' (bIter @@ bCond) s')
+
+ | A.BREAK loc ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ breakChunk loc'
+
+ | A.CONTINUE loc ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+(*
+ continueOrLabelChunk loc'
+*)
+ continueDuplicateChunk loc'
+
+ | A.RETURN (A.NOTHING, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ if not (isVoidType !currentReturnType) then
+ ignore (warn "Return statement without a value in function returning %a\n" d_type !currentReturnType);
+ returnChunk None loc'
+
+ | A.RETURN (e, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ (* Sometimes we return the result of a void function call *)
+ if isVoidType !currentReturnType then begin
+ ignore (warn "Return statement with a value in function returning void");
+ let (se, _, _) = doExp false e ADrop in
+ se @@ returnChunk None loc'
+ end else begin
+ let (se, e', et) =
+ doExp false e (AExp (Some !currentReturnType)) in
+ let (et'', e'') = castTo et (!currentReturnType) e' in
+ se @@ (returnChunk (Some e'') loc')
+ end
+
+ | A.SWITCH (e, s, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ let (se, e', et) = doExp false e (AExp (Some intType)) in
+ let (et'', e'') = castTo et intType e' in
+ let s' = doStatement s in
+ se @@ (switchChunk e'' s' loc')
+
+ | A.CASE (e, s, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ let (se, e', et) = doExp true e (AExp None) in
+ if isNotEmpty se then
+ E.s (error "Case statement with a non-constant");
+ caseRangeChunk [if !lowerConstants then constFold false e' else e']
+ loc' (doStatement s)
+
+ | A.CASERANGE (el, eh, s, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ let (sel, el', etl) = doExp false el (AExp None) in
+ let (seh, eh', etl) = doExp false eh (AExp None) in
+ if isNotEmpty sel || isNotEmpty seh then
+ E.s (error "Case statement with a non-constant");
+ let il, ih =
+ match constFold true el', constFold true eh' with
+ Const(CInt64(il, _, _)), Const(CInt64(ih, _, _)) ->
+ Int64.to_int il, Int64.to_int ih
+ | _ -> E.s (unimp "Cannot understand the constants in case range")
+ in
+ if il > ih then
+ E.s (error "Empty case range");
+ let rec mkAll (i: int) =
+ if i > ih then [] else integer i :: mkAll (i + 1)
+ in
+ caseRangeChunk (mkAll il) loc' (doStatement s)
+
+
+ | A.DEFAULT (s, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ defaultChunk loc' (doStatement s)
+
+ | A.LABEL (l, s, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ (* Lookup the label because it might have been locally defined *)
+ consLabel (lookupLabel l) (doStatement s) loc' true
+
+ | A.GOTO (l, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ (* Maybe we need to rename this label *)
+ gotoChunk (lookupLabel l) loc'
+
+ | A.COMPGOTO (e, loc) -> begin
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ (* Do the expression *)
+ let se, e', t' = doExp false e (AExp (Some voidPtrType)) in
+ match !gotoTargetData with
+ Some (switchv, switch) -> (* We have already generated this one *)
+ se
+ @@ i2c(Set (var switchv, mkCast e' uintType, loc'))
+ @@ s2c(mkStmt(Goto (ref switch, loc')))
+
+ | None -> begin
+ (* Make a temporary variable *)
+ let vchunk = createLocal
+ (TInt(IUInt, []), NoStorage, false, [])
+ (("__compgoto", A.JUSTBASE, [], loc), A.NO_INIT)
+ in
+ if not (isEmpty vchunk) then
+ E.s (unimp "Non-empty chunk in creating temporary for goto *");
+ let switchv, _ =
+ try lookupVar "__compgoto"
+ with Not_found -> E.s (bug "Cannot find temporary for goto *");
+ in
+ (* Make a switch statement. We'll fill in the statements at the
+ * end of the function *)
+ let switch = mkStmt (Switch (Lval(var switchv),
+ mkBlock [], [], loc')) in
+ (* And make a label for it since we'll goto it *)
+ switch.labels <- [Label ("__docompgoto", loc', false)];
+ gotoTargetData := Some (switchv, switch);
+ se @@ i2c (Set(var switchv, mkCast e' uintType, loc')) @@
+ s2c switch
+ end
+ end
+
+ | A.DEFINITION d ->
+ let s = doDecl false d in
+(*
+ ignore (E.log "Def at %a: %a\n" d_loc !currentLoc d_chunk s);
+*)
+ s
+
+
+
+ | A.ASM (asmattr, tmpls, details, loc) ->
+ (* Make sure all the outs are variables *)
+ let loc' = convLoc loc in
+ let attr' = doAttributes asmattr in
+ currentLoc := loc';
+ let stmts : chunk ref = ref empty in
+ let (tmpls', outs', ins', clobs') =
+ match details with
+ | None ->
+ let tmpls' =
+ if !msvcMode then
+ tmpls
+ else
+ let pattern = Str.regexp "%" in
+ let escape = Str.global_replace pattern "%%" in
+ List.map escape tmpls
+ in
+ (tmpls', [], [], [])
+ | Some { aoutputs = outs; ainputs = ins; aclobbers = clobs } ->
+ let outs' =
+ List.map
+ (fun (c, e) ->
+ let (se, e', t) = doExp false e (AExp None) in
+ let lv =
+ match e' with
+ | Lval lval
+ | StartOf lval -> lval
+ | _ -> E.s (error "Expected lval for ASM outputs")
+ in
+ stmts := !stmts @@ se;
+ (c, lv)) outs
+ in
+ (* Get the side-effects out of expressions *)
+ let ins' =
+ List.map
+ (fun (c, e) ->
+ let (se, e', et) = doExp false e (AExp None) in
+ stmts := !stmts @@ se;
+ (c, e'))
+ ins
+ in
+ (tmpls, outs', ins', clobs)
+ in
+ !stmts @@
+ (i2c (Asm(attr', tmpls', outs', ins', clobs', loc')))
+
+ | TRY_FINALLY (b, h, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ let b': chunk = doBody b in
+ let h': chunk = doBody h in
+ if b'.cases <> [] || h'.cases <> [] then
+ E.s (error "Try statements cannot contain switch cases");
+
+ s2c (mkStmt (TryFinally (c2block b', c2block h', loc')))
+
+ | TRY_EXCEPT (b, e, h, loc) ->
+ let loc' = convLoc loc in
+ currentLoc := loc';
+ let b': chunk = doBody b in
+ (* Now do e *)
+ let ((se: chunk), e', t') = doExp false e (AExp None) in
+ let h': chunk = doBody h in
+ if b'.cases <> [] || h'.cases <> [] || se.cases <> [] then
+ E.s (error "Try statements cannot contain switch cases");
+ (* Now take se and try to convert it to a list of instructions. This
+ * might not be always possible *)
+ let il' =
+ match compactStmts se.stmts with
+ [] -> se.postins
+ | [ s ] -> begin
+ match s.skind with
+ Instr il -> il @ se.postins
+ | _ -> E.s (error "Except expression contains unexpected statement")
+ end
+ | _ -> E.s (error "Except expression contains too many statements")
+ in
+ s2c (mkStmt (TryExcept (c2block b', (il', e'), c2block h', loc')))
+
+ with e -> begin
+ (ignore (E.log "Error in doStatement (%s)\n" (Printexc.to_string e)));
+ consLabel "booo_statement" empty (convLoc (A.get_statementloc s)) false
+ end
+
+
+(* Translate a file *)
+let convFile ((fname : string), (dl : Cabs.definition list)) : Cil.file =
+ Cil.initCIL (); (* make sure we have initialized CIL *)
+ (* Clean up the global types *)
+ E.hadErrors := false;
+ initGlobals();
+ startFile ();
+ IH.clear noProtoFunctions;
+ H.clear compInfoNameEnv;
+ H.clear enumInfoNameEnv;
+ IH.clear mustTurnIntoDef;
+ H.clear alreadyDefined;
+ H.clear staticLocals;
+ H.clear typedefs;
+ H.clear isomorphicStructs;
+ annonCompFieldNameId := 0;
+ if !E.verboseFlag || !Cilutil.printStages then
+ ignore (E.log "Converting CABS->CIL\n");
+ (* Setup the built-ins, but do not add their prototypes to the file *)
+ let setupBuiltin name (resTyp, argTypes, isva) =
+ let v =
+ makeGlobalVar name (TFun(resTyp,
+ Some (List.map (fun at -> ("", at, []))
+ argTypes),
+ isva, [])) in
+ ignore (alphaConvertVarAndAddToEnv true v)
+ in
+ H.iter setupBuiltin (if !msvcMode then msvcBuiltins else gccBuiltins);
+
+ let globalidx = ref 0 in
+ let doOneGlobal (d: A.definition) =
+ let s = doDecl true d in
+ if isNotEmpty s then
+ E.s (bug "doDecl returns non-empty statement for global");
+ (* See if this is one of the globals which we can leave alone. Increment
+ * globalidx and see if we must leave this alone. *)
+ if
+ (match d with
+ A.DECDEF _ -> true
+ | A.FUNDEF _ -> true
+ | _ -> false) && (incr globalidx; !globalidx = !nocil) then begin
+ (* Create a file where we put the CABS output *)
+ let temp_cabs_name = "__temp_cabs" in
+ let temp_cabs = open_out temp_cabs_name in
+ (* Now print the CABS in there *)
+ Cprint.commit (); Cprint.flush ();
+ let old = !Cprint.out in (* Save the old output channel *)
+ Cprint.out := temp_cabs;
+ Cprint.print_def d;
+ Cprint.commit (); Cprint.flush ();
+ flush !Cprint.out;
+ Cprint.out := old;
+ close_out temp_cabs;
+ (* Now read everythign in *and create a GText from it *)
+ let temp_cabs = open_in temp_cabs_name in
+ let buff = Buffer.create 1024 in
+ Buffer.add_string buff "// Start of CABS form\n";
+ Buffer.add_channel buff temp_cabs (in_channel_length temp_cabs);
+ Buffer.add_string buff "// End of CABS form\n";
+ close_in temp_cabs;
+ (* Try to pop the last thing in the file *)
+ (match !theFile with
+ _ :: rest -> theFile := rest
+ | _ -> ());
+ (* Insert in the file a GText *)
+ cabsPushGlobal (GText(Buffer.contents buff))
+ end
+ in
+ List.iter doOneGlobal dl;
+ let globals = ref (popGlobals ()) in
+
+ IH.clear noProtoFunctions;
+ IH.clear mustTurnIntoDef;
+ H.clear alreadyDefined;
+ H.clear compInfoNameEnv;
+ H.clear enumInfoNameEnv;
+ H.clear isomorphicStructs;
+ H.clear staticLocals;
+ H.clear typedefs;
+ H.clear env;
+ H.clear genv;
+ IH.clear callTempVars;
+
+ if false then ignore (E.log "Cabs2cil converted %d globals\n" !globalidx);
+ (* We are done *)
+ { fileName = fname;
+ globals = !globals;
+ globinit = None;
+ globinitcalled = false;
+ }
+
+
+
+
diff --git a/cil/src/frontc/cabs2cil.mli b/cil/src/frontc/cabs2cil.mli
new file mode 100644
index 0000000..986f5a2
--- /dev/null
+++ b/cil/src/frontc/cabs2cil.mli
@@ -0,0 +1,49 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+val convFile: Cabs.file -> Cil.file
+
+(** NDC added command line parameter **)
+(* Turn on tranformation that forces correct parameter evaluation order *)
+val forceRLArgEval: bool ref
+
+(* Set this integer to the index of the global to be left in CABS form. Use
+ * -1 to disable *)
+val nocil: int ref
+
+(* Indicates whether we're allowed to duplicate small chunks of code. *)
+val allowDuplication: bool ref
diff --git a/cil/src/frontc/cabsvisit.ml b/cil/src/frontc/cabsvisit.ml
new file mode 100644
index 0000000..b2f9784
--- /dev/null
+++ b/cil/src/frontc/cabsvisit.ml
@@ -0,0 +1,577 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* cabsvisit.ml *)
+(* tree visitor and rewriter for cabs *)
+
+open Cabs
+open Trace
+open Pretty
+module E = Errormsg
+
+(* basic interface for a visitor object *)
+
+(* Different visiting actions. 'a will be instantiated with exp, instr, etc. *)
+type 'a visitAction =
+ SkipChildren (* Do not visit the children. Return
+ * the node as it is *)
+ | ChangeTo of 'a (* Replace the expression with the
+ * given one *)
+ | DoChildren (* Continue with the children of this
+ * node. Rebuild the node on return
+ * if any of the children changes
+ * (use == test) *)
+ | ChangeDoChildrenPost of 'a * ('a -> 'a) (* First consider that the entire
+ * exp is replaced by the first
+ * paramenter. Then continue with
+ * the children. On return rebuild
+ * the node if any of the children
+ * has changed and then apply the
+ * function on the node *)
+
+type nameKind =
+ NVar (* Variable or function prototype
+ name *)
+ | NFun (* A function definition name *)
+ | NField (* The name of a field *)
+ | NType (* The name of a type *)
+
+(* All visit methods are called in preorder! (but you can use
+ * ChangeDoChildrenPost to change the order) *)
+class type cabsVisitor = object
+ method vexpr: expression -> expression visitAction (* expressions *)
+ method vinitexpr: init_expression -> init_expression visitAction
+ method vstmt: statement -> statement list visitAction
+ method vblock: block -> block visitAction
+ method vvar: string -> string (* use of a variable
+ * names *)
+ method vdef: definition -> definition list visitAction
+ method vtypespec: typeSpecifier -> typeSpecifier visitAction
+ method vdecltype: decl_type -> decl_type visitAction
+
+ (* For each declaration we call vname *)
+ method vname: nameKind -> specifier -> name -> name visitAction
+ method vspec: specifier -> specifier visitAction (* specifier *)
+ method vattr: attribute -> attribute list visitAction
+
+ method vEnterScope: unit -> unit
+ method vExitScope: unit -> unit
+end
+
+let visitorLocation = ref { filename = "";
+ lineno = -1;
+ byteno = -1;}
+
+ (* a default visitor which does nothing to the tree *)
+class nopCabsVisitor : cabsVisitor = object
+ method vexpr (e:expression) = DoChildren
+ method vinitexpr (e:init_expression) = DoChildren
+ method vstmt (s: statement) =
+ visitorLocation := get_statementloc s;
+ DoChildren
+ method vblock (b: block) = DoChildren
+ method vvar (s: string) = s
+ method vdef (d: definition) =
+ visitorLocation := get_definitionloc d;
+ DoChildren
+ method vtypespec (ts: typeSpecifier) = DoChildren
+ method vdecltype (dt: decl_type) = DoChildren
+ method vname k (s:specifier) (n: name) = DoChildren
+ method vspec (s:specifier) = DoChildren
+ method vattr (a: attribute) = DoChildren
+
+ method vEnterScope () = ()
+ method vExitScope () = ()
+end
+
+ (* Map but try not to copy the list unless necessary *)
+let rec mapNoCopy (f: 'a -> 'a) = function
+ [] -> []
+ | (i :: resti) as li ->
+ let i' = f i in
+ let resti' = mapNoCopy f resti in
+ if i' != i || resti' != resti then i' :: resti' else li
+
+let rec mapNoCopyList (f: 'a -> 'a list) = function
+ [] -> []
+ | (i :: resti) as li ->
+ let il' = f i in
+ let resti' = mapNoCopyList f resti in
+ match il' with
+ [i'] when i' == i && resti' == resti -> li
+ | _ -> il' @ resti'
+
+let doVisit (vis: cabsVisitor)
+ (startvisit: 'a -> 'a visitAction)
+ (children: cabsVisitor -> 'a -> 'a)
+ (node: 'a) : 'a =
+ let action = startvisit node in
+ match action with
+ SkipChildren -> node
+ | ChangeTo node' -> node'
+ | _ ->
+ let nodepre = match action with
+ ChangeDoChildrenPost (node', _) -> node'
+ | _ -> node
+ in
+ let nodepost = children vis nodepre in
+ match action with
+ ChangeDoChildrenPost (_, f) -> f nodepost
+ | _ -> nodepost
+
+(* A visitor for lists *)
+let doVisitList (vis: cabsVisitor)
+ (startvisit: 'a -> 'a list visitAction)
+ (children: cabsVisitor -> 'a -> 'a)
+ (node: 'a) : 'a list =
+ let action = startvisit node in
+ match action with
+ SkipChildren -> [node]
+ | ChangeTo nodes' -> nodes'
+ | _ ->
+ let nodespre = match action with
+ ChangeDoChildrenPost (nodespre, _) -> nodespre
+ | _ -> [node]
+ in
+ let nodespost = mapNoCopy (children vis) nodespre in
+ match action with
+ ChangeDoChildrenPost (_, f) -> f nodespost
+ | _ -> nodespost
+
+
+let rec visitCabsTypeSpecifier (vis: cabsVisitor) (ts: typeSpecifier) =
+ doVisit vis vis#vtypespec childrenTypeSpecifier ts
+
+and childrenTypeSpecifier vis ts =
+ let childrenFieldGroup ((s, nel) as input) =
+ let s' = visitCabsSpecifier vis s in
+ let doOneField ((n, eo) as input) =
+ let n' = visitCabsName vis NField s' n in
+ let eo' =
+ match eo with
+ None -> None
+ | Some e -> let e' = visitCabsExpression vis e in
+ if e' != e then Some e' else eo
+ in
+ if n' != n || eo' != eo then (n', eo') else input
+ in
+ let nel' = mapNoCopy doOneField nel in
+ if s' != s || nel' != nel then (s', nel') else input
+ in
+ match ts with
+ Tstruct (n, Some fg, extraAttrs) ->
+ (*(trace "sm" (dprintf "visiting struct %s\n" n));*)
+ let fg' = mapNoCopy childrenFieldGroup fg in
+ if fg' != fg then Tstruct( n, Some fg', extraAttrs) else ts
+ | Tunion (n, Some fg, extraAttrs) ->
+ let fg' = mapNoCopy childrenFieldGroup fg in
+ if fg' != fg then Tunion( n, Some fg', extraAttrs) else ts
+ | Tenum (n, Some ei, extraAttrs) ->
+ let doOneEnumItem ((s, e, loc) as ei) =
+ let e' = visitCabsExpression vis e in
+ if e' != e then (s, e', loc) else ei
+ in
+ vis#vEnterScope ();
+ let ei' = mapNoCopy doOneEnumItem ei in
+ vis#vExitScope();
+ if ei' != ei then Tenum( n, Some ei', extraAttrs) else ts
+ | TtypeofE e ->
+ let e' = visitCabsExpression vis e in
+ if e' != e then TtypeofE e' else ts
+ | TtypeofT (s, dt) ->
+ let s' = visitCabsSpecifier vis s in
+ let dt' = visitCabsDeclType vis false dt in
+ if s != s' || dt != dt' then TtypeofT (s', dt') else ts
+ | ts -> ts
+
+and childrenSpecElem (vis: cabsVisitor) (se: spec_elem) : spec_elem =
+ match se with
+ SpecTypedef | SpecInline | SpecStorage _ | SpecPattern _ -> se
+ | SpecCV _ -> se (* cop out *)
+ | SpecAttr a -> begin
+ let al' = visitCabsAttribute vis a in
+ match al' with
+ [a''] when a'' == a -> se
+ | [a''] -> SpecAttr a''
+ | _ -> E.s (E.unimp "childrenSpecElem: visitCabsAttribute returned a list")
+ end
+ | SpecType ts ->
+ let ts' = visitCabsTypeSpecifier vis ts in
+ if ts' != ts then SpecType ts' else se
+
+and visitCabsSpecifier (vis: cabsVisitor) (s: specifier) : specifier =
+ doVisit vis vis#vspec childrenSpec s
+and childrenSpec vis s = mapNoCopy (childrenSpecElem vis) s
+
+
+and visitCabsDeclType vis (isfundef: bool) (dt: decl_type) : decl_type =
+ doVisit vis vis#vdecltype (childrenDeclType isfundef) dt
+and childrenDeclType isfundef vis dt =
+ match dt with
+ JUSTBASE -> dt
+ | PARENTYPE (prea, dt1, posta) ->
+ let prea' = mapNoCopyList (visitCabsAttribute vis) prea in
+ let dt1' = visitCabsDeclType vis isfundef dt1 in
+ let posta'= mapNoCopyList (visitCabsAttribute vis) posta in
+ if prea' != prea || dt1' != dt1 || posta' != posta then
+ PARENTYPE (prea', dt1', posta') else dt
+ | ARRAY (dt1, al, e) ->
+ let dt1' = visitCabsDeclType vis isfundef dt1 in
+ let al' = mapNoCopy (childrenAttribute vis) al in
+ let e'= visitCabsExpression vis e in
+ if dt1' != dt1 || al' != al || e' != e then ARRAY(dt1', al', e') else dt
+ | PTR (al, dt1) ->
+ let al' = mapNoCopy (childrenAttribute vis) al in
+ let dt1' = visitCabsDeclType vis isfundef dt1 in
+ if al' != al || dt1' != dt1 then PTR(al', dt1') else dt
+ | PROTO (dt1, snl, b) ->
+ (* Do not propagate isfundef further *)
+ let dt1' = visitCabsDeclType vis false dt1 in
+ let _ = vis#vEnterScope () in
+ let snl' = mapNoCopy (childrenSingleName vis NVar) snl in
+ (* Exit the scope only if not in a function definition *)
+ let _ = if not isfundef then vis#vExitScope () in
+ if dt1' != dt1 || snl' != snl then PROTO(dt1', snl', b) else dt
+
+
+and childrenNameGroup vis (kind: nameKind) ((s, nl) as input) =
+ let s' = visitCabsSpecifier vis s in
+ let nl' = mapNoCopy (visitCabsName vis kind s') nl in
+ if s' != s || nl' != nl then (s', nl') else input
+
+
+and childrenInitNameGroup vis ((s, inl) as input) =
+ let s' = visitCabsSpecifier vis s in
+ let inl' = mapNoCopy (childrenInitName vis s') inl in
+ if s' != s || inl' != inl then (s', inl') else input
+
+and visitCabsName vis (k: nameKind) (s: specifier)
+ (n: name) : name =
+ doVisit vis (vis#vname k s) (childrenName s k) n
+and childrenName (s: specifier) (k: nameKind) vis (n: name) : name =
+ let (sn, dt, al, loc) = n in
+ let dt' = visitCabsDeclType vis (k = NFun) dt in
+ let al' = mapNoCopy (childrenAttribute vis) al in
+ if dt' != dt || al' != al then (sn, dt', al', loc) else n
+
+and childrenInitName vis (s: specifier) (inn: init_name) : init_name =
+ let (n, ie) = inn in
+ let n' = visitCabsName vis NVar s n in
+ let ie' = visitCabsInitExpression vis ie in
+ if n' != n || ie' != ie then (n', ie') else inn
+
+and childrenSingleName vis (k: nameKind) (sn: single_name) : single_name =
+ let s, n = sn in
+ let s' = visitCabsSpecifier vis s in
+ let n' = visitCabsName vis k s' n in
+ if s' != s || n' != n then (s', n') else sn
+
+and visitCabsDefinition vis (d: definition) : definition list =
+ doVisitList vis vis#vdef childrenDefinition d
+and childrenDefinition vis d =
+ match d with
+ FUNDEF (sn, b, l, lend) ->
+ let sn' = childrenSingleName vis NFun sn in
+ let b' = visitCabsBlock vis b in
+ (* End the scope that was started by childrenFunctionName *)
+ vis#vExitScope ();
+ if sn' != sn || b' != b then FUNDEF (sn', b', l, lend) else d
+
+ | DECDEF ((s, inl), l) ->
+ let s' = visitCabsSpecifier vis s in
+ let inl' = mapNoCopy (childrenInitName vis s') inl in
+ if s' != s || inl' != inl then DECDEF ((s', inl'), l) else d
+ | TYPEDEF (ng, l) ->
+ let ng' = childrenNameGroup vis NType ng in
+ if ng' != ng then TYPEDEF (ng', l) else d
+ | ONLYTYPEDEF (s, l) ->
+ let s' = visitCabsSpecifier vis s in
+ if s' != s then ONLYTYPEDEF (s', l) else d
+ | GLOBASM _ -> d
+ | PRAGMA (e, l) ->
+ let e' = visitCabsExpression vis e in
+ if e' != e then PRAGMA (e', l) else d
+ | LINKAGE (n, l, dl) ->
+ let dl' = mapNoCopyList (visitCabsDefinition vis) dl in
+ if dl' != dl then LINKAGE (n, l, dl') else d
+
+ | TRANSFORMER _ -> d
+ | EXPRTRANSFORMER _ -> d
+
+and visitCabsBlock vis (b: block) : block =
+ doVisit vis vis#vblock childrenBlock b
+
+and childrenBlock vis (b: block) : block =
+ let _ = vis#vEnterScope () in
+ let battrs' = mapNoCopyList (visitCabsAttribute vis) b.battrs in
+ let bstmts' = mapNoCopyList (visitCabsStatement vis) b.bstmts in
+ let _ = vis#vExitScope () in
+ if battrs' != b.battrs || bstmts' != b.bstmts then
+ { blabels = b.blabels; battrs = battrs'; bstmts = bstmts' }
+ else
+ b
+
+and visitCabsStatement vis (s: statement) : statement list =
+ doVisitList vis vis#vstmt childrenStatement s
+and childrenStatement vis s =
+ let ve e = visitCabsExpression vis e in
+ let vs l s =
+ match visitCabsStatement vis s with
+ [s'] -> s'
+ | sl -> BLOCK ({blabels = []; battrs = []; bstmts = sl }, l)
+ in
+ match s with
+ NOP _ -> s
+ | COMPUTATION (e, l) ->
+ let e' = ve e in
+ if e' != e then COMPUTATION (e', l) else s
+ | BLOCK (b, l) ->
+ let b' = visitCabsBlock vis b in
+ if b' != b then BLOCK (b', l) else s
+ | SEQUENCE (s1, s2, l) ->
+ let s1' = vs l s1 in
+ let s2' = vs l s2 in
+ if s1' != s1 || s2' != s2 then SEQUENCE (s1', s2', l) else s
+ | IF (e, s1, s2, l) ->
+ let e' = ve e in
+ let s1' = vs l s1 in
+ let s2' = vs l s2 in
+ if e' != e || s1' != s1 || s2' != s2 then IF (e', s1', s2', l) else s
+ | WHILE (e, s1, l) ->
+ let e' = ve e in
+ let s1' = vs l s1 in
+ if e' != e || s1' != s1 then WHILE (e', s1', l) else s
+ | DOWHILE (e, s1, l) ->
+ let e' = ve e in
+ let s1' = vs l s1 in
+ if e' != e || s1' != s1 then DOWHILE (e', s1', l) else s
+ | FOR (fc1, e2, e3, s4, l) ->
+ let _ = vis#vEnterScope () in
+ let fc1' =
+ match fc1 with
+ FC_EXP e1 ->
+ let e1' = ve e1 in
+ if e1' != e1 then FC_EXP e1' else fc1
+ | FC_DECL d1 ->
+ let d1' =
+ match visitCabsDefinition vis d1 with
+ [d1'] -> d1'
+ | _ -> E.s (E.unimp "visitCabs: for can have only one definition")
+ in
+ if d1' != d1 then FC_DECL d1' else fc1
+ in
+ let e2' = ve e2 in
+ let e3' = ve e3 in
+ let s4' = vs l s4 in
+ let _ = vis#vExitScope () in
+ if fc1' != fc1 || e2' != e2 || e3' != e3 || s4' != s4
+ then FOR (fc1', e2', e3', s4', l) else s
+ | BREAK _ | CONTINUE _ | GOTO _ -> s
+ | RETURN (e, l) ->
+ let e' = ve e in
+ if e' != e then RETURN (e', l) else s
+ | SWITCH (e, s1, l) ->
+ let e' = ve e in
+ let s1' = vs l s1 in
+ if e' != e || s1' != s1 then SWITCH (e', s1', l) else s
+ | CASE (e, s1, l) ->
+ let e' = ve e in
+ let s1' = vs l s1 in
+ if e' != e || s1' != s1 then CASE (e', s1', l) else s
+ | CASERANGE (e1, e2, s3, l) ->
+ let e1' = ve e1 in
+ let e2' = ve e2 in
+ let s3' = vs l s3 in
+ if e1' != e1 || e2' != e2 || s3' != s3 then
+ CASERANGE (e1', e2', s3', l) else s
+ | DEFAULT (s1, l) ->
+ let s1' = vs l s1 in
+ if s1' != s1 then DEFAULT (s1', l) else s
+ | LABEL (n, s1, l) ->
+ let s1' = vs l s1 in
+ if s1' != s1 then LABEL (n, s1', l) else s
+ | COMPGOTO (e, l) ->
+ let e' = ve e in
+ if e' != e then COMPGOTO (e', l) else s
+ | DEFINITION d -> begin
+ match visitCabsDefinition vis d with
+ [d'] when d' == d -> s
+ | [d'] -> DEFINITION d'
+ | dl -> let l = get_definitionloc d in
+ let dl' = List.map (fun d' -> DEFINITION d') dl in
+ BLOCK ({blabels = []; battrs = []; bstmts = dl' }, l)
+ end
+ | ASM (sl, b, details, l) ->
+ let childrenStringExp ((s, e) as input) =
+ let e' = ve e in
+ if e' != e then (s, e') else input
+ in
+ let details' = match details with
+ | None -> details
+ | Some { aoutputs = outl; ainputs = inl; aclobbers = clobs } ->
+ let outl' = mapNoCopy childrenStringExp outl in
+ let inl' = mapNoCopy childrenStringExp inl in
+ if outl' == outl && inl' == inl then
+ details
+ else
+ Some { aoutputs = outl'; ainputs = inl'; aclobbers = clobs }
+ in
+ if details' != details then
+ ASM (sl, b, details', l) else s
+ | TRY_FINALLY (b1, b2, l) ->
+ let b1' = visitCabsBlock vis b1 in
+ let b2' = visitCabsBlock vis b2 in
+ if b1' != b1 || b2' != b2 then TRY_FINALLY(b1', b2', l) else s
+ | TRY_EXCEPT (b1, e, b2, l) ->
+ let b1' = visitCabsBlock vis b1 in
+ let e' = visitCabsExpression vis e in
+ let b2' = visitCabsBlock vis b2 in
+ if b1' != b1 || e' != e || b2' != b2 then TRY_EXCEPT(b1', e', b2', l) else s
+
+
+and visitCabsExpression vis (e: expression) : expression =
+ doVisit vis vis#vexpr childrenExpression e
+and childrenExpression vis e =
+ let ve e = visitCabsExpression vis e in
+ match e with
+ NOTHING | LABELADDR _ -> e
+ | UNARY (uo, e1) ->
+ let e1' = ve e1 in
+ if e1' != e1 then UNARY (uo, e1') else e
+ | BINARY (bo, e1, e2) ->
+ let e1' = ve e1 in
+ let e2' = ve e2 in
+ if e1' != e1 || e2' != e2 then BINARY (bo, e1', e2') else e
+ | QUESTION (e1, e2, e3) ->
+ let e1' = ve e1 in
+ let e2' = ve e2 in
+ let e3' = ve e3 in
+ if e1' != e1 || e2' != e2 || e3' != e3 then
+ QUESTION (e1', e2', e3') else e
+ | CAST ((s, dt), ie) ->
+ let s' = visitCabsSpecifier vis s in
+ let dt' = visitCabsDeclType vis false dt in
+ let ie' = visitCabsInitExpression vis ie in
+ if s' != s || dt' != dt || ie' != ie then CAST ((s', dt'), ie') else e
+ | CALL (f, el) ->
+ let f' = ve f in
+ let el' = mapNoCopy ve el in
+ if f' != f || el' != el then CALL (f', el') else e
+ | COMMA el ->
+ let el' = mapNoCopy ve el in
+ if el' != el then COMMA (el') else e
+ | CONSTANT _ -> e
+ | VARIABLE s ->
+ let s' = vis#vvar s in
+ if s' != s then VARIABLE s' else e
+ | EXPR_SIZEOF (e1) ->
+ let e1' = ve e1 in
+ if e1' != e1 then EXPR_SIZEOF (e1') else e
+ | TYPE_SIZEOF (s, dt) ->
+ let s' = visitCabsSpecifier vis s in
+ let dt' = visitCabsDeclType vis false dt in
+ if s' != s || dt' != dt then TYPE_SIZEOF (s' ,dt') else e
+ | EXPR_ALIGNOF (e1) ->
+ let e1' = ve e1 in
+ if e1' != e1 then EXPR_ALIGNOF (e1') else e
+ | TYPE_ALIGNOF (s, dt) ->
+ let s' = visitCabsSpecifier vis s in
+ let dt' = visitCabsDeclType vis false dt in
+ if s' != s || dt' != dt then TYPE_ALIGNOF (s' ,dt') else e
+ | INDEX (e1, e2) ->
+ let e1' = ve e1 in
+ let e2' = ve e2 in
+ if e1' != e1 || e2' != e2 then INDEX (e1', e2') else e
+ | MEMBEROF (e1, n) ->
+ let e1' = ve e1 in
+ if e1' != e1 then MEMBEROF (e1', n) else e
+ | MEMBEROFPTR (e1, n) ->
+ let e1' = ve e1 in
+ if e1' != e1 then MEMBEROFPTR (e1', n) else e
+ | GNU_BODY b ->
+ let b' = visitCabsBlock vis b in
+ if b' != b then GNU_BODY b' else e
+ | EXPR_PATTERN _ -> e
+
+and visitCabsInitExpression vis (ie: init_expression) : init_expression =
+ doVisit vis vis#vinitexpr childrenInitExpression ie
+and childrenInitExpression vis ie =
+ let rec childrenInitWhat iw =
+ match iw with
+ NEXT_INIT -> iw
+ | INFIELD_INIT (n, iw1) ->
+ let iw1' = childrenInitWhat iw1 in
+ if iw1' != iw1 then INFIELD_INIT (n, iw1') else iw
+ | ATINDEX_INIT (e, iw1) ->
+ let e' = visitCabsExpression vis e in
+ let iw1' = childrenInitWhat iw1 in
+ if e' != e || iw1' != iw1 then ATINDEX_INIT (e', iw1') else iw
+ | ATINDEXRANGE_INIT (e1, e2) ->
+ let e1' = visitCabsExpression vis e1 in
+ let e2' = visitCabsExpression vis e2 in
+ if e1' != e1 || e2' != e2 then ATINDEXRANGE_INIT (e1, e2) else iw
+ in
+ match ie with
+ NO_INIT -> ie
+ | SINGLE_INIT e ->
+ let e' = visitCabsExpression vis e in
+ if e' != e then SINGLE_INIT e' else ie
+ | COMPOUND_INIT il ->
+ let childrenOne ((iw, ie) as input) =
+ let iw' = childrenInitWhat iw in
+ let ie' = visitCabsInitExpression vis ie in
+ if iw' != iw || ie' != ie then (iw', ie') else input
+ in
+ let il' = mapNoCopy childrenOne il in
+ if il' != il then COMPOUND_INIT il' else ie
+
+
+and visitCabsAttribute vis (a: attribute) : attribute list =
+ doVisitList vis vis#vattr childrenAttribute a
+
+and childrenAttribute vis ((n, el) as input) =
+ let el' = mapNoCopy (visitCabsExpression vis) el in
+ if el' != el then (n, el') else input
+
+and visitCabsAttributes vis (al: attribute list) : attribute list =
+ mapNoCopyList (visitCabsAttribute vis) al
+
+let visitCabsFile (vis: cabsVisitor) ((fname, f): file) : file =
+ (fname, mapNoCopyList (visitCabsDefinition vis) f)
+
+ (* end of file *)
+
diff --git a/cil/src/frontc/cabsvisit.mli b/cil/src/frontc/cabsvisit.mli
new file mode 100644
index 0000000..d238789
--- /dev/null
+++ b/cil/src/frontc/cabsvisit.mli
@@ -0,0 +1,115 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* cabsvisit.mli *)
+(* interface for cabsvisit.ml *)
+
+(* Different visiting actions. 'a will be instantiated with exp, instr, etc. *)
+type 'a visitAction =
+ SkipChildren (* Do not visit the children. Return
+ * the node as it is *)
+ | ChangeTo of 'a (* Replace the expression with the
+ * given one *)
+ | DoChildren (* Continue with the children of this
+ * node. Rebuild the node on return
+ * if any of the children changes
+ * (use == test) *)
+ | ChangeDoChildrenPost of 'a * ('a -> 'a) (* First consider that the entire
+ * exp is replaced by the first
+ * paramenter. Then continue with
+ * the children. On return rebuild
+ * the node if any of the children
+ * has changed and then apply the
+ * function on the node *)
+
+type nameKind =
+ NVar (** Variable or function prototype
+ name *)
+ | NFun (** Function definition name *)
+ | NField (** The name of a field *)
+ | NType (** The name of a type *)
+
+
+(* All visit methods are called in preorder! (but you can use
+ * ChangeDoChildrenPost to change the order) *)
+class type cabsVisitor = object
+ method vexpr: Cabs.expression -> Cabs.expression visitAction (* expressions *)
+ method vinitexpr: Cabs.init_expression -> Cabs.init_expression visitAction
+ method vstmt: Cabs.statement -> Cabs.statement list visitAction
+ method vblock: Cabs.block -> Cabs.block visitAction
+ method vvar: string -> string (* use of a variable
+ * names *)
+ method vdef: Cabs.definition -> Cabs.definition list visitAction
+ method vtypespec: Cabs.typeSpecifier -> Cabs.typeSpecifier visitAction
+ method vdecltype: Cabs.decl_type -> Cabs.decl_type visitAction
+
+ (* For each declaration we call vname *)
+ method vname: nameKind -> Cabs.specifier -> Cabs.name -> Cabs.name visitAction
+ method vspec: Cabs.specifier -> Cabs.specifier visitAction (* specifier *)
+ method vattr: Cabs.attribute -> Cabs.attribute list visitAction
+
+
+ method vEnterScope: unit -> unit
+ method vExitScope: unit -> unit
+end
+
+
+class nopCabsVisitor: cabsVisitor
+
+
+val visitCabsTypeSpecifier: cabsVisitor ->
+ Cabs.typeSpecifier -> Cabs.typeSpecifier
+val visitCabsSpecifier: cabsVisitor -> Cabs.specifier -> Cabs.specifier
+
+(** Visits a decl_type. The bool argument is saying whether we are ina
+ * function definition and thus the scope in a PROTO should extend until the
+ * end of the function *)
+val visitCabsDeclType: cabsVisitor -> bool -> Cabs.decl_type -> Cabs.decl_type
+val visitCabsDefinition: cabsVisitor -> Cabs.definition -> Cabs.definition list
+val visitCabsBlock: cabsVisitor -> Cabs.block -> Cabs.block
+val visitCabsStatement: cabsVisitor -> Cabs.statement -> Cabs.statement list
+val visitCabsExpression: cabsVisitor -> Cabs.expression -> Cabs.expression
+val visitCabsAttributes: cabsVisitor -> Cabs.attribute list
+ -> Cabs.attribute list
+val visitCabsName: cabsVisitor -> nameKind
+ -> Cabs.specifier -> Cabs.name -> Cabs.name
+val visitCabsFile: cabsVisitor -> Cabs.file -> Cabs.file
+
+
+
+(** Set by the visitor to the current location *)
+val visitorLocation: Cabs.cabsloc ref
diff --git a/cil/src/frontc/clexer.mli b/cil/src/frontc/clexer.mli
new file mode 100644
index 0000000..01acfd0
--- /dev/null
+++ b/cil/src/frontc/clexer.mli
@@ -0,0 +1,55 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(* This interface is generated manually. The corresponding .ml file is
+ * generated automatically and is placed in ../obj/clexer.ml. The reason we
+ * want this interface is to avoid confusing make with freshly generated
+ * interface files *)
+
+
+val init: filename:string -> Lexing.lexbuf
+val finish: unit -> unit
+
+(* This is the main parser function *)
+val initial: Lexing.lexbuf -> Cparser.token
+
+
+val push_context: unit -> unit (* Start a context *)
+val add_type: string -> unit (* Add a new string as a type name *)
+val add_identifier: string -> unit (* Add a new string as a variable name *)
+val pop_context: unit -> unit (* Remove all names added in this context *)
diff --git a/cil/src/frontc/clexer.mll b/cil/src/frontc/clexer.mll
new file mode 100644
index 0000000..08f7881
--- /dev/null
+++ b/cil/src/frontc/clexer.mll
@@ -0,0 +1,664 @@
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(* FrontC -- lexical analyzer
+**
+** 1.0 3.22.99 Hugues Cassé First version.
+** 2.0 George Necula 12/12/00: Many extensions
+*)
+{
+open Cparser
+open Pretty
+exception Eof
+exception InternalError of string
+module E = Errormsg
+module H = Hashtbl
+
+let matchingParsOpen = ref 0
+
+let currentLoc () =
+ let l, f, c = E.getPosition () in
+ { Cabs.lineno = l;
+ Cabs.filename = f;
+ Cabs.byteno = c;}
+
+(* string -> unit *)
+let addComment c =
+ let l = currentLoc() in
+ let i = GrowArray.max_init_index Cabs.commentsGA in
+ GrowArray.setg Cabs.commentsGA (i+1) (l,c,false)
+
+let int64_to_char value =
+ if (compare value (Int64.of_int 255) > 0) || (compare value Int64.zero < 0) then
+ begin
+ let msg = Printf.sprintf "clexer:intlist_to_string: character 0x%Lx too big" value in
+ E.parse_error msg;
+ end
+ else
+ Char.chr (Int64.to_int value)
+
+(* takes a not-nul-terminated list, and converts it to a string. *)
+let rec intlist_to_string (str: int64 list):string =
+ match str with
+ [] -> "" (* add nul-termination *)
+ | value::rest ->
+ let this_char = int64_to_char value in
+ (String.make 1 this_char) ^ (intlist_to_string rest)
+
+(* Some debugging support for line numbers *)
+let dbgToken (t: token) =
+ if false then begin
+ ignore (E.log "%a" insert
+ (match t with
+ IDENT (n, l) -> dprintf "IDENT(%s,%d)\n" n l.Cabs.lineno
+ | LBRACE l -> dprintf "LBRACE(%d)\n" l.Cabs.lineno
+ | RBRACE l -> dprintf "RBRACE(%d)\n" l.Cabs.lineno
+ | IF l -> dprintf "IF(%d)\n" l.Cabs.lineno
+ | SWITCH l -> dprintf "SWITCH(%d)\n" l.Cabs.lineno
+ | RETURN l -> dprintf "RETURN(%d)\n" l.Cabs.lineno
+ | _ -> nil));
+ t
+ end else
+ t
+
+
+(*
+** Keyword hashtable
+*)
+let lexicon = H.create 211
+let init_lexicon _ =
+ H.clear lexicon;
+ List.iter
+ (fun (key, builder) -> H.add lexicon key builder)
+ [ ("auto", fun loc -> AUTO loc);
+ ("const", fun loc -> CONST loc);
+ ("__const", fun loc -> CONST loc);
+ ("__const__", fun loc -> CONST loc);
+ ("static", fun loc -> STATIC loc);
+ ("extern", fun loc -> EXTERN loc);
+ ("long", fun loc -> LONG loc);
+ ("short", fun loc -> SHORT loc);
+ ("register", fun loc -> REGISTER loc);
+ ("signed", fun loc -> SIGNED loc);
+ ("__signed", fun loc -> SIGNED loc);
+ ("unsigned", fun loc -> UNSIGNED loc);
+ ("volatile", fun loc -> VOLATILE loc);
+ ("__volatile", fun loc -> VOLATILE loc);
+ (* WW: see /usr/include/sys/cdefs.h for why __signed and __volatile
+ * are accepted GCC-isms *)
+ ("char", fun loc -> CHAR loc);
+ ("int", fun loc -> INT loc);
+ ("float", fun loc -> FLOAT loc);
+ ("double", fun loc -> DOUBLE loc);
+ ("void", fun loc -> VOID loc);
+ ("enum", fun loc -> ENUM loc);
+ ("struct", fun loc -> STRUCT loc);
+ ("typedef", fun loc -> TYPEDEF loc);
+ ("union", fun loc -> UNION loc);
+ ("break", fun loc -> BREAK loc);
+ ("continue", fun loc -> CONTINUE loc);
+ ("goto", fun loc -> GOTO loc);
+ ("return", fun loc -> dbgToken (RETURN loc));
+ ("switch", fun loc -> dbgToken (SWITCH loc));
+ ("case", fun loc -> CASE loc);
+ ("default", fun loc -> DEFAULT loc);
+ ("while", fun loc -> WHILE loc);
+ ("do", fun loc -> DO loc);
+ ("for", fun loc -> FOR loc);
+ ("if", fun loc -> dbgToken (IF loc));
+ ("else", fun _ -> ELSE);
+ (*** Implementation specific keywords ***)
+ ("__signed__", fun loc -> SIGNED loc);
+ ("__inline__", fun loc -> INLINE loc);
+ ("inline", fun loc -> INLINE loc);
+ ("__inline", fun loc -> INLINE loc);
+ ("_inline", fun loc -> INLINE loc);
+ ("__attribute__", fun loc -> ATTRIBUTE loc);
+ ("__attribute", fun loc -> ATTRIBUTE loc);
+(*
+ ("__attribute_used__", fun loc -> ATTRIBUTE_USED loc);
+*)
+ ("__blockattribute__", fun _ -> BLOCKATTRIBUTE);
+ ("__blockattribute", fun _ -> BLOCKATTRIBUTE);
+ ("__asm__", fun loc -> ASM loc);
+ ("asm", fun loc -> ASM loc);
+ ("__typeof__", fun loc -> TYPEOF loc);
+ ("__typeof", fun loc -> TYPEOF loc);
+ ("typeof", fun loc -> TYPEOF loc);
+ ("__alignof", fun loc -> ALIGNOF loc);
+ ("__alignof__", fun loc -> ALIGNOF loc);
+ ("__volatile__", fun loc -> VOLATILE loc);
+ ("__volatile", fun loc -> VOLATILE loc);
+
+ ("__FUNCTION__", fun loc -> FUNCTION__ loc);
+ ("__func__", fun loc -> FUNCTION__ loc); (* ISO 6.4.2.2 *)
+ ("__PRETTY_FUNCTION__", fun loc -> PRETTY_FUNCTION__ loc);
+ ("__label__", fun _ -> LABEL__);
+ (*** weimer: GCC arcana ***)
+ ("__restrict", fun loc -> RESTRICT loc);
+ ("restrict", fun loc -> RESTRICT loc);
+(* ("__extension__", EXTENSION); *)
+ (**** MS VC ***)
+ ("__int64", fun _ -> INT64 (currentLoc ()));
+ ("__int32", fun loc -> INT loc);
+ ("_cdecl", fun _ -> MSATTR ("_cdecl", currentLoc ()));
+ ("__cdecl", fun _ -> MSATTR ("__cdecl", currentLoc ()));
+ ("_stdcall", fun _ -> MSATTR ("_stdcall", currentLoc ()));
+ ("__stdcall", fun _ -> MSATTR ("__stdcall", currentLoc ()));
+ ("_fastcall", fun _ -> MSATTR ("_fastcall", currentLoc ()));
+ ("__fastcall", fun _ -> MSATTR ("__fastcall", currentLoc ()));
+ ("__w64", fun _ -> MSATTR("__w64", currentLoc ()));
+ ("__declspec", fun loc -> DECLSPEC loc);
+ ("__forceinline", fun loc -> INLINE loc); (* !! we turn forceinline
+ * into inline *)
+ ("__try", fun loc -> TRY loc);
+ ("__except", fun loc -> EXCEPT loc);
+ ("__finally", fun loc -> FINALLY loc);
+ (* weimer: some files produced by 'GCC -E' expect this type to be
+ * defined *)
+ ("__builtin_va_list",
+ fun _ -> NAMED_TYPE ("__builtin_va_list", currentLoc ()));
+ ("__builtin_va_arg", fun loc -> BUILTIN_VA_ARG loc);
+ ("__builtin_types_compatible_p", fun loc -> BUILTIN_TYPES_COMPAT loc);
+ ("__builtin_offsetof", fun loc -> BUILTIN_OFFSETOF loc);
+ (* On some versions of GCC __thread is a regular identifier *)
+ ("__thread", fun loc ->
+ if Machdep.__thread_is_keyword then
+ THREAD loc
+ else
+ IDENT ("__thread", loc));
+ ]
+
+(* Mark an identifier as a type name. The old mapping is preserved and will
+ * be reinstated when we exit this context *)
+let add_type name =
+ (* ignore (print_string ("adding type name " ^ name ^ "\n")); *)
+ H.add lexicon name (fun loc -> NAMED_TYPE (name, loc))
+
+let context : string list list ref = ref []
+
+let push_context _ = context := []::!context
+
+let pop_context _ =
+ match !context with
+ [] -> raise (InternalError "Empty context stack")
+ | con::sub ->
+ (context := sub;
+ List.iter (fun name ->
+ (* ignore (print_string ("removing lexicon for " ^ name ^ "\n")); *)
+ H.remove lexicon name) con)
+
+(* Mark an identifier as a variable name. The old mapping is preserved and
+ * will be reinstated when we exit this context *)
+let add_identifier name =
+ match !context with
+ [] -> () (* Just ignore raise (InternalError "Empty context stack") *)
+ | con::sub ->
+ (context := (name::con)::sub;
+ (* print_string ("adding IDENT for " ^ name ^ "\n"); *)
+ H.add lexicon name (fun loc ->
+ dbgToken (IDENT (name, loc))))
+
+
+(*
+** Useful primitives
+*)
+let scan_ident id =
+ let here = currentLoc () in
+ try (H.find lexicon id) here
+ (* default to variable name, as opposed to type *)
+ with Not_found -> dbgToken (IDENT (id, here))
+
+
+(*
+** Buffer processor
+*)
+
+
+let init ~(filename: string) : Lexing.lexbuf =
+ init_lexicon ();
+ (* Inititialize the pointer in Errormsg *)
+ Lexerhack.add_type := add_type;
+ Lexerhack.push_context := push_context;
+ Lexerhack.pop_context := pop_context;
+ Lexerhack.add_identifier := add_identifier;
+ E.startParsing filename
+
+
+let finish () =
+ E.finishParsing ()
+
+(*** Error handling ***)
+let error msg =
+ E.parse_error msg
+
+
+(*** escape character management ***)
+let scan_escape (char: char) : int64 =
+ let result = match char with
+ 'n' -> '\n'
+ | 'r' -> '\r'
+ | 't' -> '\t'
+ | 'b' -> '\b'
+ | 'f' -> '\012' (* ASCII code 12 *)
+ | 'v' -> '\011' (* ASCII code 11 *)
+ | 'a' -> '\007' (* ASCII code 7 *)
+ | 'e' | 'E' -> '\027' (* ASCII code 27. This is a GCC extension *)
+ | '\'' -> '\''
+ | '"'-> '"' (* '"' *)
+ | '?' -> '?'
+ | '(' when not !Cprint.msvcMode -> '('
+ | '{' when not !Cprint.msvcMode -> '{'
+ | '[' when not !Cprint.msvcMode -> '['
+ | '%' when not !Cprint.msvcMode -> '%'
+ | '\\' -> '\\'
+ | other -> error ("Unrecognized escape sequence: \\" ^ (String.make 1 other))
+ in
+ Int64.of_int (Char.code result)
+
+let scan_hex_escape str =
+ let radix = Int64.of_int 16 in
+ let the_value = ref Int64.zero in
+ (* start at character 2 to skip the \x *)
+ for i = 2 to (String.length str) - 1 do
+ let thisDigit = Cabs.valueOfDigit (String.get str i) in
+ (* the_value := !the_value * 16 + thisDigit *)
+ the_value := Int64.add (Int64.mul !the_value radix) thisDigit
+ done;
+ !the_value
+
+let scan_oct_escape str =
+ let radix = Int64.of_int 8 in
+ let the_value = ref Int64.zero in
+ (* start at character 1 to skip the \x *)
+ for i = 1 to (String.length str) - 1 do
+ let thisDigit = Cabs.valueOfDigit (String.get str i) in
+ (* the_value := !the_value * 8 + thisDigit *)
+ the_value := Int64.add (Int64.mul !the_value radix) thisDigit
+ done;
+ !the_value
+
+let lex_hex_escape remainder lexbuf =
+ let prefix = scan_hex_escape (Lexing.lexeme lexbuf) in
+ prefix :: remainder lexbuf
+
+let lex_oct_escape remainder lexbuf =
+ let prefix = scan_oct_escape (Lexing.lexeme lexbuf) in
+ prefix :: remainder lexbuf
+
+let lex_simple_escape remainder lexbuf =
+ let lexchar = Lexing.lexeme_char lexbuf 1 in
+ let prefix = scan_escape lexchar in
+ prefix :: remainder lexbuf
+
+let lex_unescaped remainder lexbuf =
+ let prefix = Int64.of_int (Char.code (Lexing.lexeme_char lexbuf 0)) in
+ prefix :: remainder lexbuf
+
+let lex_comment remainder lexbuf =
+ let ch = Lexing.lexeme_char lexbuf 0 in
+ let prefix = Int64.of_int (Char.code ch) in
+ if ch = '\n' then E.newline();
+ prefix :: remainder lexbuf
+
+let make_char (i:int64):char =
+ let min_val = Int64.zero in
+ let max_val = Int64.of_int 255 in
+ (* if i < 0 || i > 255 then error*)
+ if compare i min_val < 0 || compare i max_val > 0 then begin
+ let msg = Printf.sprintf "clexer:make_char: character 0x%Lx too big" i in
+ error msg
+ end;
+ Char.chr (Int64.to_int i)
+
+
+(* ISO standard locale-specific function to convert a wide character
+ * into a sequence of normal characters. Here we work on strings.
+ * We convert L"Hi" to "H\000i\000"
+ matth: this seems unused.
+let wbtowc wstr =
+ let len = String.length wstr in
+ let dest = String.make (len * 2) '\000' in
+ for i = 0 to len-1 do
+ dest.[i*2] <- wstr.[i] ;
+ done ;
+ dest
+*)
+
+(* This function converst the "Hi" in L"Hi" to { L'H', L'i', L'\0' }
+ matth: this seems unused.
+let wstr_to_warray wstr =
+ let len = String.length wstr in
+ let res = ref "{ " in
+ for i = 0 to len-1 do
+ res := !res ^ (Printf.sprintf "L'%c', " wstr.[i])
+ done ;
+ res := !res ^ "}" ;
+ !res
+*)
+
+(* Pragmas get explicit end-of-line tokens.
+ * Elsewhere they are silently discarded as whitespace. *)
+let pragmaLine = ref false
+
+}
+
+let decdigit = ['0'-'9']
+let octdigit = ['0'-'7']
+let hexdigit = ['0'-'9' 'a'-'f' 'A'-'F']
+let letter = ['a'- 'z' 'A'-'Z']
+
+
+let usuffix = ['u' 'U']
+let lsuffix = "l"|"L"|"ll"|"LL"
+let intsuffix = lsuffix | usuffix | usuffix lsuffix | lsuffix usuffix
+ | usuffix ? "i64"
+
+
+let hexprefix = '0' ['x' 'X']
+
+let intnum = decdigit+ intsuffix?
+let octnum = '0' octdigit+ intsuffix?
+let hexnum = hexprefix hexdigit+ intsuffix?
+
+let exponent = ['e' 'E']['+' '-']? decdigit+
+let fraction = '.' decdigit+
+let decfloat = (intnum? fraction)
+ |(intnum exponent)
+ |(intnum? fraction exponent)
+ | (intnum '.')
+ | (intnum '.' exponent)
+
+let hexfraction = hexdigit* '.' hexdigit+ | hexdigit+
+let binexponent = ['p' 'P'] ['+' '-']? decdigit+
+let hexfloat = hexprefix hexfraction binexponent
+ | hexprefix hexdigit+ binexponent
+
+let floatsuffix = ['f' 'F' 'l' 'L']
+let floatnum = (decfloat | hexfloat) floatsuffix?
+
+let ident = (letter|'_')(letter|decdigit|'_'|'$')*
+let blank = [' ' '\t' '\012' '\r']+
+let escape = '\\' _
+let hex_escape = '\\' ['x' 'X'] hexdigit+
+let oct_escape = '\\' octdigit octdigit? octdigit?
+
+(* Pragmas that are not parsed by CIL. We lex them as PRAGMA_LINE tokens *)
+let no_parse_pragma =
+ "warning" | "GCC"
+ (* Solaris-style pragmas: *)
+ | "ident" | "section" | "option" | "asm" | "use_section" | "weak"
+ | "redefine_extname"
+ | "TCS_align"
+
+
+rule initial =
+ parse "/*" { let il = comment lexbuf in
+ let sl = intlist_to_string il in
+ addComment sl;
+ initial lexbuf}
+| "//" { let il = onelinecomment lexbuf in
+ let sl = intlist_to_string il in
+ addComment sl;
+ E.newline();
+ initial lexbuf
+ }
+| blank {initial lexbuf}
+| '\n' { E.newline ();
+ if !pragmaLine then
+ begin
+ pragmaLine := false;
+ PRAGMA_EOL
+ end
+ else
+ initial lexbuf }
+| '\\' '\r' * '\n' {
+ E.newline ();
+ initial lexbuf
+ }
+| '#' { hash lexbuf}
+| "_Pragma" { PRAGMA (currentLoc ()) }
+| '\'' { CST_CHAR (chr lexbuf, currentLoc ())}
+| "L'" { CST_WCHAR (chr lexbuf, currentLoc ()) }
+| '"' { (* '"' *)
+(* matth: BUG: this could be either a regular string or a wide string.
+ * e.g. if it's the "world" in
+ * L"Hello, " "world"
+ * then it should be treated as wide even though there's no L immediately
+ * preceding it. See test/small1/wchar5.c for a failure case. *)
+ try CST_STRING (str lexbuf, currentLoc ())
+ with e ->
+ raise (InternalError
+ ("str: " ^
+ Printexc.to_string e))}
+| "L\"" { (* weimer: wchar_t string literal *)
+ try CST_WSTRING(str lexbuf, currentLoc ())
+ with e ->
+ raise (InternalError
+ ("wide string: " ^
+ Printexc.to_string e))}
+| floatnum {CST_FLOAT (Lexing.lexeme lexbuf, currentLoc ())}
+| hexnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())}
+| octnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())}
+| intnum {CST_INT (Lexing.lexeme lexbuf, currentLoc ())}
+| "!quit!" {EOF}
+| "..." {ELLIPSIS}
+| "+=" {PLUS_EQ}
+| "-=" {MINUS_EQ}
+| "*=" {STAR_EQ}
+| "/=" {SLASH_EQ}
+| "%=" {PERCENT_EQ}
+| "|=" {PIPE_EQ}
+| "&=" {AND_EQ}
+| "^=" {CIRC_EQ}
+| "<<=" {INF_INF_EQ}
+| ">>=" {SUP_SUP_EQ}
+| "<<" {INF_INF}
+| ">>" {SUP_SUP}
+| "==" {EQ_EQ}
+| "!=" {EXCLAM_EQ}
+| "<=" {INF_EQ}
+| ">=" {SUP_EQ}
+| "=" {EQ}
+| "<" {INF}
+| ">" {SUP}
+| "++" {PLUS_PLUS (currentLoc ())}
+| "--" {MINUS_MINUS (currentLoc ())}
+| "->" {ARROW}
+| '+' {PLUS (currentLoc ())}
+| '-' {MINUS (currentLoc ())}
+| '*' {STAR (currentLoc ())}
+| '/' {SLASH}
+| '%' {PERCENT}
+| '!' {EXCLAM (currentLoc ())}
+| "&&" {AND_AND (currentLoc ())}
+| "||" {PIPE_PIPE}
+| '&' {AND (currentLoc ())}
+| '|' {PIPE}
+| '^' {CIRC}
+| '?' {QUEST}
+| ':' {COLON}
+| '~' {TILDE (currentLoc ())}
+
+| '{' {dbgToken (LBRACE (currentLoc ()))}
+| '}' {dbgToken (RBRACE (currentLoc ()))}
+| '[' {LBRACKET}
+| ']' {RBRACKET}
+| '(' {dbgToken (LPAREN (currentLoc ())) }
+| ')' {RPAREN}
+| ';' {dbgToken (SEMICOLON (currentLoc ())) }
+| ',' {COMMA}
+| '.' {DOT}
+| "sizeof" {SIZEOF (currentLoc ())}
+| "__asm" { if !Cprint.msvcMode then
+ MSASM (msasm lexbuf, currentLoc ())
+ else (ASM (currentLoc ())) }
+
+(* If we see __pragma we eat it and the matching parentheses as well *)
+| "__pragma" { matchingParsOpen := 0;
+ let _ = matchingpars lexbuf in
+ initial lexbuf
+ }
+
+(* sm: tree transformation keywords *)
+| "@transform" {AT_TRANSFORM (currentLoc ())}
+| "@transformExpr" {AT_TRANSFORMEXPR (currentLoc ())}
+| "@specifier" {AT_SPECIFIER (currentLoc ())}
+| "@expr" {AT_EXPR (currentLoc ())}
+| "@name" {AT_NAME}
+
+(* __extension__ is a black. The parser runs into some conflicts if we let it
+ * pass *)
+| "__extension__" {initial lexbuf }
+| ident {scan_ident (Lexing.lexeme lexbuf)}
+| eof {EOF}
+| _ {E.parse_error "Invalid symbol"}
+and comment =
+ parse
+ "*/" { [] }
+(*| '\n' { E.newline (); lex_unescaped comment lexbuf }*)
+| _ { lex_comment comment lexbuf }
+
+
+and onelinecomment = parse
+ '\n' {[]}
+| _ { lex_comment onelinecomment lexbuf }
+
+and matchingpars = parse
+ '\n' { E.newline (); matchingpars lexbuf }
+| blank { matchingpars lexbuf }
+| '(' { incr matchingParsOpen; matchingpars lexbuf }
+| ')' { decr matchingParsOpen;
+ if !matchingParsOpen = 0 then
+ ()
+ else
+ matchingpars lexbuf
+ }
+| "/*" { let il = comment lexbuf in
+ let sl = intlist_to_string il in
+ addComment sl;
+ matchingpars lexbuf}
+| '"' { (* '"' *)
+ let _ = str lexbuf in
+ matchingpars lexbuf
+ }
+| _ { matchingpars lexbuf }
+
+(* # <line number> <file name> ... *)
+and hash = parse
+ '\n' { E.newline (); initial lexbuf}
+| blank { hash lexbuf}
+| intnum { (* We are seeing a line number. This is the number for the
+ * next line *)
+ let s = Lexing.lexeme lexbuf in
+ begin try
+ E.setCurrentLine (int_of_string s - 1)
+ with Failure _ ->
+ E.warn "Bad line number in preprocessed file: %s" s
+ end;
+ (* A file name must follow *)
+ file lexbuf }
+| "line" { hash lexbuf } (* MSVC line number info *)
+ (* For pragmas with irregular syntax, like #pragma warning,
+ * we parse them as a whole line. *)
+| "pragma" blank (no_parse_pragma as pragmaName)
+ { let here = currentLoc () in
+ PRAGMA_LINE (pragmaName ^ pragma lexbuf, here)
+ }
+| "pragma" { pragmaLine := true; PRAGMA (currentLoc ()) }
+| _ { endline lexbuf}
+
+and file = parse
+ '\n' {E.newline (); initial lexbuf}
+| blank {file lexbuf}
+| '"' [^ '\012' '\t' '"']* '"' { (* '"' *)
+ let n = Lexing.lexeme lexbuf in
+ let n1 = String.sub n 1
+ ((String.length n) - 2) in
+ E.setCurrentFile n1;
+ endline lexbuf}
+
+| _ {endline lexbuf}
+
+and endline = parse
+ '\n' { E.newline (); initial lexbuf}
+| eof { EOF }
+| _ { endline lexbuf}
+
+and pragma = parse
+ '\n' { E.newline (); "" }
+| _ { let cur = Lexing.lexeme lexbuf in
+ cur ^ (pragma lexbuf) }
+
+and str = parse
+ '"' {[]} (* no nul terminiation in CST_STRING '"' *)
+| hex_escape {lex_hex_escape str lexbuf}
+| oct_escape {lex_oct_escape str lexbuf}
+| escape {lex_simple_escape str lexbuf}
+| _ {lex_unescaped str lexbuf}
+
+and chr = parse
+ '\'' {[]}
+| hex_escape {lex_hex_escape chr lexbuf}
+| oct_escape {lex_oct_escape chr lexbuf}
+| escape {lex_simple_escape chr lexbuf}
+| _ {lex_unescaped chr lexbuf}
+
+and msasm = parse
+ blank { msasm lexbuf }
+| '{' { msasminbrace lexbuf }
+| _ { let cur = Lexing.lexeme lexbuf in
+ cur ^ (msasmnobrace lexbuf) }
+
+and msasminbrace = parse
+ '}' { "" }
+| _ { let cur = Lexing.lexeme lexbuf in
+ cur ^ (msasminbrace lexbuf) }
+and msasmnobrace = parse
+ ['}' ';' '\n'] { lexbuf.Lexing.lex_curr_pos <-
+ lexbuf.Lexing.lex_curr_pos - 1;
+ "" }
+| "__asm" { lexbuf.Lexing.lex_curr_pos <-
+ lexbuf.Lexing.lex_curr_pos - 5;
+ "" }
+| _ { let cur = Lexing.lexeme lexbuf in
+
+ cur ^ (msasmnobrace lexbuf) }
+
+{
+
+}
diff --git a/cil/src/frontc/cparser.mly b/cil/src/frontc/cparser.mly
new file mode 100644
index 0000000..f1e1ef9
--- /dev/null
+++ b/cil/src/frontc/cparser.mly
@@ -0,0 +1,1521 @@
+/*(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ **)
+(**
+** 1.0 3.22.99 Hugues Cassé First version.
+** 2.0 George Necula 12/12/00: Practically complete rewrite.
+*)
+*/
+%{
+open Cabs
+module E = Errormsg
+
+let parse_error msg : unit = (* sm: c++-mode highlight hack: -> ' <- *)
+ E.parse_error msg
+
+let print = print_string
+
+(* unit -> string option *)
+(*
+let getComments () =
+ match !comments with
+ [] -> None
+ | _ ->
+ let r = Some(String.concat "\n" (List.rev !comments)) in
+ comments := [];
+ r
+*)
+
+let currentLoc () =
+ let l, f, c = E.getPosition () in
+ { lineno = l;
+ filename = f;
+ byteno = c;}
+
+let cabslu = {lineno = -10;
+ filename = "cabs loc unknown";
+ byteno = -10;}
+
+(* cabsloc -> cabsloc *)
+(*
+let handleLoc l =
+ l.clcomment <- getComments();
+ l
+*)
+
+(*
+** Expression building
+*)
+let smooth_expression lst =
+ match lst with
+ [] -> NOTHING
+ | [expr] -> expr
+ | _ -> COMMA (lst)
+
+
+let currentFunctionName = ref "<outside any function>"
+
+let announceFunctionName ((n, decl, _, _):name) =
+ !Lexerhack.add_identifier n;
+ (* Start a context that includes the parameter names and the whole body.
+ * Will pop when we finish parsing the function body *)
+ !Lexerhack.push_context ();
+ (* Go through all the parameter names and mark them as identifiers *)
+ let rec findProto = function
+ PROTO (d, args, _) when isJUSTBASE d ->
+ List.iter (fun (_, (an, _, _, _)) -> !Lexerhack.add_identifier an) args
+
+ | PROTO (d, _, _) -> findProto d
+ | PARENTYPE (_, d, _) -> findProto d
+ | PTR (_, d) -> findProto d
+ | ARRAY (d, _, _) -> findProto d
+ | _ -> parse_error "Cannot find the prototype in a function definition";
+ raise Parsing.Parse_error
+
+ and isJUSTBASE = function
+ JUSTBASE -> true
+ | PARENTYPE (_, d, _) -> isJUSTBASE d
+ | _ -> false
+ in
+ findProto decl;
+ currentFunctionName := n
+
+
+
+let applyPointer (ptspecs: attribute list list) (dt: decl_type)
+ : decl_type =
+ (* Outer specification first *)
+ let rec loop = function
+ [] -> dt
+ | attrs :: rest -> PTR(attrs, loop rest)
+ in
+ loop ptspecs
+
+let doDeclaration (loc: cabsloc) (specs: spec_elem list) (nl: init_name list) : definition =
+ if isTypedef specs then begin
+ (* Tell the lexer about the new type names *)
+ List.iter (fun ((n, _, _, _), _) -> !Lexerhack.add_type n) nl;
+ TYPEDEF ((specs, List.map (fun (n, _) -> n) nl), loc)
+ end else
+ if nl = [] then
+ ONLYTYPEDEF (specs, loc)
+ else begin
+ (* Tell the lexer about the new variable names *)
+ List.iter (fun ((n, _, _, _), _) -> !Lexerhack.add_identifier n) nl;
+ DECDEF ((specs, nl), loc)
+ end
+
+
+let doFunctionDef (loc: cabsloc)
+ (lend: cabsloc)
+ (specs: spec_elem list)
+ (n: name)
+ (b: block) : definition =
+ let fname = (specs, n) in
+ FUNDEF (fname, b, loc, lend)
+
+
+let doOldParDecl (names: string list)
+ ((pardefs: name_group list), (isva: bool))
+ : single_name list * bool =
+ let findOneName n =
+ (* Search in pardefs for the definition for this parameter *)
+ let rec loopGroups = function
+ [] -> ([SpecType Tint], (n, JUSTBASE, [], cabslu))
+ | (specs, names) :: restgroups ->
+ let rec loopNames = function
+ [] -> loopGroups restgroups
+ | ((n',_, _, _) as sn) :: _ when n' = n -> (specs, sn)
+ | _ :: restnames -> loopNames restnames
+ in
+ loopNames names
+ in
+ loopGroups pardefs
+ in
+ let args = List.map findOneName names in
+ (args, isva)
+
+let checkConnective (s : string) : unit =
+begin
+ (* checking this means I could possibly have more connectives, with *)
+ (* different meaning *)
+ if (s <> "to") then (
+ parse_error "transformer connective must be 'to'";
+ raise Parsing.Parse_error
+ )
+ else ()
+end
+
+let int64_to_char value =
+ if (compare value (Int64.of_int 255) > 0) || (compare value Int64.zero < 0) then
+ begin
+ let msg = Printf.sprintf "cparser:intlist_to_string: character 0x%Lx too big" value in
+ parse_error msg;
+ raise Parsing.Parse_error
+ end
+ else
+ Char.chr (Int64.to_int value)
+
+(* takes a not-nul-terminated list, and converts it to a string. *)
+let rec intlist_to_string (str: int64 list):string =
+ match str with
+ [] -> "" (* add nul-termination *)
+ | value::rest ->
+ let this_char = int64_to_char value in
+ (String.make 1 this_char) ^ (intlist_to_string rest)
+
+let fst3 (result, _, _) = result
+let snd3 (_, result, _) = result
+let trd3 (_, _, result) = result
+
+
+(*
+ transform: __builtin_offsetof(type, member)
+ into : (size_t) (&(type * ) 0)->member
+ *)
+
+let transformOffsetOf (speclist, dtype) member =
+ let rec addPointer = function
+ | JUSTBASE ->
+ PTR([], JUSTBASE)
+ | PARENTYPE (attrs1, dtype, attrs2) ->
+ PARENTYPE (attrs1, addPointer dtype, attrs2)
+ | ARRAY (dtype, attrs, expr) ->
+ ARRAY (addPointer dtype, attrs, expr)
+ | PTR (attrs, dtype) ->
+ PTR (attrs, addPointer dtype)
+ | PROTO (dtype, names, variadic) ->
+ PROTO (addPointer dtype, names, variadic)
+ in
+ let nullType = (speclist, addPointer dtype) in
+ let nullExpr = CONSTANT (CONST_INT "0") in
+ let castExpr = CAST (nullType, SINGLE_INIT nullExpr) in
+
+ let rec replaceBase = function
+ | VARIABLE field ->
+ MEMBEROFPTR (castExpr, field)
+ | MEMBEROF (base, field) ->
+ MEMBEROF (replaceBase base, field)
+ | INDEX (base, index) ->
+ INDEX (replaceBase base, index)
+ | _ ->
+ parse_error "malformed offset expression in __builtin_offsetof";
+ raise Parsing.Parse_error
+ in
+ let memberExpr = replaceBase member in
+ let addrExpr = UNARY (ADDROF, memberExpr) in
+ (* slight cheat: hard-coded assumption that size_t == unsigned int *)
+ let sizeofType = [SpecType Tunsigned], JUSTBASE in
+ let resultExpr = CAST (sizeofType, SINGLE_INIT addrExpr) in
+ resultExpr
+
+%}
+
+%token <string * Cabs.cabsloc> IDENT
+%token <int64 list * Cabs.cabsloc> CST_CHAR
+%token <int64 list * Cabs.cabsloc> CST_WCHAR
+%token <string * Cabs.cabsloc> CST_INT
+%token <string * Cabs.cabsloc> CST_FLOAT
+%token <string * Cabs.cabsloc> NAMED_TYPE
+
+/* Each character is its own list element, and the terminating nul is not
+ included in this list. */
+%token <int64 list * Cabs.cabsloc> CST_STRING
+%token <int64 list * Cabs.cabsloc> CST_WSTRING
+
+%token EOF
+%token<Cabs.cabsloc> CHAR INT DOUBLE FLOAT VOID INT64 INT32
+%token<Cabs.cabsloc> ENUM STRUCT TYPEDEF UNION
+%token<Cabs.cabsloc> SIGNED UNSIGNED LONG SHORT
+%token<Cabs.cabsloc> VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
+%token<Cabs.cabsloc> THREAD
+
+%token<Cabs.cabsloc> SIZEOF ALIGNOF
+
+%token EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
+%token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
+%token ARROW DOT
+
+%token EQ_EQ EXCLAM_EQ INF SUP INF_EQ SUP_EQ
+%token<Cabs.cabsloc> PLUS MINUS STAR
+%token SLASH PERCENT
+%token<Cabs.cabsloc> TILDE AND
+%token PIPE CIRC
+%token<Cabs.cabsloc> EXCLAM AND_AND
+%token PIPE_PIPE
+%token INF_INF SUP_SUP
+%token<Cabs.cabsloc> PLUS_PLUS MINUS_MINUS
+
+%token RPAREN
+%token<Cabs.cabsloc> LPAREN RBRACE
+%token<Cabs.cabsloc> LBRACE
+%token LBRACKET RBRACKET
+%token COLON
+%token<Cabs.cabsloc> SEMICOLON
+%token COMMA ELLIPSIS QUEST
+
+%token<Cabs.cabsloc> BREAK CONTINUE GOTO RETURN
+%token<Cabs.cabsloc> SWITCH CASE DEFAULT
+%token<Cabs.cabsloc> WHILE DO FOR
+%token<Cabs.cabsloc> IF TRY EXCEPT FINALLY
+%token ELSE
+
+%token<Cabs.cabsloc> ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__
+%token LABEL__
+%token<Cabs.cabsloc> BUILTIN_VA_ARG ATTRIBUTE_USED
+%token BUILTIN_VA_LIST
+%token BLOCKATTRIBUTE
+%token<Cabs.cabsloc> BUILTIN_TYPES_COMPAT BUILTIN_OFFSETOF
+%token<Cabs.cabsloc> DECLSPEC
+%token<string * Cabs.cabsloc> MSASM MSATTR
+%token<string * Cabs.cabsloc> PRAGMA_LINE
+%token<Cabs.cabsloc> PRAGMA
+%token PRAGMA_EOL
+
+/* sm: cabs tree transformation specification keywords */
+%token<Cabs.cabsloc> AT_TRANSFORM AT_TRANSFORMEXPR AT_SPECIFIER AT_EXPR
+%token AT_NAME
+
+/* operator precedence */
+%nonassoc IF
+%nonassoc ELSE
+
+
+%left COMMA
+%right EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
+ AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
+%right QUEST COLON
+%left PIPE_PIPE
+%left AND_AND
+%left PIPE
+%left CIRC
+%left AND
+%left EQ_EQ EXCLAM_EQ
+%left INF SUP INF_EQ SUP_EQ
+%left INF_INF SUP_SUP
+%left PLUS MINUS
+%left STAR SLASH PERCENT CONST RESTRICT VOLATILE
+%right EXCLAM TILDE PLUS_PLUS MINUS_MINUS CAST RPAREN ADDROF SIZEOF ALIGNOF
+%left LBRACKET
+%left DOT ARROW LPAREN LBRACE
+%right NAMED_TYPE /* We'll use this to handle redefinitions of
+ * NAMED_TYPE as variables */
+%left IDENT
+
+/* Non-terminals informations */
+%start interpret file
+%type <Cabs.definition list> file interpret globals
+
+%type <Cabs.definition> global
+
+
+%type <Cabs.attribute list> attributes attributes_with_asm asmattr
+%type <Cabs.statement> statement
+%type <Cabs.constant * cabsloc> constant
+%type <string * cabsloc> string_constant
+%type <Cabs.expression * cabsloc> expression
+%type <Cabs.expression> opt_expression
+%type <Cabs.init_expression> init_expression
+%type <Cabs.expression list * cabsloc> comma_expression
+%type <Cabs.expression list * cabsloc> paren_comma_expression
+%type <Cabs.expression list> arguments
+%type <Cabs.expression list> bracket_comma_expression
+%type <int64 list Queue.t * cabsloc> string_list
+%type <int64 list * cabsloc> wstring_list
+
+%type <Cabs.initwhat * Cabs.init_expression> initializer
+%type <(Cabs.initwhat * Cabs.init_expression) list> initializer_list
+%type <Cabs.initwhat> init_designators init_designators_opt
+
+%type <spec_elem list * cabsloc> decl_spec_list
+%type <typeSpecifier * cabsloc> type_spec
+%type <Cabs.field_group list> struct_decl_list
+
+
+%type <Cabs.name> old_proto_decl
+%type <Cabs.single_name> parameter_decl
+%type <Cabs.enum_item> enumerator
+%type <Cabs.enum_item list> enum_list
+%type <Cabs.definition> declaration function_def
+%type <cabsloc * spec_elem list * name> function_def_start
+%type <Cabs.spec_elem list * Cabs.decl_type> type_name
+%type <Cabs.block * cabsloc * cabsloc> block
+%type <Cabs.statement list> block_element_list
+%type <string list> local_labels local_label_names
+%type <string list> old_parameter_list_ne
+
+%type <Cabs.init_name> init_declarator
+%type <Cabs.init_name list> init_declarator_list
+%type <Cabs.name> declarator
+%type <Cabs.name * expression option> field_decl
+%type <(Cabs.name * expression option) list> field_decl_list
+%type <string * Cabs.decl_type> direct_decl
+%type <Cabs.decl_type> abs_direct_decl abs_direct_decl_opt
+%type <Cabs.decl_type * Cabs.attribute list> abstract_decl
+
+ /* (* Each element is a "* <type_quals_opt>". *) */
+%type <attribute list list * cabsloc> pointer pointer_opt
+%type <Cabs.cabsloc> location
+%type <Cabs.spec_elem * cabsloc> cvspec
+%%
+
+interpret:
+ file EOF {$1}
+;
+file: globals {$1}
+;
+globals:
+ /* empty */ { [] }
+| global globals { $1 :: $2 }
+| SEMICOLON globals { $2 }
+;
+
+location:
+ /* empty */ { currentLoc () } %prec IDENT
+
+
+/*** Global Definition ***/
+global:
+| declaration { $1 }
+| function_def { $1 }
+/*(* Some C header files ar shared with the C++ compiler and have linkage
+ * specification *)*/
+| EXTERN string_constant declaration { LINKAGE (fst $2, (*handleLoc*) (snd $2), [ $3 ]) }
+| EXTERN string_constant LBRACE globals RBRACE
+ { LINKAGE (fst $2, (*handleLoc*) (snd $2), $4) }
+| ASM LPAREN string_constant RPAREN SEMICOLON
+ { GLOBASM (fst $3, (*handleLoc*) $1) }
+| pragma { $1 }
+/* (* Old-style function prototype. This should be somewhere else, like in
+ * "declaration". For now we keep it at global scope only because in local
+ * scope it looks too much like a function call *) */
+| IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list SEMICOLON
+ { (* Convert pardecl to new style *)
+ let pardecl, isva = doOldParDecl $3 $5 in
+ (* Make the function declarator *)
+ doDeclaration ((*handleLoc*) (snd $1)) []
+ [((fst $1, PROTO(JUSTBASE, pardecl,isva), [], cabslu),
+ NO_INIT)]
+ }
+/* (* Old style function prototype, but without any arguments *) */
+| IDENT LPAREN RPAREN SEMICOLON
+ { (* Make the function declarator *)
+ doDeclaration ((*handleLoc*)(snd $1)) []
+ [((fst $1, PROTO(JUSTBASE,[],false), [], cabslu),
+ NO_INIT)]
+ }
+/* transformer for a toplevel construct */
+| AT_TRANSFORM LBRACE global RBRACE IDENT/*to*/ LBRACE globals RBRACE {
+ checkConnective(fst $5);
+ TRANSFORMER($3, $7, $1)
+ }
+/* transformer for an expression */
+| AT_TRANSFORMEXPR LBRACE expression RBRACE IDENT/*to*/ LBRACE expression RBRACE {
+ checkConnective(fst $5);
+ EXPRTRANSFORMER(fst $3, fst $7, $1)
+ }
+| location error SEMICOLON { PRAGMA (VARIABLE "parse_error", $1) }
+;
+
+id_or_typename:
+ IDENT {fst $1}
+| NAMED_TYPE {fst $1}
+| AT_NAME LPAREN IDENT RPAREN { "@name(" ^ fst $3 ^ ")" } /* pattern variable name */
+;
+
+maybecomma:
+ /* empty */ { () }
+| COMMA { () }
+;
+
+/* *** Expressions *** */
+
+primary_expression: /*(* 6.5.1. *)*/
+| IDENT
+ {VARIABLE (fst $1), snd $1}
+| constant
+ {CONSTANT (fst $1), snd $1}
+| paren_comma_expression
+ {smooth_expression (fst $1), snd $1}
+| LPAREN block RPAREN
+ { GNU_BODY (fst3 $2), $1 }
+
+ /*(* Next is Scott's transformer *)*/
+| AT_EXPR LPAREN IDENT RPAREN /* expression pattern variable */
+ { EXPR_PATTERN(fst $3), $1 }
+;
+
+postfix_expression: /*(* 6.5.2 *)*/
+| primary_expression
+ { $1 }
+| postfix_expression bracket_comma_expression
+ {INDEX (fst $1, smooth_expression $2), snd $1}
+| postfix_expression LPAREN arguments RPAREN
+ {CALL (fst $1, $3), snd $1}
+| BUILTIN_VA_ARG LPAREN expression COMMA type_name RPAREN
+ { let b, d = $5 in
+ CALL (VARIABLE "__builtin_va_arg",
+ [fst $3; TYPE_SIZEOF (b, d)]), $1 }
+| BUILTIN_TYPES_COMPAT LPAREN type_name COMMA type_name RPAREN
+ { let b1,d1 = $3 in
+ let b2,d2 = $5 in
+ CALL (VARIABLE "__builtin_types_compatible_p",
+ [TYPE_SIZEOF(b1,d1); TYPE_SIZEOF(b2,d2)]), $1 }
+| BUILTIN_OFFSETOF LPAREN type_name COMMA offsetof_member_designator RPAREN
+ { transformOffsetOf $3 (fst $5), $1 }
+| postfix_expression DOT id_or_typename
+ {MEMBEROF (fst $1, $3), snd $1}
+| postfix_expression ARROW id_or_typename
+ {MEMBEROFPTR (fst $1, $3), snd $1}
+| postfix_expression PLUS_PLUS
+ {UNARY (POSINCR, fst $1), snd $1}
+| postfix_expression MINUS_MINUS
+ {UNARY (POSDECR, fst $1), snd $1}
+/* (* We handle GCC constructor expressions *) */
+| LPAREN type_name RPAREN LBRACE initializer_list_opt RBRACE
+ { CAST($2, COMPOUND_INIT $5), $1 }
+;
+
+offsetof_member_designator: /* GCC extension for __builtin_offsetof */
+| IDENT
+ { VARIABLE (fst $1), snd $1 }
+| offsetof_member_designator DOT IDENT
+ { MEMBEROF (fst $1, fst $3), snd $1 }
+| offsetof_member_designator bracket_comma_expression
+ { INDEX (fst $1, smooth_expression $2), snd $1 }
+;
+
+unary_expression: /*(* 6.5.3 *)*/
+| postfix_expression
+ { $1 }
+| PLUS_PLUS unary_expression
+ {UNARY (PREINCR, fst $2), $1}
+| MINUS_MINUS unary_expression
+ {UNARY (PREDECR, fst $2), $1}
+| SIZEOF unary_expression
+ {EXPR_SIZEOF (fst $2), $1}
+| SIZEOF LPAREN type_name RPAREN
+ {let b, d = $3 in TYPE_SIZEOF (b, d), $1}
+| ALIGNOF unary_expression
+ {EXPR_ALIGNOF (fst $2), $1}
+| ALIGNOF LPAREN type_name RPAREN
+ {let b, d = $3 in TYPE_ALIGNOF (b, d), $1}
+| PLUS cast_expression
+ {UNARY (PLUS, fst $2), $1}
+| MINUS cast_expression
+ {UNARY (MINUS, fst $2), $1}
+| STAR cast_expression
+ {UNARY (MEMOF, fst $2), $1}
+| AND cast_expression
+ {UNARY (ADDROF, fst $2), $1}
+| EXCLAM cast_expression
+ {UNARY (NOT, fst $2), $1}
+| TILDE cast_expression
+ {UNARY (BNOT, fst $2), $1}
+| AND_AND IDENT { LABELADDR (fst $2), $1 }
+;
+
+cast_expression: /*(* 6.5.4 *)*/
+| unary_expression
+ { $1 }
+| LPAREN type_name RPAREN cast_expression
+ { CAST($2, SINGLE_INIT (fst $4)), $1 }
+;
+
+multiplicative_expression: /*(* 6.5.5 *)*/
+| cast_expression
+ { $1 }
+| multiplicative_expression STAR cast_expression
+ {BINARY(MUL, fst $1, fst $3), snd $1}
+| multiplicative_expression SLASH cast_expression
+ {BINARY(DIV, fst $1, fst $3), snd $1}
+| multiplicative_expression PERCENT cast_expression
+ {BINARY(MOD, fst $1, fst $3), snd $1}
+;
+
+additive_expression: /*(* 6.5.6 *)*/
+| multiplicative_expression
+ { $1 }
+| additive_expression PLUS multiplicative_expression
+ {BINARY(ADD, fst $1, fst $3), snd $1}
+| additive_expression MINUS multiplicative_expression
+ {BINARY(SUB, fst $1, fst $3), snd $1}
+;
+
+shift_expression: /*(* 6.5.7 *)*/
+| additive_expression
+ { $1 }
+| shift_expression INF_INF additive_expression
+ {BINARY(SHL, fst $1, fst $3), snd $1}
+| shift_expression SUP_SUP additive_expression
+ {BINARY(SHR, fst $1, fst $3), snd $1}
+;
+
+
+relational_expression: /*(* 6.5.8 *)*/
+| shift_expression
+ { $1 }
+| relational_expression INF shift_expression
+ {BINARY(LT, fst $1, fst $3), snd $1}
+| relational_expression SUP shift_expression
+ {BINARY(GT, fst $1, fst $3), snd $1}
+| relational_expression INF_EQ shift_expression
+ {BINARY(LE, fst $1, fst $3), snd $1}
+| relational_expression SUP_EQ shift_expression
+ {BINARY(GE, fst $1, fst $3), snd $1}
+;
+
+equality_expression: /*(* 6.5.9 *)*/
+| relational_expression
+ { $1 }
+| equality_expression EQ_EQ relational_expression
+ {BINARY(EQ, fst $1, fst $3), snd $1}
+| equality_expression EXCLAM_EQ relational_expression
+ {BINARY(NE, fst $1, fst $3), snd $1}
+;
+
+
+bitwise_and_expression: /*(* 6.5.10 *)*/
+| equality_expression
+ { $1 }
+| bitwise_and_expression AND equality_expression
+ {BINARY(BAND, fst $1, fst $3), snd $1}
+;
+
+bitwise_xor_expression: /*(* 6.5.11 *)*/
+| bitwise_and_expression
+ { $1 }
+| bitwise_xor_expression CIRC bitwise_and_expression
+ {BINARY(XOR, fst $1, fst $3), snd $1}
+;
+
+bitwise_or_expression: /*(* 6.5.12 *)*/
+| bitwise_xor_expression
+ { $1 }
+| bitwise_or_expression PIPE bitwise_xor_expression
+ {BINARY(BOR, fst $1, fst $3), snd $1}
+;
+
+logical_and_expression: /*(* 6.5.13 *)*/
+| bitwise_or_expression
+ { $1 }
+| logical_and_expression AND_AND bitwise_or_expression
+ {BINARY(AND, fst $1, fst $3), snd $1}
+;
+
+logical_or_expression: /*(* 6.5.14 *)*/
+| logical_and_expression
+ { $1 }
+| logical_or_expression PIPE_PIPE logical_and_expression
+ {BINARY(OR, fst $1, fst $3), snd $1}
+;
+
+conditional_expression: /*(* 6.5.15 *)*/
+| logical_or_expression
+ { $1 }
+| logical_or_expression QUEST opt_expression COLON conditional_expression
+ {QUESTION (fst $1, $3, fst $5), snd $1}
+;
+
+/*(* The C spec says that left-hand sides of assignment expressions are unary
+ * expressions. GCC allows cast expressions in there ! *)*/
+
+assignment_expression: /*(* 6.5.16 *)*/
+| conditional_expression
+ { $1 }
+| cast_expression EQ assignment_expression
+ {BINARY(ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression PLUS_EQ assignment_expression
+ {BINARY(ADD_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression MINUS_EQ assignment_expression
+ {BINARY(SUB_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression STAR_EQ assignment_expression
+ {BINARY(MUL_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression SLASH_EQ assignment_expression
+ {BINARY(DIV_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression PERCENT_EQ assignment_expression
+ {BINARY(MOD_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression AND_EQ assignment_expression
+ {BINARY(BAND_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression PIPE_EQ assignment_expression
+ {BINARY(BOR_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression CIRC_EQ assignment_expression
+ {BINARY(XOR_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression INF_INF_EQ assignment_expression
+ {BINARY(SHL_ASSIGN, fst $1, fst $3), snd $1}
+| cast_expression SUP_SUP_EQ assignment_expression
+ {BINARY(SHR_ASSIGN, fst $1, fst $3), snd $1}
+;
+
+expression: /*(* 6.5.17 *)*/
+ assignment_expression
+ { $1 }
+;
+
+
+constant:
+ CST_INT {CONST_INT (fst $1), snd $1}
+| CST_FLOAT {CONST_FLOAT (fst $1), snd $1}
+| CST_CHAR {CONST_CHAR (fst $1), snd $1}
+| CST_WCHAR {CONST_WCHAR (fst $1), snd $1}
+| string_constant {CONST_STRING (fst $1), snd $1}
+| wstring_list {CONST_WSTRING (fst $1), snd $1}
+;
+
+string_constant:
+/* Now that we know this constant isn't part of a wstring, convert it
+ back to a string for easy viewing. */
+ string_list {
+ let queue, location = $1 in
+ let buffer = Buffer.create (Queue.length queue) in
+ Queue.iter
+ (List.iter
+ (fun value ->
+ let char = int64_to_char value in
+ Buffer.add_char buffer char))
+ queue;
+ Buffer.contents buffer, location
+ }
+;
+one_string_constant:
+/* Don't concat multiple strings. For asm templates. */
+ CST_STRING {intlist_to_string (fst $1) }
+;
+string_list:
+ one_string {
+ let queue = Queue.create () in
+ Queue.add (fst $1) queue;
+ queue, snd $1
+ }
+| string_list one_string {
+ Queue.add (fst $2) (fst $1);
+ $1
+ }
+;
+
+wstring_list:
+ CST_WSTRING { $1 }
+| wstring_list one_string { (fst $1) @ (fst $2), snd $1 }
+| wstring_list CST_WSTRING { (fst $1) @ (fst $2), snd $1 }
+/* Only the first string in the list needs an L, so L"a" "b" is the same
+ * as L"ab" or L"a" L"b". */
+
+one_string:
+ CST_STRING {$1}
+| FUNCTION__ {(Cabs.explodeStringToInts
+ !currentFunctionName), $1}
+| PRETTY_FUNCTION__ {(Cabs.explodeStringToInts
+ !currentFunctionName), $1}
+;
+
+init_expression:
+ expression { SINGLE_INIT (fst $1) }
+| LBRACE initializer_list_opt RBRACE
+ { COMPOUND_INIT $2}
+
+initializer_list: /* ISO 6.7.8. Allow a trailing COMMA */
+ initializer { [$1] }
+| initializer COMMA initializer_list_opt { $1 :: $3 }
+;
+initializer_list_opt:
+ /* empty */ { [] }
+| initializer_list { $1 }
+;
+initializer:
+ init_designators eq_opt init_expression { ($1, $3) }
+| gcc_init_designators init_expression { ($1, $2) }
+| init_expression { (NEXT_INIT, $1) }
+;
+eq_opt:
+ EQ { () }
+ /*(* GCC allows missing = *)*/
+| /*(* empty *)*/ { () }
+;
+init_designators:
+ DOT id_or_typename init_designators_opt { INFIELD_INIT($2, $3) }
+| LBRACKET expression RBRACKET init_designators_opt
+ { ATINDEX_INIT(fst $2, $4) }
+| LBRACKET expression ELLIPSIS expression RBRACKET
+ { ATINDEXRANGE_INIT(fst $2, fst $4) }
+;
+init_designators_opt:
+ /* empty */ { NEXT_INIT }
+| init_designators { $1 }
+;
+
+gcc_init_designators: /*(* GCC supports these strange things *)*/
+ id_or_typename COLON { INFIELD_INIT($1, NEXT_INIT) }
+;
+
+arguments:
+ /* empty */ { [] }
+| comma_expression { fst $1 }
+;
+
+opt_expression:
+ /* empty */
+ {NOTHING}
+| comma_expression
+ {smooth_expression (fst $1)}
+;
+
+comma_expression:
+ expression {[fst $1], snd $1}
+| expression COMMA comma_expression { fst $1 :: fst $3, snd $1 }
+| error COMMA comma_expression { $3 }
+;
+
+comma_expression_opt:
+ /* empty */ { NOTHING }
+| comma_expression { smooth_expression (fst $1) }
+;
+
+paren_comma_expression:
+ LPAREN comma_expression RPAREN { $2 }
+| LPAREN error RPAREN { [], $1 }
+;
+
+bracket_comma_expression:
+ LBRACKET comma_expression RBRACKET { fst $2 }
+| LBRACKET error RBRACKET { [] }
+;
+
+
+/*** statements ***/
+block: /* ISO 6.8.2 */
+ block_begin local_labels block_attrs block_element_list RBRACE
+ {!Lexerhack.pop_context();
+ { blabels = $2;
+ battrs = $3;
+ bstmts = $4 },
+ $1, $5
+ }
+| error location RBRACE { { blabels = [];
+ battrs = [];
+ bstmts = [] },
+ $2, $3
+ }
+;
+block_begin:
+ LBRACE {!Lexerhack.push_context (); $1}
+;
+
+block_attrs:
+ /* empty */ { [] }
+| BLOCKATTRIBUTE paren_attr_list_ne
+ { [("__blockattribute__", $2)] }
+;
+
+/* statements and declarations in a block, in any order (for C99 support) */
+block_element_list:
+ /* empty */ { [] }
+| declaration block_element_list { DEFINITION($1) :: $2 }
+| statement block_element_list { $1 :: $2 }
+/*(* GCC accepts a label at the end of a block *)*/
+| IDENT COLON { [ LABEL (fst $1, NOP (snd $1),
+ snd $1)] }
+| pragma block_element_list { $2 }
+;
+
+local_labels:
+ /* empty */ { [] }
+| LABEL__ local_label_names SEMICOLON local_labels { $2 @ $4 }
+;
+local_label_names:
+ IDENT { [ fst $1 ] }
+| IDENT COMMA local_label_names { fst $1 :: $3 }
+;
+
+
+
+statement:
+ SEMICOLON {NOP ((*handleLoc*) $1) }
+| comma_expression SEMICOLON
+ {COMPUTATION (smooth_expression (fst $1), (*handleLoc*)(snd $1))}
+| block {BLOCK (fst3 $1, (*handleLoc*)(snd3 $1))}
+| IF paren_comma_expression statement %prec IF
+ {IF (smooth_expression (fst $2), $3, NOP $1, $1)}
+| IF paren_comma_expression statement ELSE statement
+ {IF (smooth_expression (fst $2), $3, $5, (*handleLoc*) $1)}
+| SWITCH paren_comma_expression statement
+ {SWITCH (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
+| WHILE paren_comma_expression statement
+ {WHILE (smooth_expression (fst $2), $3, (*handleLoc*) $1)}
+| DO statement WHILE paren_comma_expression SEMICOLON
+ {DOWHILE (smooth_expression (fst $4), $2, (*handleLoc*) $1)}
+| FOR LPAREN for_clause opt_expression
+ SEMICOLON opt_expression RPAREN statement
+ {FOR ($3, $4, $6, $8, (*handleLoc*) $1)}
+| IDENT COLON statement
+ {LABEL (fst $1, $3, (*handleLoc*) (snd $1))}
+| CASE expression COLON statement
+ {CASE (fst $2, $4, (*handleLoc*) $1)}
+| CASE expression ELLIPSIS expression COLON statement
+ {CASERANGE (fst $2, fst $4, $6, (*handleLoc*) $1)}
+| DEFAULT COLON
+ {DEFAULT (NOP $1, (*handleLoc*) $1)}
+| RETURN SEMICOLON {RETURN (NOTHING, (*handleLoc*) $1)}
+| RETURN comma_expression SEMICOLON
+ {RETURN (smooth_expression (fst $2), (*handleLoc*) $1)}
+| BREAK SEMICOLON {BREAK ((*handleLoc*) $1)}
+| CONTINUE SEMICOLON {CONTINUE ((*handleLoc*) $1)}
+| GOTO IDENT SEMICOLON
+ {GOTO (fst $2, (*handleLoc*) $1)}
+| GOTO STAR comma_expression SEMICOLON
+ { COMPGOTO (smooth_expression (fst $3), (*handleLoc*) $1) }
+| ASM asmattr LPAREN asmtemplate asmoutputs RPAREN SEMICOLON
+ { ASM ($2, $4, $5, (*handleLoc*) $1) }
+| MSASM { ASM ([], [fst $1], None, (*handleLoc*)(snd $1))}
+| TRY block EXCEPT paren_comma_expression block
+ { let b, _, _ = $2 in
+ let h, _, _ = $5 in
+ if not !Cprint.msvcMode then
+ parse_error "try/except in GCC code";
+ TRY_EXCEPT (b, COMMA (fst $4), h, (*handleLoc*) $1) }
+| TRY block FINALLY block
+ { let b, _, _ = $2 in
+ let h, _, _ = $4 in
+ if not !Cprint.msvcMode then
+ parse_error "try/finally in GCC code";
+ TRY_FINALLY (b, h, (*handleLoc*) $1) }
+
+| error location SEMICOLON { (NOP $2)}
+;
+
+
+for_clause:
+ opt_expression SEMICOLON { FC_EXP $1 }
+| declaration { FC_DECL $1 }
+;
+
+declaration: /* ISO 6.7.*/
+ decl_spec_list init_declarator_list SEMICOLON
+ { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) $2 }
+| decl_spec_list SEMICOLON
+ { doDeclaration ((*handleLoc*)(snd $1)) (fst $1) [] }
+;
+init_declarator_list: /* ISO 6.7 */
+ init_declarator { [$1] }
+| init_declarator COMMA init_declarator_list { $1 :: $3 }
+
+;
+init_declarator: /* ISO 6.7 */
+ declarator { ($1, NO_INIT) }
+| declarator EQ init_expression
+ { ($1, $3) }
+;
+
+decl_spec_list: /* ISO 6.7 */
+ /* ISO 6.7.1 */
+| TYPEDEF decl_spec_list_opt { SpecTypedef :: $2, $1 }
+| EXTERN decl_spec_list_opt { SpecStorage EXTERN :: $2, $1 }
+| STATIC decl_spec_list_opt { SpecStorage STATIC :: $2, $1 }
+| AUTO decl_spec_list_opt { SpecStorage AUTO :: $2, $1 }
+| REGISTER decl_spec_list_opt { SpecStorage REGISTER :: $2, $1}
+ /* ISO 6.7.2 */
+| type_spec decl_spec_list_opt_no_named { SpecType (fst $1) :: $2, snd $1 }
+ /* ISO 6.7.4 */
+| INLINE decl_spec_list_opt { SpecInline :: $2, $1 }
+| cvspec decl_spec_list_opt { (fst $1) :: $2, snd $1 }
+| attribute_nocv decl_spec_list_opt { SpecAttr (fst $1) :: $2, snd $1 }
+/* specifier pattern variable (must be last in spec list) */
+| AT_SPECIFIER LPAREN IDENT RPAREN { [ SpecPattern(fst $3) ], $1 }
+;
+/* (* In most cases if we see a NAMED_TYPE we must shift it. Thus we declare
+ * NAMED_TYPE to have right associativity *) */
+decl_spec_list_opt:
+ /* empty */ { [] } %prec NAMED_TYPE
+| decl_spec_list { fst $1 }
+;
+/* (* We add this separate rule to handle the special case when an appearance
+ * of NAMED_TYPE should not be considered as part of the specifiers but as
+ * part of the declarator. IDENT has higher precedence than NAMED_TYPE *)
+ */
+decl_spec_list_opt_no_named:
+ /* empty */ { [] } %prec IDENT
+| decl_spec_list { fst $1 }
+;
+type_spec: /* ISO 6.7.2 */
+ VOID { Tvoid, $1}
+| CHAR { Tchar, $1 }
+| SHORT { Tshort, $1 }
+| INT { Tint, $1 }
+| LONG { Tlong, $1 }
+| INT64 { Tint64, $1 }
+| FLOAT { Tfloat, $1 }
+| DOUBLE { Tdouble, $1 }
+| SIGNED { Tsigned, $1 }
+| UNSIGNED { Tunsigned, $1 }
+| STRUCT id_or_typename
+ { Tstruct ($2, None, []), $1 }
+| STRUCT just_attributes id_or_typename
+ { Tstruct ($3, None, $2), $1 }
+| STRUCT id_or_typename LBRACE struct_decl_list RBRACE
+ { Tstruct ($2, Some $4, []), $1 }
+| STRUCT LBRACE struct_decl_list RBRACE
+ { Tstruct ("", Some $3, []), $1 }
+| STRUCT just_attributes id_or_typename LBRACE struct_decl_list RBRACE
+ { Tstruct ($3, Some $5, $2), $1 }
+| STRUCT just_attributes LBRACE struct_decl_list RBRACE
+ { Tstruct ("", Some $4, $2), $1 }
+| UNION id_or_typename
+ { Tunion ($2, None, []), $1 }
+| UNION id_or_typename LBRACE struct_decl_list RBRACE
+ { Tunion ($2, Some $4, []), $1 }
+| UNION LBRACE struct_decl_list RBRACE
+ { Tunion ("", Some $3, []), $1 }
+| UNION just_attributes id_or_typename LBRACE struct_decl_list RBRACE
+ { Tunion ($3, Some $5, $2), $1 }
+| UNION just_attributes LBRACE struct_decl_list RBRACE
+ { Tunion ("", Some $4, $2), $1 }
+| ENUM id_or_typename
+ { Tenum ($2, None, []), $1 }
+| ENUM id_or_typename LBRACE enum_list maybecomma RBRACE
+ { Tenum ($2, Some $4, []), $1 }
+| ENUM LBRACE enum_list maybecomma RBRACE
+ { Tenum ("", Some $3, []), $1 }
+| ENUM just_attributes id_or_typename LBRACE enum_list maybecomma RBRACE
+ { Tenum ($3, Some $5, $2), $1 }
+| ENUM just_attributes LBRACE enum_list maybecomma RBRACE
+ { Tenum ("", Some $4, $2), $1 }
+| NAMED_TYPE { Tnamed (fst $1), snd $1 }
+| TYPEOF LPAREN expression RPAREN { TtypeofE (fst $3), $1 }
+| TYPEOF LPAREN type_name RPAREN { let s, d = $3 in
+ TtypeofT (s, d), $1 }
+;
+struct_decl_list: /* (* ISO 6.7.2. Except that we allow empty structs. We
+ * also allow missing field names. *)
+ */
+ /* empty */ { [] }
+| decl_spec_list SEMICOLON struct_decl_list
+ { (fst $1,
+ [(missingFieldDecl, None)]) :: $3 }
+/*(* GCC allows extra semicolons *)*/
+| SEMICOLON struct_decl_list
+ { $2 }
+| decl_spec_list field_decl_list SEMICOLON struct_decl_list
+ { (fst $1, $2)
+ :: $4 }
+/*(* MSVC allows pragmas in strange places *)*/
+| pragma struct_decl_list { $2 }
+
+| error SEMICOLON struct_decl_list
+ { $3 }
+;
+field_decl_list: /* (* ISO 6.7.2 *) */
+ field_decl { [$1] }
+| field_decl COMMA field_decl_list { $1 :: $3 }
+;
+field_decl: /* (* ISO 6.7.2. Except that we allow unnamed fields. *) */
+| declarator { ($1, None) }
+| declarator COLON expression { ($1, Some (fst $3)) }
+| COLON expression { (missingFieldDecl, Some (fst $2)) }
+;
+
+enum_list: /* (* ISO 6.7.2.2 *) */
+ enumerator {[$1]}
+| enum_list COMMA enumerator {$1 @ [$3]}
+| enum_list COMMA error { $1 }
+;
+enumerator:
+ IDENT {(fst $1, NOTHING, snd $1)}
+| IDENT EQ expression {(fst $1, fst $3, snd $1)}
+;
+
+
+declarator: /* (* ISO 6.7.5. Plus Microsoft declarators.*) */
+ pointer_opt direct_decl attributes_with_asm
+ { let (n, decl) = $2 in
+ (n, applyPointer (fst $1) decl, $3, (*(*handleLoc*)*)(snd $1)) }
+;
+
+
+direct_decl: /* (* ISO 6.7.5 *) */
+ /* (* We want to be able to redefine named
+ * types as variable names *) */
+| id_or_typename { ($1, JUSTBASE) }
+
+| LPAREN attributes declarator RPAREN
+ { let (n,decl,al,loc) = $3 in
+ (n, PARENTYPE($2,decl,al)) }
+
+| direct_decl LBRACKET attributes comma_expression_opt RBRACKET
+ { let (n, decl) = $1 in
+ (n, ARRAY(decl, $3, $4)) }
+| direct_decl LBRACKET attributes error RBRACKET
+ { let (n, decl) = $1 in
+ (n, ARRAY(decl, $3, NOTHING)) }
+| direct_decl parameter_list_startscope rest_par_list RPAREN
+ { let (n, decl) = $1 in
+ let (params, isva) = $3 in
+ !Lexerhack.pop_context ();
+ (n, PROTO(decl, params, isva))
+ }
+;
+parameter_list_startscope:
+ LPAREN { !Lexerhack.push_context () }
+;
+rest_par_list:
+| /* empty */ { ([], false) }
+| parameter_decl rest_par_list1 { let (params, isva) = $2 in
+ ($1 :: params, isva)
+ }
+;
+rest_par_list1:
+ /* empty */ { ([], false) }
+| COMMA ELLIPSIS { ([], true) }
+| COMMA parameter_decl rest_par_list1 { let (params, isva) = $3 in
+ ($2 :: params, isva)
+ }
+;
+
+
+parameter_decl: /* (* ISO 6.7.5 *) */
+ decl_spec_list declarator { (fst $1, $2) }
+| decl_spec_list abstract_decl { let d, a = $2 in
+ (fst $1, ("", d, a, cabslu)) }
+| decl_spec_list { (fst $1, ("", JUSTBASE, [], cabslu)) }
+| LPAREN parameter_decl RPAREN { $2 }
+;
+
+/* (* Old style prototypes. Like a declarator *) */
+old_proto_decl:
+ pointer_opt direct_old_proto_decl { let (n, decl, a) = $2 in
+ (n, applyPointer (fst $1) decl,
+ a, snd $1)
+ }
+
+;
+
+direct_old_proto_decl:
+ direct_decl LPAREN old_parameter_list_ne RPAREN old_pardef_list
+ { let par_decl, isva = doOldParDecl $3 $5 in
+ let n, decl = $1 in
+ (n, PROTO(decl, par_decl, isva), [])
+ }
+| direct_decl LPAREN RPAREN
+ { let n, decl = $1 in
+ (n, PROTO(decl, [], false), [])
+ }
+
+/* (* appears sometimesm but generates a shift-reduce conflict. *)
+| LPAREN STAR direct_decl LPAREN old_parameter_list_ne RPAREN RPAREN LPAREN RPAREN old_pardef_list
+ { let par_decl, isva
+ = doOldParDecl $5 $10 in
+ let n, decl = $3 in
+ (n, PROTO(decl, par_decl, isva), [])
+ }
+*/
+;
+
+old_parameter_list_ne:
+| IDENT { [fst $1] }
+| IDENT COMMA old_parameter_list_ne { let rest = $3 in
+ (fst $1 :: rest) }
+;
+
+old_pardef_list:
+ /* empty */ { ([], false) }
+| decl_spec_list old_pardef SEMICOLON ELLIPSIS
+ { ([(fst $1, $2)], true) }
+| decl_spec_list old_pardef SEMICOLON old_pardef_list
+ { let rest, isva = $4 in
+ ((fst $1, $2) :: rest, isva)
+ }
+;
+
+old_pardef:
+ declarator { [$1] }
+| declarator COMMA old_pardef { $1 :: $3 }
+| error { [] }
+;
+
+
+pointer: /* (* ISO 6.7.5 *) */
+ STAR attributes pointer_opt { $2 :: fst $3, $1 }
+;
+pointer_opt:
+ /**/ { let l = currentLoc () in
+ ([], l) }
+| pointer { $1 }
+;
+
+type_name: /* (* ISO 6.7.6 *) */
+ decl_spec_list abstract_decl { let d, a = $2 in
+ if a <> [] then begin
+ parse_error "attributes in type name";
+ raise Parsing.Parse_error
+ end;
+ (fst $1, d)
+ }
+| decl_spec_list { (fst $1, JUSTBASE) }
+;
+abstract_decl: /* (* ISO 6.7.6. *) */
+ pointer_opt abs_direct_decl attributes { applyPointer (fst $1) $2, $3 }
+| pointer { applyPointer (fst $1) JUSTBASE, [] }
+;
+
+abs_direct_decl: /* (* ISO 6.7.6. We do not support optional declarator for
+ * functions. Plus Microsoft attributes. See the
+ * discussion for declarator. *) */
+| LPAREN attributes abstract_decl RPAREN
+ { let d, a = $3 in
+ PARENTYPE ($2, d, a)
+ }
+
+| LPAREN error RPAREN
+ { JUSTBASE }
+
+| abs_direct_decl_opt LBRACKET comma_expression_opt RBRACKET
+ { ARRAY($1, [], $3) }
+/*(* The next should be abs_direct_decl_opt but we get conflicts *)*/
+| abs_direct_decl parameter_list_startscope rest_par_list RPAREN
+ { let (params, isva) = $3 in
+ !Lexerhack.pop_context ();
+ PROTO ($1, params, isva)
+ }
+;
+abs_direct_decl_opt:
+ abs_direct_decl { $1 }
+| /* empty */ { JUSTBASE }
+;
+function_def: /* (* ISO 6.9.1 *) */
+ function_def_start block
+ { let (loc, specs, decl) = $1 in
+ currentFunctionName := "<__FUNCTION__ used outside any functions>";
+ !Lexerhack.pop_context (); (* The context pushed by
+ * announceFunctionName *)
+ doFunctionDef ((*handleLoc*) loc) (trd3 $2) specs decl (fst3 $2)
+ }
+
+
+function_def_start: /* (* ISO 6.9.1 *) */
+ decl_spec_list declarator
+ { announceFunctionName $2;
+ (snd $1, fst $1, $2)
+ }
+
+/* (* Old-style function prototype *) */
+| decl_spec_list old_proto_decl
+ { announceFunctionName $2;
+ (snd $1, fst $1, $2)
+ }
+/* (* New-style function that does not have a return type *) */
+| IDENT parameter_list_startscope rest_par_list RPAREN
+ { let (params, isva) = $3 in
+ let fdec =
+ (fst $1, PROTO(JUSTBASE, params, isva), [], snd $1) in
+ announceFunctionName fdec;
+ (* Default is int type *)
+ let defSpec = [SpecType Tint] in
+ (snd $1, defSpec, fdec)
+ }
+
+/* (* No return type and old-style parameter list *) */
+| IDENT LPAREN old_parameter_list_ne RPAREN old_pardef_list
+ { (* Convert pardecl to new style *)
+ let pardecl, isva = doOldParDecl $3 $5 in
+ (* Make the function declarator *)
+ let fdec = (fst $1,
+ PROTO(JUSTBASE, pardecl,isva),
+ [], snd $1) in
+ announceFunctionName fdec;
+ (* Default is int type *)
+ let defSpec = [SpecType Tint] in
+ (snd $1, defSpec, fdec)
+ }
+/* (* No return type and no parameters *) */
+| IDENT LPAREN RPAREN
+ { (* Make the function declarator *)
+ let fdec = (fst $1,
+ PROTO(JUSTBASE, [], false),
+ [], snd $1) in
+ announceFunctionName fdec;
+ (* Default is int type *)
+ let defSpec = [SpecType Tint] in
+ (snd $1, defSpec, fdec)
+ }
+;
+
+/* const/volatile as type specifier elements */
+cvspec:
+ CONST { SpecCV(CV_CONST), $1 }
+| VOLATILE { SpecCV(CV_VOLATILE), $1 }
+| RESTRICT { SpecCV(CV_RESTRICT), $1 }
+;
+
+/*** GCC attributes ***/
+attributes:
+ /* empty */ { []}
+| attribute attributes { fst $1 :: $2 }
+;
+
+/* (* In some contexts we can have an inline assembly to specify the name to
+ * be used for a global. We treat this as a name attribute *) */
+attributes_with_asm:
+ /* empty */ { [] }
+| attribute attributes_with_asm { fst $1 :: $2 }
+| ASM LPAREN string_constant RPAREN attributes
+ { ("__asm__",
+ [CONSTANT(CONST_STRING (fst $3))]) :: $5 }
+;
+
+/* things like __attribute__, but no const/volatile */
+attribute_nocv:
+ ATTRIBUTE LPAREN paren_attr_list_ne RPAREN
+ { ("__attribute__", $3), $1 }
+/*(*
+| ATTRIBUTE_USED { ("__attribute__",
+ [ VARIABLE "used" ]), $1 }
+*)*/
+| DECLSPEC paren_attr_list_ne { ("__declspec", $2), $1 }
+| MSATTR { (fst $1, []), snd $1 }
+ /* ISO 6.7.3 */
+| THREAD { ("__thread",[]), $1 }
+;
+
+/* __attribute__ plus const/volatile */
+attribute:
+ attribute_nocv { $1 }
+| CONST { ("const", []), $1 }
+| RESTRICT { ("restrict",[]), $1 }
+| VOLATILE { ("volatile",[]), $1 }
+;
+
+/* (* sm: I need something that just includes __attribute__ and nothing more,
+ * to support them appearing between the 'struct' keyword and the type name.
+ * Actually, a declspec can appear there as well (on MSVC) *) */
+just_attribute:
+ ATTRIBUTE LPAREN paren_attr_list_ne RPAREN
+ { ("__attribute__", $3) }
+| DECLSPEC paren_attr_list_ne { ("__declspec", $2) }
+;
+
+/* this can't be empty, b/c I folded that possibility into the calling
+ * productions to avoid some S/R conflicts */
+just_attributes:
+ just_attribute { [$1] }
+| just_attribute just_attributes { $1 :: $2 }
+;
+
+/** (* PRAGMAS and ATTRIBUTES *) ***/
+pragma:
+| PRAGMA attr PRAGMA_EOL { PRAGMA ($2, $1) }
+| PRAGMA attr SEMICOLON PRAGMA_EOL { PRAGMA ($2, $1) }
+| PRAGMA_LINE { PRAGMA (VARIABLE (fst $1),
+ snd $1) }
+;
+
+/* (* We want to allow certain strange things that occur in pragmas, so we
+ * cannot use directly the language of expressions *) */
+primary_attr:
+ IDENT { VARIABLE (fst $1) }
+ /*(* The NAMED_TYPE here creates conflicts with IDENT *)*/
+| NAMED_TYPE { VARIABLE (fst $1) }
+| LPAREN attr RPAREN { $2 }
+| IDENT IDENT { CALL(VARIABLE (fst $1), [VARIABLE (fst $2)]) }
+| CST_INT { CONSTANT(CONST_INT (fst $1)) }
+| string_constant { CONSTANT(CONST_STRING (fst $1)) }
+ /*(* Const when it appears in
+ * attribute lists, is translated
+ * to aconst *)*/
+| CONST { VARIABLE "aconst" }
+| IDENT COLON CST_INT { VARIABLE (fst $1 ^ ":" ^ fst $3) }
+
+| CST_INT COLON CST_INT { VARIABLE (fst $1 ^ ":" ^ fst $3) }
+| DEFAULT COLON CST_INT { VARIABLE ("default:" ^ fst $3) }
+
+ /*(** GCC allows this as an
+ * attribute for functions,
+ * synonim for noreturn **)*/
+| VOLATILE { VARIABLE ("__noreturn__") }
+;
+
+postfix_attr:
+ primary_attr { $1 }
+ /* (* use a VARIABLE "" so that the
+ * parentheses are printed *) */
+| IDENT LPAREN RPAREN { CALL(VARIABLE (fst $1), [VARIABLE ""]) }
+| IDENT paren_attr_list_ne { CALL(VARIABLE (fst $1), $2) }
+
+| postfix_attr ARROW id_or_typename {MEMBEROFPTR ($1, $3)}
+| postfix_attr DOT id_or_typename {MEMBEROF ($1, $3)}
+;
+
+/*(* Since in attributes we use both IDENT and NAMED_TYPE as indentifiers,
+ * that leads to conflicts for SIZEOF and ALIGNOF. In those cases we require
+ * that their arguments be expressions, not attributes *)*/
+unary_attr:
+ postfix_attr { $1 }
+| SIZEOF unary_expression {EXPR_SIZEOF (fst $2) }
+| SIZEOF LPAREN type_name RPAREN
+ {let b, d = $3 in TYPE_SIZEOF (b, d)}
+
+| ALIGNOF unary_expression {EXPR_ALIGNOF (fst $2) }
+| ALIGNOF LPAREN type_name RPAREN {let b, d = $3 in TYPE_ALIGNOF (b, d)}
+| PLUS cast_attr {UNARY (PLUS, $2)}
+| MINUS cast_attr {UNARY (MINUS, $2)}
+| STAR cast_attr {UNARY (MEMOF, $2)}
+| AND cast_attr
+ {UNARY (ADDROF, $2)}
+| EXCLAM cast_attr {UNARY (NOT, $2)}
+| TILDE cast_attr {UNARY (BNOT, $2)}
+;
+
+cast_attr:
+ unary_attr { $1 }
+;
+
+multiplicative_attr:
+ cast_attr { $1 }
+| multiplicative_attr STAR cast_attr {BINARY(MUL ,$1 , $3)}
+| multiplicative_attr SLASH cast_attr {BINARY(DIV ,$1 , $3)}
+| multiplicative_attr PERCENT cast_attr {BINARY(MOD ,$1 , $3)}
+;
+
+
+additive_attr:
+ multiplicative_attr { $1 }
+| additive_attr PLUS multiplicative_attr {BINARY(ADD ,$1 , $3)}
+| additive_attr MINUS multiplicative_attr {BINARY(SUB ,$1 , $3)}
+;
+
+shift_attr:
+ additive_attr { $1 }
+| shift_attr INF_INF additive_attr {BINARY(SHL ,$1 , $3)}
+| shift_attr SUP_SUP additive_attr {BINARY(SHR ,$1 , $3)}
+;
+
+relational_attr:
+ shift_attr { $1 }
+| relational_attr INF shift_attr {BINARY(LT ,$1 , $3)}
+| relational_attr SUP shift_attr {BINARY(GT ,$1 , $3)}
+| relational_attr INF_EQ shift_attr {BINARY(LE ,$1 , $3)}
+| relational_attr SUP_EQ shift_attr {BINARY(GE ,$1 , $3)}
+;
+
+equality_attr:
+ relational_attr { $1 }
+| equality_attr EQ_EQ relational_attr {BINARY(EQ ,$1 , $3)}
+| equality_attr EXCLAM_EQ relational_attr {BINARY(NE ,$1 , $3)}
+;
+
+
+bitwise_and_attr:
+ equality_attr { $1 }
+| bitwise_and_attr AND equality_attr {BINARY(BAND ,$1 , $3)}
+;
+
+bitwise_xor_attr:
+ bitwise_and_attr { $1 }
+| bitwise_xor_attr CIRC bitwise_and_attr {BINARY(XOR ,$1 , $3)}
+;
+
+bitwise_or_attr:
+ bitwise_xor_attr { $1 }
+| bitwise_or_attr PIPE bitwise_xor_attr {BINARY(BOR ,$1 , $3)}
+;
+
+logical_and_attr:
+ bitwise_or_attr { $1 }
+| logical_and_attr AND_AND bitwise_or_attr {BINARY(AND ,$1 , $3)}
+;
+
+logical_or_attr:
+ logical_and_attr { $1 }
+| logical_or_attr PIPE_PIPE logical_and_attr {BINARY(OR ,$1 , $3)}
+;
+
+
+attr: logical_or_attr { $1 }
+;
+
+attr_list_ne:
+| attr { [$1] }
+| attr COMMA attr_list_ne { $1 :: $3 }
+| error COMMA attr_list_ne { $3 }
+;
+paren_attr_list_ne:
+ LPAREN attr_list_ne RPAREN { $2 }
+| LPAREN error RPAREN { [] }
+;
+/*** GCC ASM instructions ***/
+asmattr:
+ /* empty */ { [] }
+| VOLATILE asmattr { ("volatile", []) :: $2 }
+| CONST asmattr { ("const", []) :: $2 }
+;
+asmtemplate:
+ one_string_constant { [$1] }
+| one_string_constant asmtemplate { $1 :: $2 }
+;
+asmoutputs:
+ /* empty */ { None }
+| COLON asmoperands asminputs
+ { let (ins, clobs) = $3 in
+ Some {aoutputs = $2; ainputs = ins; aclobbers = clobs} }
+;
+asmoperands:
+ /* empty */ { [] }
+| asmoperandsne { List.rev $1 }
+;
+asmoperandsne:
+ asmoperand { [$1] }
+| asmoperandsne COMMA asmoperand { $3 :: $1 }
+;
+asmoperand:
+ string_constant LPAREN expression RPAREN { (fst $1, fst $3) }
+| string_constant LPAREN error RPAREN { (fst $1, NOTHING ) }
+;
+asminputs:
+ /* empty */ { ([], []) }
+| COLON asmoperands asmclobber
+ { ($2, $3) }
+;
+asmclobber:
+ /* empty */ { [] }
+| COLON asmcloberlst_ne { $2 }
+;
+asmcloberlst_ne:
+ one_string_constant { [$1] }
+| one_string_constant COMMA asmcloberlst_ne { $1 :: $3 }
+;
+
+%%
+
+
+
diff --git a/cil/src/frontc/cprint.ml b/cil/src/frontc/cprint.ml
new file mode 100644
index 0000000..570945c
--- /dev/null
+++ b/cil/src/frontc/cprint.ml
@@ -0,0 +1,1014 @@
+(*
+ *
+ * Copyright (c) 2001-2003,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+(* cprint -- pretty printer of C program from abstract syntax
+**
+** Project: FrontC
+** File: cprint.ml
+** Version: 2.1e
+** Date: 9.1.99
+** Author: Hugues Cassé
+**
+** 1.0 2.22.99 Hugues Cassé First version.
+** 2.0 3.18.99 Hugues Cassé Compatible with Frontc 2.1, use of CAML
+** pretty printer.
+** 2.1 3.22.99 Hugues Cassé More efficient custom pretty printer used.
+** 2.1a 4.12.99 Hugues Cassé Correctly handle:
+** char *m, *m, *p; m + (n - p)
+** 2.1b 4.15.99 Hugues Cassé x + (y + z) stays x + (y + z) for
+** keeping computation order.
+** 2.1c 7.23.99 Hugues Cassé Improvement of case and default display.
+** 2.1d 8.25.99 Hugues Cassé Rebuild escape sequences in string and
+** characters.
+** 2.1e 9.1.99 Hugues Cassé Fix, recognize and correctly display '\0'.
+*)
+
+(* George Necula: I changed this pretty dramatically since CABS changed *)
+open Cabs
+open Escape
+let version = "Cprint 2.1e 9.1.99 Hugues Cassé"
+
+type loc = { line : int; file : string }
+
+let lu = {line = -1; file = "loc unknown";}
+let cabslu = {lineno = -10;
+ filename = "cabs loc unknown";
+ byteno = -10;}
+
+let curLoc = ref cabslu
+
+let msvcMode = ref false
+
+let printLn = ref true
+let printLnComment = ref false
+
+let printCounters = ref false
+let printComments = ref false
+
+(*
+** FrontC Pretty printer
+*)
+let out = ref stdout
+let width = ref 80
+let tab = ref 2
+let max_indent = ref 60
+
+let line = ref ""
+let line_len = ref 0
+let current = ref ""
+let current_len = ref 0
+let spaces = ref 0
+let follow = ref 0
+let roll = ref 0
+
+let print_tab size =
+ for i = 1 to size / 8 do
+ output_char !out '\t'
+ done;
+ for i = 1 to size mod 8 do
+ output_char !out ' '
+ done
+
+let flush _ =
+ if !line <> "" then begin
+ print_tab (!spaces + !follow);
+ output_string !out !line;
+ line := "";
+ line_len := 0
+ end
+
+let commit _ =
+ if !current <> "" then begin
+ if !line = "" then begin
+ line := !current;
+ line_len := !current_len
+ end else begin
+ line := (!line ^ " " ^ !current);
+ line_len := !line_len + 1 + !current_len
+ end;
+ current := "";
+ current_len := 0
+ end
+
+
+let addline () =
+ curLoc := {lineno = !curLoc.lineno+1;
+ filename = !curLoc.filename;
+ byteno = -1;} (*sfg: can we do better than this?*)
+
+
+let new_line _ =
+ commit ();
+ if !line <> "" then begin
+ flush ();
+ addline();
+ output_char !out '\n'
+ end;
+ follow := 0
+
+let force_new_line _ =
+ commit ();
+ flush ();
+ addline();
+ output_char !out '\n';
+ follow := 0
+
+let indent _ =
+ new_line ();
+ spaces := !spaces + !tab;
+ if !spaces >= !max_indent then begin
+ spaces := !tab;
+ roll := !roll + 1
+ end
+
+let indentline _ =
+ new_line ();
+ if !spaces >= !max_indent then begin
+ spaces := !tab;
+ roll := !roll + 1
+ end
+
+let unindent _ =
+ new_line ();
+ spaces := !spaces - !tab;
+ if (!spaces <= 0) && (!roll > 0) then begin
+ spaces := ((!max_indent - 1) / !tab) * !tab;
+ roll := !roll - 1
+ end
+
+let space _ = commit ()
+
+let print str =
+ current := !current ^ str;
+ current_len := !current_len + (String.length str);
+ if (!spaces + !follow + !line_len + 1 + !current_len) > !width
+ then begin
+ if !line_len = 0 then commit ();
+ flush ();
+ addline();
+ output_char !out '\n';
+ if !follow = 0 then follow := !tab
+ end
+
+(* sm: for some reason I couldn't just call print from frontc.... ? *)
+let print_unescaped_string str = print str
+
+let setLoc (l : cabsloc) =
+ if !printLn then
+ if (l.lineno <> !curLoc.lineno) || l.filename <> !curLoc.filename then
+ begin
+ let oldspaces = !spaces in
+ (* sm: below, we had '//#' instead of '#', which means printLnComment was disregarded *)
+ if !printLnComment then print "//" else print "#";
+ if !msvcMode then print "line";
+ print " ";
+ print (string_of_int l.lineno);
+ if (l.filename <> !curLoc.filename) then begin
+ print (" \"" ^ l.filename ^ "\"")
+ end;
+ spaces := oldspaces;
+ new_line();
+ curLoc := l
+ end
+
+
+
+(*
+** Useful primitives
+*)
+let print_list print_sep print_elt lst =
+ let _ = List.fold_left
+ (fun com elt ->
+ if com then print_sep ();
+ print_elt elt;
+ true)
+ false
+ lst in
+ ()
+
+let print_commas nl fct lst =
+ print_list (fun () -> print ","; if nl then new_line() else space()) fct lst
+
+let print_string (s:string) =
+ print ("\"" ^ escape_string s ^ "\"")
+
+let print_wstring (s: int64 list ) =
+ print ("L\"" ^ escape_wstring s ^ "\"")
+
+(*
+** Base Type Printing
+*)
+
+let rec print_specifiers (specs: spec_elem list) =
+ comprint "specifier(";
+ let print_spec_elem = function
+ SpecTypedef -> print "typedef "
+ | SpecInline -> print "__inline "
+ | SpecStorage sto ->
+ print (match sto with
+ NO_STORAGE -> (comstring "/*no storage*/")
+ | AUTO -> "auto "
+ | STATIC -> "static "
+ | EXTERN -> "extern "
+ | REGISTER -> "register ")
+ | SpecCV cv ->
+ print (match cv with
+ | CV_CONST -> "const "
+ | CV_VOLATILE -> "volatile "
+ | CV_RESTRICT -> "restrict ")
+ | SpecAttr al -> print_attribute al; space ()
+ | SpecType bt -> print_type_spec bt
+ | SpecPattern name -> print ("@specifier(" ^ name ^ ") ")
+ in
+ List.iter print_spec_elem specs
+ ;comprint ")"
+
+
+and print_type_spec = function
+ Tvoid -> print "void "
+ | Tchar -> print "char "
+ | Tshort -> print "short "
+ | Tint -> print "int "
+ | Tlong -> print "long "
+ | Tint64 -> print "__int64 "
+ | Tfloat -> print "float "
+ | Tdouble -> print "double "
+ | Tsigned -> print "signed "
+ | Tunsigned -> print "unsigned "
+ | Tnamed s -> comprint "tnamed"; print s; space ();
+ | Tstruct (n, None, _) -> print ("struct " ^ n ^ " ")
+ | Tstruct (n, Some flds, extraAttrs) ->
+ (print_struct_name_attr "struct" n extraAttrs);
+ (print_fields flds)
+ | Tunion (n, None, _) -> print ("union " ^ n ^ " ")
+ | Tunion (n, Some flds, extraAttrs) ->
+ (print_struct_name_attr "union" n extraAttrs);
+ (print_fields flds)
+ | Tenum (n, None, _) -> print ("enum " ^ n ^ " ")
+ | Tenum (n, Some enum_items, extraAttrs) ->
+ (print_struct_name_attr "enum" n extraAttrs);
+ (print_enum_items enum_items)
+ | TtypeofE e -> print "__typeof__("; print_expression e; print ") "
+ | TtypeofT (s,d) -> print "__typeof__("; print_onlytype (s, d); print ") "
+
+
+(* print "struct foo", but with specified keyword and a list of
+ * attributes to put between keyword and name *)
+and print_struct_name_attr (keyword: string) (name: string) (extraAttrs: attribute list) =
+begin
+ if extraAttrs = [] then
+ print (keyword ^ " " ^ name)
+ else begin
+ (print (keyword ^ " "));
+ (print_attributes extraAttrs); (* prints a final space *)
+ (print name);
+ end
+end
+
+
+(* This is the main printer for declarations. It is easy bacause the
+ * declarations are laid out as they need to be printed. *)
+and print_decl (n: string) = function
+ JUSTBASE -> if n <> "___missing_field_name" then
+ print n
+ else
+ comprint "missing field name"
+ | PARENTYPE (al1, d, al2) ->
+ print "(";
+ print_attributes al1; space ();
+ print_decl n d; space ();
+ print_attributes al2; print ")"
+ | PTR (al, d) ->
+ print "* ";
+ print_attributes al; space ();
+ print_decl n d
+ | ARRAY (d, al, e) ->
+ print_decl n d;
+ print "[";
+ print_attributes al;
+ if e <> NOTHING then print_expression e;
+ print "]"
+ | PROTO(d, args, isva) ->
+ comprint "proto(";
+ print_decl n d;
+ print "(";
+ print_params args isva;
+ print ")";
+ comprint ")"
+
+
+and print_fields (flds : field_group list) =
+ if flds = [] then print " { } "
+ else begin
+ print " {";
+ indent ();
+ List.iter
+ (fun fld -> print_field_group fld; print ";"; new_line ())
+ flds;
+ unindent ();
+ print "} "
+ end
+
+and print_enum_items items =
+ if items = [] then print " { } "
+ else begin
+ print " {";
+ indent ();
+ print_commas
+ true
+ (fun (id, exp, loc) -> print id;
+ if exp = NOTHING then ()
+ else begin
+ space ();
+ print "= ";
+ print_expression exp
+ end)
+ items;
+ unindent ();
+ print "} ";
+ end
+
+
+and print_onlytype (specs, dt) =
+ print_specifiers specs;
+ print_decl "" dt
+
+and print_name ((n, decl, attrs, _) : name) =
+ print_decl n decl;
+ space ();
+ print_attributes attrs
+
+and print_init_name ((n, i) : init_name) =
+ print_name n;
+ if i <> NO_INIT then begin
+ space ();
+ print "= ";
+ print_init_expression i
+ end
+
+and print_name_group (specs, names) =
+ print_specifiers specs;
+ print_commas false print_name names
+
+and print_field_group (specs, fields) =
+ print_specifiers specs;
+ print_commas false print_field fields
+
+
+and print_field (name, widtho) =
+ print_name name;
+ (match widtho with
+ None -> ()
+ | Some w -> print " : "; print_expression w)
+
+and print_init_name_group (specs, names) =
+ print_specifiers specs;
+ print_commas false print_init_name names
+
+and print_single_name (specs, name) =
+ print_specifiers specs;
+ print_name name
+
+and print_params (pars : single_name list) (ell : bool) =
+ print_commas false print_single_name pars;
+ if ell then print (if pars = [] then "..." else ", ...") else ()
+
+and print_old_params pars ell =
+ print_commas false (fun id -> print id) pars;
+ if ell then print (if pars = [] then "..." else ", ...") else ()
+
+
+(*
+** Expression printing
+** Priorities
+** 16 variables
+** 15 . -> [] call()
+** 14 ++, -- (post)
+** 13 ++ -- (pre) ~ ! - + & *(cast)
+** 12 * / %
+** 11 + -
+** 10 << >>
+** 9 < <= > >=
+** 8 == !=
+** 7 &
+** 6 ^
+** 5 |
+** 4 &&
+** 3 ||
+** 2 ? :
+** 1 = ?=
+** 0 ,
+*)
+and get_operator exp =
+ match exp with
+ NOTHING -> ("", 16)
+ | UNARY (op, _) ->
+ (match op with
+ MINUS -> ("-", 13)
+ | PLUS -> ("+", 13)
+ | NOT -> ("!", 13)
+ | BNOT -> ("~", 13)
+ | MEMOF -> ("*", 13)
+ | ADDROF -> ("&", 13)
+ | PREINCR -> ("++", 13)
+ | PREDECR -> ("--", 13)
+ | POSINCR -> ("++", 14)
+ | POSDECR -> ("--", 14))
+ | LABELADDR s -> ("", 16) (* Like a constant *)
+ | BINARY (op, _, _) ->
+ (match op with
+ MUL -> ("*", 12)
+ | DIV -> ("/", 12)
+ | MOD -> ("%", 12)
+ | ADD -> ("+", 11)
+ | SUB -> ("-", 11)
+ | SHL -> ("<<", 10)
+ | SHR -> (">>", 10)
+ | LT -> ("<", 9)
+ | LE -> ("<=", 9)
+ | GT -> (">", 9)
+ | GE -> (">=", 9)
+ | EQ -> ("==", 8)
+ | NE -> ("!=", 8)
+ | BAND -> ("&", 7)
+ | XOR -> ("^", 6)
+ | BOR -> ("|", 5)
+ | AND -> ("&&", 4)
+ | OR -> ("||", 3)
+ | ASSIGN -> ("=", 1)
+ | ADD_ASSIGN -> ("+=", 1)
+ | SUB_ASSIGN -> ("-=", 1)
+ | MUL_ASSIGN -> ("*=", 1)
+ | DIV_ASSIGN -> ("/=", 1)
+ | MOD_ASSIGN -> ("%=", 1)
+ | BAND_ASSIGN -> ("&=", 1)
+ | BOR_ASSIGN -> ("|=", 1)
+ | XOR_ASSIGN -> ("^=", 1)
+ | SHL_ASSIGN -> ("<<=", 1)
+ | SHR_ASSIGN -> (">>=", 1))
+ | QUESTION _ -> ("", 2)
+ | CAST _ -> ("", 13)
+ | CALL _ -> ("", 15)
+ | COMMA _ -> ("", 0)
+ | CONSTANT _ -> ("", 16)
+ | VARIABLE name -> ("", 16)
+ | EXPR_SIZEOF exp -> ("", 16)
+ | TYPE_SIZEOF _ -> ("", 16)
+ | EXPR_ALIGNOF exp -> ("", 16)
+ | TYPE_ALIGNOF _ -> ("", 16)
+ | INDEX (exp, idx) -> ("", 15)
+ | MEMBEROF (exp, fld) -> ("", 15)
+ | MEMBEROFPTR (exp, fld) -> ("", 15)
+ | GNU_BODY _ -> ("", 17)
+ | EXPR_PATTERN _ -> ("", 16) (* sm: not sure about this *)
+
+and print_comma_exps exps =
+ print_commas false print_expression exps
+
+and print_init_expression (iexp: init_expression) : unit =
+ match iexp with
+ NO_INIT -> ()
+ | SINGLE_INIT e -> print_expression e
+ | COMPOUND_INIT initexps ->
+ let doinitexp = function
+ NEXT_INIT, e -> print_init_expression e
+ | i, e ->
+ let rec doinit = function
+ NEXT_INIT -> ()
+ | INFIELD_INIT (fn, i) -> print ("." ^ fn); doinit i
+ | ATINDEX_INIT (e, i) ->
+ print "[";
+ print_expression e;
+ print "]";
+ doinit i
+ | ATINDEXRANGE_INIT (s, e) ->
+ print "[";
+ print_expression s;
+ print " ... ";
+ print_expression e;
+ print "]"
+ in
+ doinit i; print " = ";
+ print_init_expression e
+ in
+ print "{";
+ print_commas false doinitexp initexps;
+ print "}"
+
+and print_expression (exp: expression) = print_expression_level 1 exp
+
+and print_expression_level (lvl: int) (exp : expression) =
+ let (txt, lvl') = get_operator exp in
+ let _ = if lvl > lvl' then print "(" else () in
+ let _ = match exp with
+ NOTHING -> ()
+ | UNARY (op, exp') ->
+ (match op with
+ POSINCR | POSDECR ->
+ print_expression_level lvl' exp';
+ print txt
+ | _ ->
+ print txt; space (); (* Print the space to avoid --5 *)
+ print_expression_level lvl' exp')
+ | LABELADDR l -> print ("&& " ^ l)
+ | BINARY (op, exp1, exp2) ->
+ (*if (op = SUB) && (lvl <= lvl') then print "(";*)
+ print_expression_level lvl' exp1;
+ space ();
+ print txt;
+ space ();
+ (*print_expression exp2 (if op = SUB then (lvl' + 1) else lvl');*)
+ print_expression_level (lvl' + 1) exp2
+ (*if (op = SUB) && (lvl <= lvl') then print ")"*)
+ | QUESTION (exp1, exp2, exp3) ->
+ print_expression_level 2 exp1;
+ space ();
+ print "? ";
+ print_expression_level 2 exp2;
+ space ();
+ print ": ";
+ print_expression_level 2 exp3;
+ | CAST (typ, iexp) ->
+ print "(";
+ print_onlytype typ;
+ print ")";
+ (* Always print parentheses. In a small number of cases when we print
+ * constants we don't need them *)
+ (match iexp with
+ SINGLE_INIT e -> print_expression_level 15 e
+ | COMPOUND_INIT _ -> (* print "("; *)
+ print_init_expression iexp
+ (* ; print ")" *)
+ | NO_INIT -> print "<NO_INIT in cast. Should never arise>")
+
+ | CALL (VARIABLE "__builtin_va_arg", [arg; TYPE_SIZEOF (bt, dt)]) ->
+ comprint "variable";
+ print "__builtin_va_arg";
+ print "(";
+ print_expression_level 1 arg;
+ print ",";
+ print_onlytype (bt, dt);
+ print ")"
+ | CALL (exp, args) ->
+ print_expression_level 16 exp;
+ print "(";
+ print_comma_exps args;
+ print ")"
+ | COMMA exps ->
+ print_comma_exps exps
+ | CONSTANT cst ->
+ (match cst with
+ CONST_INT i -> print i
+ | CONST_FLOAT r -> print r
+ | CONST_CHAR c -> print ("'" ^ escape_wstring c ^ "'")
+ | CONST_WCHAR c -> print ("L'" ^ escape_wstring c ^ "'")
+ | CONST_STRING s -> print_string s
+ | CONST_WSTRING ws -> print_wstring ws)
+ | VARIABLE name ->
+ comprint "variable";
+ print name
+ | EXPR_SIZEOF exp ->
+ print "sizeof(";
+ print_expression_level 0 exp;
+ print ")"
+ | TYPE_SIZEOF (bt,dt) ->
+ print "sizeof(";
+ print_onlytype (bt, dt);
+ print ")"
+ | EXPR_ALIGNOF exp ->
+ print "__alignof__(";
+ print_expression_level 0 exp;
+ print ")"
+ | TYPE_ALIGNOF (bt,dt) ->
+ print "__alignof__(";
+ print_onlytype (bt, dt);
+ print ")"
+ | INDEX (exp, idx) ->
+ print_expression_level 16 exp;
+ print "[";
+ print_expression_level 0 idx;
+ print "]"
+ | MEMBEROF (exp, fld) ->
+ print_expression_level 16 exp;
+ print ("." ^ fld)
+ | MEMBEROFPTR (exp, fld) ->
+ print_expression_level 16 exp;
+ print ("->" ^ fld)
+ | GNU_BODY (blk) ->
+ print "(";
+ print_block blk;
+ print ")"
+ | EXPR_PATTERN (name) ->
+ print ("@expr(" ^ name ^ ") ")
+ in
+ if lvl > lvl' then print ")" else ()
+
+
+(*
+** Statement printing
+*)
+and print_statement stat =
+ match stat with
+ NOP (loc) ->
+ setLoc(loc);
+ print ";";
+ new_line ()
+ | COMPUTATION (exp, loc) ->
+ setLoc(loc);
+ print_expression exp;
+ print ";";
+ new_line ()
+ | BLOCK (blk, loc) -> print_block blk
+
+ | SEQUENCE (s1, s2, loc) ->
+ setLoc(loc);
+ print_statement s1;
+ print_statement s2;
+ | IF (exp, s1, s2, loc) ->
+ setLoc(loc);
+ print "if(";
+ print_expression_level 0 exp;
+ print ")";
+ print_substatement s1;
+ (match s2 with
+ | NOP(_) -> ()
+ | _ -> begin
+ print "else";
+ print_substatement s2;
+ end)
+ | WHILE (exp, stat, loc) ->
+ setLoc(loc);
+ print "while(";
+ print_expression_level 0 exp;
+ print ")";
+ print_substatement stat
+ | DOWHILE (exp, stat, loc) ->
+ setLoc(loc);
+ print "do";
+ print_substatement stat;
+ print "while(";
+ print_expression_level 0 exp;
+ print ");";
+ new_line ();
+ | FOR (fc1, exp2, exp3, stat, loc) ->
+ setLoc(loc);
+ print "for(";
+ (match fc1 with
+ FC_EXP exp1 -> print_expression_level 0 exp1; print ";"
+ | FC_DECL dec1 -> print_def dec1);
+ space ();
+ print_expression_level 0 exp2;
+ print ";";
+ space ();
+ print_expression_level 0 exp3;
+ print ")";
+ print_substatement stat
+ | BREAK (loc)->
+ setLoc(loc);
+ print "break;"; new_line ()
+ | CONTINUE (loc) ->
+ setLoc(loc);
+ print "continue;"; new_line ()
+ | RETURN (exp, loc) ->
+ setLoc(loc);
+ print "return";
+ if exp = NOTHING
+ then ()
+ else begin
+ print " ";
+ print_expression_level 1 exp
+ end;
+ print ";";
+ new_line ()
+ | SWITCH (exp, stat, loc) ->
+ setLoc(loc);
+ print "switch(";
+ print_expression_level 0 exp;
+ print ")";
+ print_substatement stat
+ | CASE (exp, stat, loc) ->
+ setLoc(loc);
+ unindent ();
+ print "case ";
+ print_expression_level 1 exp;
+ print ":";
+ indent ();
+ print_substatement stat
+ | CASERANGE (expl, exph, stat, loc) ->
+ setLoc(loc);
+ unindent ();
+ print "case ";
+ print_expression expl;
+ print " ... ";
+ print_expression exph;
+ print ":";
+ indent ();
+ print_substatement stat
+ | DEFAULT (stat, loc) ->
+ setLoc(loc);
+ unindent ();
+ print "default :";
+ indent ();
+ print_substatement stat
+ | LABEL (name, stat, loc) ->
+ setLoc(loc);
+ print (name ^ ":");
+ space ();
+ print_substatement stat
+ | GOTO (name, loc) ->
+ setLoc(loc);
+ print ("goto " ^ name ^ ";");
+ new_line ()
+ | COMPGOTO (exp, loc) ->
+ setLoc(loc);
+ print ("goto *"); print_expression exp; print ";"; new_line ()
+ | DEFINITION d ->
+ print_def d
+ | ASM (attrs, tlist, details, loc) ->
+ setLoc(loc);
+ let print_asm_operand (cnstr, e) =
+ print_string cnstr; space (); print_expression_level 100 e
+ in
+ if !msvcMode then begin
+ print "__asm {";
+ print_list (fun () -> new_line()) print tlist; (* templates *)
+ print "};"
+ end else begin
+ print "__asm__ ";
+ print_attributes attrs;
+ print "(";
+ print_list (fun () -> new_line()) print_string tlist; (* templates *)
+ begin
+ match details with
+ | None -> ()
+ | Some { aoutputs = outs; ainputs = ins; aclobbers = clobs } ->
+ print ":"; space ();
+ print_commas false print_asm_operand outs;
+ if ins <> [] || clobs <> [] then begin
+ print ":"; space ();
+ print_commas false print_asm_operand ins;
+ if clobs <> [] then begin
+ print ":"; space ();
+ print_commas false print_string clobs
+ end;
+ end
+ end;
+ print ");"
+ end;
+ new_line ()
+ | TRY_FINALLY (b, h, loc) ->
+ setLoc loc;
+ print "__try ";
+ print_block b;
+ print "__finally ";
+ print_block h
+
+ | TRY_EXCEPT (b, e, h, loc) ->
+ setLoc loc;
+ print "__try ";
+ print_block b;
+ print "__except("; print_expression e; print ")";
+ print_block h
+
+and print_block blk =
+ new_line();
+ print "{";
+ indent ();
+ if blk.blabels <> [] then begin
+ print "__label__ ";
+ print_commas false print blk.blabels;
+ print ";";
+ new_line ();
+ end;
+ if blk.battrs <> [] then begin
+ List.iter print_attribute blk.battrs;
+ new_line ();
+ end;
+ List.iter print_statement blk.bstmts;
+ unindent ();
+ print "}";
+ new_line ()
+
+and print_substatement stat =
+ match stat with
+ IF _
+ | SEQUENCE _
+ | DOWHILE _ ->
+ new_line ();
+ print "{";
+ indent ();
+ print_statement stat;
+ unindent ();
+ print "}";
+ new_line ();
+ | BLOCK _ ->
+ print_statement stat
+ | _ ->
+ indent ();
+ print_statement stat;
+ unindent ()
+
+
+(*
+** GCC Attributes
+*)
+and print_attribute (name,args) =
+ if args = [] then print (
+ match name with
+ "restrict" -> "__restrict"
+ (* weimer: Fri Dec 7 17:12:35 2001
+ * must not print 'restrict' and the code below does allows some
+ * plain 'restrict's to slip though! *)
+ | x -> x)
+ else begin
+ print name;
+ print "("; if name = "__attribute__" then print "(";
+ (match args with
+ [VARIABLE "aconst"] -> print "const"
+ | [VARIABLE "restrict"] -> print "__restrict"
+ | _ -> print_commas false (fun e -> print_expression e) args);
+ print ")"; if name = "__attribute__" then print ")"
+ end
+
+(* Print attributes. *)
+and print_attributes attrs =
+ List.iter (fun a -> print_attribute a; space ()) attrs
+
+(*
+** Declaration printing
+*)
+and print_defs defs =
+ let prev = ref false in
+ List.iter
+ (fun def ->
+ (match def with
+ DECDEF _ -> prev := false
+ | _ ->
+ if not !prev then force_new_line ();
+ prev := true);
+ print_def def)
+ defs
+
+and print_def def =
+ match def with
+ FUNDEF (proto, body, loc, _) ->
+ comprint "fundef";
+ if !printCounters then begin
+ try
+ let fname =
+ match proto with
+ (_, (n, _, _, _)) -> n
+ in
+ print_def (DECDEF (([SpecType Tint],
+ [(fname ^ "__counter", JUSTBASE, [], cabslu),
+ NO_INIT]), loc));
+ with Not_found -> print "/* can't print the counter */"
+ end;
+ setLoc(loc);
+ print_single_name proto;
+ print_block body;
+ force_new_line ();
+
+ | DECDEF (names, loc) ->
+ comprint "decdef";
+ setLoc(loc);
+ print_init_name_group names;
+ print ";";
+ new_line ()
+
+ | TYPEDEF (names, loc) ->
+ comprint "typedef";
+ setLoc(loc);
+ print_name_group names;
+ print ";";
+ new_line ();
+ force_new_line ()
+
+ | ONLYTYPEDEF (specs, loc) ->
+ comprint "onlytypedef";
+ setLoc(loc);
+ print_specifiers specs;
+ print ";";
+ new_line ();
+ force_new_line ()
+
+ | GLOBASM (asm, loc) ->
+ setLoc(loc);
+ print "__asm__ ("; print_string asm; print ");";
+ new_line ();
+ force_new_line ()
+
+ | PRAGMA (a,loc) ->
+ setLoc(loc);
+ force_new_line ();
+ print "#pragma ";
+ let oldwidth = !width in
+ width := 1000000; (* Do not wrap pragmas *)
+ print_expression a;
+ width := oldwidth;
+ force_new_line ()
+
+ | LINKAGE (n, loc, dl) ->
+ setLoc (loc);
+ force_new_line ();
+ print "extern "; print_string n; print_string " {";
+ List.iter print_def dl;
+ print_string "}";
+ force_new_line ()
+
+ | TRANSFORMER(srcdef, destdeflist, loc) ->
+ setLoc(loc);
+ print "@transform {";
+ force_new_line();
+ print "{";
+ force_new_line();
+ indent ();
+ print_def srcdef;
+ unindent();
+ print "}";
+ force_new_line();
+ print "to {";
+ force_new_line();
+ indent();
+ List.iter print_def destdeflist;
+ unindent();
+ print "}";
+ force_new_line()
+
+ | EXPRTRANSFORMER(srcexpr, destexpr, loc) ->
+ setLoc(loc);
+ print "@transformExpr { ";
+ print_expression srcexpr;
+ print " } to { ";
+ print_expression destexpr;
+ print " }";
+ force_new_line()
+
+
+(* sm: print a comment if the printComments flag is set *)
+and comprint (str : string) : unit =
+begin
+ if (!printComments) then (
+ print "/*";
+ print str;
+ print "*/ "
+ )
+ else
+ ()
+end
+
+(* sm: yield either the given string, or "", depending on printComments *)
+and comstring (str : string) : string =
+begin
+ if (!printComments) then
+ str
+ else
+ ""
+end
+
+
+(* print abstrac_syntax -> ()
+** Pretty printing the given abstract syntax program.
+*)
+let printFile (result : out_channel) ((fname, defs) : file) =
+ out := result;
+ print_defs defs;
+ flush () (* sm: should do this here *)
+
+let set_tab t = tab := t
+let set_width w = width := w
+
diff --git a/cil/src/frontc/frontc.ml b/cil/src/frontc/frontc.ml
new file mode 100644
index 0000000..459ae2c
--- /dev/null
+++ b/cil/src/frontc/frontc.ml
@@ -0,0 +1,256 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+module E = Errormsg
+open Trace
+open Pretty
+
+(* Output management *)
+let out : out_channel option ref = ref None
+let close_me = ref false
+
+let close_output _ =
+ match !out with
+ None -> ()
+ | Some o -> begin
+ flush o;
+ if !close_me then close_out o else ();
+ close_me := false
+ end
+
+let set_output filename =
+ close_output ();
+ (try out := Some (open_out filename)
+ with (Sys_error msg) ->
+ output_string stderr ("Error while opening output: " ^ msg); exit 1);
+ close_me := true
+
+ (* Signal that we are in MS VC mode *)
+let setMSVCMode () =
+ Cprint.msvcMode := true
+
+(* filename for patching *)
+let patchFileName : string ref = ref "" (* by default do no patching *)
+
+(* patching file contents *)
+let patchFile : Cabs.file option ref = ref None
+
+(* whether to print the patched CABS files *)
+let printPatchedFiles : bool ref = ref false
+
+(* whether to print a file of prototypes after parsing *)
+let doPrintProtos : bool ref = ref false
+
+(* this seems like something that should be built-in.. *)
+let isNone (o : 'a option) : bool =
+begin
+ match o with
+ | Some _ -> false
+ | None -> true
+end
+
+(*
+** Argument definition
+*)
+let args : (string * Arg.spec * string) list =
+[
+ "--cabsonly", Arg.String set_output, "<fname>: CABS output file name";
+ "--printComments", Arg.Unit (fun _ -> Cprint.printComments := true),
+ ": print cabs tree structure in comments in cabs output";
+ "--patchFile", Arg.String (fun pf -> patchFileName := pf),
+ "<fname>: name the file containing patching transformations";
+ "--printPatched", Arg.Unit (fun _ -> printPatchedFiles := true),
+ ": print patched CABS files after patching, to *.patched";
+ "--printProtos", Arg.Unit (fun _ -> doPrintProtos := true),
+ ": print prototypes to safec.proto.h after parsing";
+]
+
+exception ParseError of string
+exception CabsOnly
+
+(* parse, and apply patching *)
+let rec parse_to_cabs fname =
+begin
+ (* parse the patch file if it isn't parsed already *)
+ if ((!patchFileName <> "") && (isNone !patchFile)) then (
+ (* parse the patch file *)
+ patchFile := Some(parse_to_cabs_inner !patchFileName);
+ if !E.hadErrors then
+ (failwith "There were parsing errors in the patch file")
+ );
+
+ (* now parse the file we came here to parse *)
+ let cabs = parse_to_cabs_inner fname in
+ if !E.hadErrors then
+ E.s (E.error "There were parsing errors in %s\n" fname);
+
+ (* and apply the patch file, return transformed file *)
+ let patched = match !patchFile with
+
+ | Some(pf) -> (
+ (* save old value of out so I can use it for debugging during patching *)
+ let oldOut = !out in
+
+ (* reset out so we don't try to print the patch file to it *)
+ out := None;
+
+ (trace "patch" (dprintf "newpatching %s\n" fname));
+ let result = (Stats.time "newpatch" (Patch.applyPatch pf) cabs) in
+
+ if (!printPatchedFiles) then begin
+ let outFname:string = fname ^ ".patched" in
+ (trace "patch" (dprintf "printing patched version of %s to %s\n"
+ fname outFname));
+ let o = (open_out outFname) in
+ (Cprint.printFile o result);
+ (close_out o)
+ end;
+
+ (* restore out *)
+ Cprint.flush ();
+ out := oldOut;
+
+ result
+ )
+ | None -> cabs
+ in
+
+ (* print it ... *)
+ (match !out with
+ Some o -> begin
+ (trace "sm" (dprintf "writing the cabs output\n"));
+ output_string o ("/* Generated by Frontc */\n");
+ Stats.time "printCABS" (Cprint.printFile o) patched;
+ close_output ();
+ raise CabsOnly
+ end
+ | None -> ());
+ if !E.hadErrors then
+ raise Parsing.Parse_error;
+
+ (* and return the patched source *)
+ patched
+end
+
+
+(* just parse *)
+and parse_to_cabs_inner (fname : string) =
+ try
+ if !E.verboseFlag then ignore (E.log "Frontc is parsing %s\n" fname);
+ flush !E.logChannel;
+ E.hadErrors := false;
+ let lexbuf = Clexer.init fname in
+ let cabs = Stats.time "parse" (Cparser.file Clexer.initial) lexbuf in
+ Clexer.finish ();
+ (fname, cabs)
+ with (Sys_error msg) -> begin
+ ignore (E.log "Cannot open %s : %s\n" fname msg);
+ Clexer.finish ();
+ close_output ();
+ raise (ParseError("Cannot open " ^ fname ^ ": " ^ msg ^ "\n"))
+ end
+ | Parsing.Parse_error -> begin
+ ignore (E.log "Parsing error\n");
+ Clexer.finish ();
+ close_output ();
+ raise (ParseError("Parse error"))
+ end
+ | e -> begin
+ ignore (E.log "Caught %s while parsing\n" (Printexc.to_string e));
+ Clexer.finish ();
+ raise e
+ end
+
+
+(* print to safec.proto.h the prototypes of all functions that are defined *)
+let printPrototypes ((fname, file) : Cabs.file) : unit =
+begin
+ (*ignore (E.log "file has %d defns\n" (List.length file));*)
+
+ let chan = open_out "safec.proto.h" in
+ ignore (fprintf chan "/* generated prototypes file, %d defs */\n" (List.length file));
+ Cprint.out := chan;
+
+ let counter : int ref = ref 0 in
+
+ let rec loop (d : Cabs.definition) = begin
+ match d with
+ | Cabs.FUNDEF(name, _, loc, _) -> (
+ match name with
+ | (_, (funcname, Cabs.PROTO(_,_,_), _, _)) -> (
+ incr counter;
+ ignore (fprintf chan "\n/* %s from %s:%d */\n"
+ funcname loc.Cabs.filename loc.Cabs.lineno);
+ flush chan;
+ Cprint.print_single_name name;
+ Cprint.print_unescaped_string ";";
+ Cprint.force_new_line ();
+ Cprint.flush ()
+ )
+ | _ -> ()
+ )
+
+ | _ -> ()
+ end in
+ (List.iter loop file);
+
+ ignore (fprintf chan "\n/* wrote %d prototypes */\n" !counter);
+ close_out chan;
+ ignore (E.log "printed %d prototypes from %d defns to safec.proto.h\n"
+ !counter (List.length file))
+end
+
+
+
+let parse fname =
+ (trace "sm" (dprintf "parsing %s to Cabs\n" fname));
+ let cabs = parse_to_cabs fname in
+ (* Now (return a function that will) convert to CIL *)
+ fun _ ->
+ (trace "sm" (dprintf "converting %s from Cabs to CIL\n" fname));
+ let cil = Stats.time "conv" Cabs2cil.convFile cabs in
+ if !doPrintProtos then (printPrototypes cabs);
+ cil
+
+
+
+
+
+
+
+
diff --git a/cil/src/frontc/frontc.mli b/cil/src/frontc/frontc.mli
new file mode 100644
index 0000000..50ad799
--- /dev/null
+++ b/cil/src/frontc/frontc.mli
@@ -0,0 +1,55 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+ (* Signal that we are in MS VC mode *)
+val setMSVCMode: unit -> unit
+
+
+ (* Parse a file in *)
+exception ParseError of string
+
+ (* Raised when the front-end is requested to print the CABS and return *)
+exception CabsOnly
+
+ (* additional command line arguments *)
+val args: (string * Arg.spec * string) list
+
+ (* the main command to parse a file. Return a thunk that can be used to
+ * convert the AST to CIL. *)
+val parse: string -> (unit -> Cil.file)
+
diff --git a/cil/src/frontc/lexerhack.ml b/cil/src/frontc/lexerhack.ml
new file mode 100755
index 0000000..ecae28e
--- /dev/null
+++ b/cil/src/frontc/lexerhack.ml
@@ -0,0 +1,22 @@
+
+module E = Errormsg
+
+(* We provide here a pointer to a function. It will be set by the lexer and
+ * used by the parser. In Ocaml lexers depend on parsers, so we we have put
+ * such functions in a separate module. *)
+let add_identifier: (string -> unit) ref =
+ ref (fun _ -> E.s (E.bug "You called an uninitialized add_identifier"))
+
+let add_type: (string -> unit) ref =
+ ref (fun _ -> E.s (E.bug "You called an uninitialized add_type"))
+
+let push_context: (unit -> unit) ref =
+ ref (fun _ -> E.s (E.bug "You called an uninitialized push_context"))
+
+let pop_context: (unit -> unit) ref =
+ ref (fun _ -> E.s (E.bug "You called an uninitialized pop_context"))
+
+
+(* Keep here the current pattern for formatparse *)
+let currentPattern = ref ""
+
diff --git a/cil/src/frontc/patch.ml b/cil/src/frontc/patch.ml
new file mode 100644
index 0000000..fcb4ba6
--- /dev/null
+++ b/cil/src/frontc/patch.ml
@@ -0,0 +1,837 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(* patch.ml *)
+(* CABS file patching *)
+
+open Cabs
+open Trace
+open Pretty
+open Cabsvisit
+
+(* binding of a unification variable to a syntactic construct *)
+type binding =
+ | BSpecifier of string * spec_elem list
+ | BName of string * string
+ | BExpr of string * expression
+
+(* thrown when unification fails *)
+exception NoMatch
+
+(* thrown when an attempt to find the associated binding fails *)
+exception BadBind of string
+
+(* trying to isolate performance problems; will hide all the *)
+(* potentially expensive debugging output behind "if verbose .." *)
+let verbose : bool = true
+
+
+(* raise NoMatch if x and y are not equal *)
+let mustEq (x : 'a) (y : 'a) : unit =
+begin
+ if (x <> y) then (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatch by structural disequality\n"));
+ raise NoMatch
+ )
+end
+
+(* why isn't this in the core Ocaml library? *)
+let identity x = x
+
+
+let isPatternVar (s : string) : bool =
+begin
+ ((String.length s) >= 1) && ((String.get s 0) = '@')
+end
+
+(* 's' is actually "@name(blah)"; extract the 'blah' *)
+let extractPatternVar (s : string) : string =
+ (*(trace "patch" (dprintf "extractPatternVar %s\n" s));*)
+ (String.sub s 6 ((String.length s) - 7))
+
+
+(* a few debugging printers.. *)
+let printExpr (e : expression) =
+begin
+ if (verbose && traceActive "patchDebug") then (
+ Cprint.print_expression e; Cprint.force_new_line ();
+ Cprint.flush ()
+ )
+end
+
+let printSpec (spec: spec_elem list) =
+begin
+ if (verbose && traceActive "patchDebug") then (
+ Cprint.print_specifiers spec; Cprint.force_new_line ();
+ Cprint.flush ()
+ )
+end
+
+let printSpecs (pat : spec_elem list) (tgt : spec_elem list) =
+begin
+ (printSpec pat);
+ (printSpec tgt)
+end
+
+let printDecl (pat : name) (tgt : name) =
+begin
+ if (verbose && traceActive "patchDebug") then (
+ Cprint.print_name pat; Cprint.force_new_line ();
+ Cprint.print_name tgt; Cprint.force_new_line ();
+ Cprint.flush ()
+ )
+end
+
+let printDeclType (pat : decl_type) (tgt : decl_type) =
+begin
+ if (verbose && traceActive "patchDebug") then (
+ Cprint.print_decl "__missing_field_name" pat; Cprint.force_new_line ();
+ Cprint.print_decl "__missing_field_name" tgt; Cprint.force_new_line ();
+ Cprint.flush ()
+ )
+end
+
+let printDefn (d : definition) =
+begin
+ if (verbose && traceActive "patchDebug") then (
+ Cprint.print_def d;
+ Cprint.flush ()
+ )
+end
+
+
+(* class to describe how to modify the tree for subtitution *)
+class substitutor (bindings : binding list) = object(self)
+ inherit nopCabsVisitor as super
+
+ (* look in the binding list for a given name *)
+ method findBinding (name : string) : binding =
+ begin
+ try
+ (List.find
+ (fun b ->
+ match b with
+ | BSpecifier(n, _) -> n=name
+ | BName(n, _) -> n=name
+ | BExpr(n, _) -> n=name)
+ bindings)
+ with
+ Not_found -> raise (BadBind ("name not found: " ^ name))
+ end
+
+ method vexpr (e:expression) : expression visitAction =
+ begin
+ match e with
+ | EXPR_PATTERN(name) -> (
+ match (self#findBinding name) with
+ | BExpr(_, expr) -> ChangeTo(expr) (* substitute bound expression *)
+ | _ -> raise (BadBind ("wrong type: " ^ name))
+ )
+ | _ -> DoChildren
+ end
+
+ (* use of a name *)
+ method vvar (s:string) : string =
+ begin
+ if (isPatternVar s) then (
+ let nameString = (extractPatternVar s) in
+ match (self#findBinding nameString) with
+ | BName(_, str) -> str (* substitute *)
+ | _ -> raise (BadBind ("wrong type: " ^ nameString))
+ )
+ else
+ s
+ end
+
+ (* binding introduction of a name *)
+ method vname (k: nameKind) (spec: specifier) (n: name) : name visitAction =
+ begin
+ match n with (s (*variable name*), dtype, attrs, loc) -> (
+ let replacement = (self#vvar s) in (* use replacer from above *)
+ if (s <> replacement) then
+ ChangeTo(replacement, dtype, attrs, loc)
+ else
+ DoChildren (* no replacement *)
+ )
+ end
+
+ method vspec (specList: specifier) : specifier visitAction =
+ begin
+ if verbose then (trace "patchDebug" (dprintf "substitutor: vspec\n"));
+ (printSpec specList);
+
+ (* are any of the specifiers SpecPatterns? we have to check the entire *)
+ (* list, not just the head, because e.g. "typedef @specifier(foo)" has *)
+ (* "typedef" as the head of the specifier list *)
+ if (List.exists (fun elt -> match elt with
+ | SpecPattern(_) -> true
+ | _ -> false)
+ specList) then begin
+ (* yes, replace the existing list with one got by *)
+ (* replacing all occurrences of SpecPatterns *)
+ (trace "patchDebug" (dprintf "at least one spec pattern\n"));
+ ChangeTo
+ (List.flatten
+ (List.map
+ (* for each specifier element, yield the specifier list *)
+ (* to which it maps; then we'll flatten the final result *)
+ (fun elt ->
+ match elt with
+ | SpecPattern(name) -> (
+ match (self#findBinding name) with
+ | BSpecifier(_, replacement) -> (
+ (trace "patchDebug" (dprintf "replacing pattern %s\n" name));
+ replacement
+ )
+ | _ -> raise (BadBind ("wrong type: " ^ name))
+ )
+ | _ -> [elt] (* leave this one alone *)
+ )
+ specList
+ )
+ )
+ end
+ else
+ (* none of the specifiers in specList are patterns *)
+ DoChildren
+ end
+
+ method vtypespec (tspec: typeSpecifier) : typeSpecifier visitAction =
+ begin
+ match tspec with
+ | Tnamed(str) when (isPatternVar str) ->
+ ChangeTo(Tnamed(self#vvar str))
+ | Tstruct(str, fields, extraAttrs) when (isPatternVar str) -> (
+ (trace "patchDebug" (dprintf "substituting %s\n" str));
+ ChangeDoChildrenPost(Tstruct((self#vvar str), fields, extraAttrs), identity)
+ )
+ | Tunion(str, fields, extraAttrs) when (isPatternVar str) ->
+ (trace "patchDebug" (dprintf "substituting %s\n" str));
+ ChangeDoChildrenPost(Tunion((self#vvar str), fields, extraAttrs), identity)
+ | _ -> DoChildren
+ end
+
+end
+
+
+(* why can't I have forward declarations in the language?!! *)
+let unifyExprFwd : (expression -> expression -> binding list) ref
+ = ref (fun e e -> [])
+
+
+(* substitution for expressions *)
+let substExpr (bindings : binding list) (expr : expression) : expression =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "substExpr with %d bindings\n" (List.length bindings)));
+ (printExpr expr);
+
+ (* apply the transformation *)
+ let result = (visitCabsExpression (new substitutor bindings :> cabsVisitor) expr) in
+ (printExpr result);
+
+ result
+end
+
+let d_loc (_:unit) (loc: cabsloc) : doc =
+ text loc.filename ++ chr ':' ++ num loc.lineno
+
+
+(* class to describe how to modify the tree when looking for places *)
+(* to apply expression transformers *)
+class exprTransformer (srcpattern : expression) (destpattern : expression)
+ (patchline : int) (srcloc : cabsloc) = object(self)
+ inherit nopCabsVisitor as super
+
+ method vexpr (e:expression) : expression visitAction =
+ begin
+ (* see if the source pattern matches this subexpression *)
+ try (
+ let bindings = (!unifyExprFwd srcpattern e) in
+
+ (* match! *)
+ (trace "patch" (dprintf "expr match: patch line %d, src %a\n"
+ patchline d_loc srcloc));
+ ChangeTo(substExpr bindings destpattern)
+ )
+
+ with NoMatch -> (
+ (* doesn't apply *)
+ DoChildren
+ )
+ end
+
+ (* other constructs left unchanged *)
+end
+
+
+let unifyList (pat : 'a list) (tgt : 'a list)
+ (unifyElement : 'a -> 'a -> binding list) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyList (pat len %d, tgt len %d)\n"
+ (List.length pat) (List.length tgt)));
+
+ (* walk down the lists *)
+ let rec loop pat tgt : binding list =
+ match pat, tgt with
+ | [], [] -> []
+ | (pelt :: prest), (telt :: trest) ->
+ (unifyElement pelt telt) @
+ (loop prest trest)
+ | _,_ -> (
+ (* no match *)
+ if verbose then (
+ (trace "patchDebug" (dprintf "mismatching list length\n"));
+ );
+ raise NoMatch
+ )
+ in
+ (loop pat tgt)
+end
+
+
+let gettime () : float =
+ (Unix.times ()).Unix.tms_utime
+
+let rec applyPatch (patchFile : file) (srcFile : file) : file =
+begin
+ let patch : definition list = (snd patchFile) in
+ let srcFname : string = (fst srcFile) in
+ let src : definition list = (snd srcFile) in
+
+ (trace "patchTime" (dprintf "applyPatch start: %f\n" (gettime ())));
+ if (traceActive "patchDebug") then
+ Cprint.out := stdout (* hack *)
+ else ();
+
+ (* more hackery *)
+ unifyExprFwd := unifyExpr;
+
+ (* patch a single source definition, yield transformed *)
+ let rec patchDefn (patch : definition list) (d : definition) : definition list =
+ begin
+ match patch with
+ | TRANSFORMER(srcpattern, destpattern, loc) :: rest -> (
+ if verbose then
+ (trace "patchDebug"
+ (dprintf "considering applying defn pattern at line %d to src at %a\n"
+ loc.lineno d_loc (get_definitionloc d)));
+
+ (* see if the source pattern matches the definition 'd' we have *)
+ try (
+ let bindings = (unifyDefn srcpattern d) in
+
+ (* we have a match! apply the substitutions *)
+ (trace "patch" (dprintf "defn match: patch line %d, src %a\n"
+ loc.lineno d_loc (get_definitionloc d)));
+
+ (List.map (fun destElt -> (substDefn bindings destElt)) destpattern)
+ )
+
+ with NoMatch -> (
+ (* no match, continue down list *)
+ (*(trace "patch" (dprintf "no match\n"));*)
+ (patchDefn rest d)
+ )
+ )
+
+ | EXPRTRANSFORMER(srcpattern, destpattern, loc) :: rest -> (
+ if verbose then
+ (trace "patchDebug"
+ (dprintf "considering applying expr pattern at line %d to src at %a\n"
+ loc.lineno d_loc (get_definitionloc d)));
+
+ (* walk around in 'd' looking for expressions to modify *)
+ let dList = (visitCabsDefinition
+ ((new exprTransformer srcpattern destpattern
+ loc.lineno (get_definitionloc d))
+ :> cabsVisitor)
+ d
+ ) in
+
+ (* recursively invoke myself to try additional patches *)
+ (* since visitCabsDefinition might return a list, I'll try my *)
+ (* addtional patches on every yielded definition, then collapse *)
+ (* all of them into a single list *)
+ (List.flatten (List.map (fun d -> (patchDefn rest d)) dList))
+ )
+
+ | _ :: rest -> (
+ (* not a transformer; just keep going *)
+ (patchDefn rest d)
+ )
+ | [] -> (
+ (* reached the end of the patch file with no match *)
+ [d] (* have to wrap it in a list ... *)
+ )
+ end in
+
+ (* transform all the definitions *)
+ let result : definition list =
+ (List.flatten (List.map (fun d -> (patchDefn patch d)) src)) in
+
+ (*Cprint.print_defs result;*)
+
+ if (traceActive "patchDebug") then (
+ (* avoid flush bug? yes *)
+ Cprint.force_new_line ();
+ Cprint.flush ()
+ );
+
+ (trace "patchTime" (dprintf "applyPatch finish: %f\n" (gettime ())));
+ (srcFname, result)
+end
+
+
+(* given a definition pattern 'pat', and a target concrete defintion 'tgt', *)
+(* determine if they can be unified; if so, return the list of bindings of *)
+(* unification variables in pat; otherwise raise NoMatch *)
+and unifyDefn (pat : definition) (tgt : definition) : binding list =
+begin
+ match pat, tgt with
+ | DECDEF((pspecifiers, pdeclarators), _),
+ DECDEF((tspecifiers, tdeclarators), _) -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyDefn of DECDEFs\n"));
+ (unifySpecifiers pspecifiers tspecifiers) @
+ (unifyInitDeclarators pdeclarators tdeclarators)
+ )
+
+ | TYPEDEF((pspec, pdecl), _),
+ TYPEDEF((tspec, tdecl), _) -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyDefn of TYPEDEFs\n"));
+ (unifySpecifiers pspec tspec) @
+ (unifyDeclarators pdecl tdecl)
+ )
+
+ | ONLYTYPEDEF(pspec, _),
+ ONLYTYPEDEF(tspec, _) -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyDefn of ONLYTYPEDEFs\n"));
+ (unifySpecifiers pspec tspec)
+ )
+
+ | _, _ -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching definitions\n"));
+ raise NoMatch
+ )
+end
+
+and unifySpecifier (pat : spec_elem) (tgt : spec_elem) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifySpecifier\n"));
+ (printSpecs [pat] [tgt]);
+
+ if (pat = tgt) then [] else
+
+ match pat, tgt with
+ | SpecType(tspec1), SpecType(tspec2) ->
+ (unifyTypeSpecifier tspec1 tspec2)
+ | SpecPattern(name), _ ->
+ (* record that future occurrances of @specifier(name) will yield this specifier *)
+ if verbose then
+ (trace "patchDebug" (dprintf "found specifier match for %s\n" name));
+ [BSpecifier(name, [tgt])]
+ | _,_ -> (
+ (* no match *)
+ if verbose then (
+ (trace "patchDebug" (dprintf "mismatching specifiers\n"));
+ );
+ raise NoMatch
+ )
+end
+
+and unifySpecifiers (pat : spec_elem list) (tgt : spec_elem list) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifySpecifiers\n"));
+ (printSpecs pat tgt);
+
+ (* canonicalize the specifiers by sorting them *)
+ let pat' = (List.stable_sort compare pat) in
+ let tgt' = (List.stable_sort compare tgt) in
+
+ (* if they are equal, they match with no further checking *)
+ if (pat' = tgt') then [] else
+
+ (* walk down the lists; don't walk the sorted lists because the *)
+ (* pattern must always be last, if it occurs *)
+ let rec loop pat tgt : binding list =
+ match pat, tgt with
+ | [], [] -> []
+ | [SpecPattern(name)], _ ->
+ (* final SpecPattern matches anything which comes after *)
+ (* record that future occurrences of @specifier(name) will yield this specifier *)
+ if verbose then
+ (trace "patchDebug" (dprintf "found specifier match for %s\n" name));
+ [BSpecifier(name, tgt)]
+ | (pspec :: prest), (tspec :: trest) ->
+ (unifySpecifier pspec tspec) @
+ (loop prest trest)
+ | _,_ -> (
+ (* no match *)
+ if verbose then (
+ (trace "patchDebug" (dprintf "mismatching specifier list length\n"));
+ );
+ raise NoMatch
+ )
+ in
+ (loop pat tgt)
+end
+
+and unifyTypeSpecifier (pat: typeSpecifier) (tgt: typeSpecifier) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyTypeSpecifier\n"));
+
+ if (pat = tgt) then [] else
+
+ match pat, tgt with
+ | Tnamed(s1), Tnamed(s2) -> (unifyString s1 s2)
+ | Tstruct(name1, None, _), Tstruct(name2, None, _) ->
+ (unifyString name1 name2)
+ | Tstruct(name1, Some(fields1), _), Tstruct(name2, Some(fields2), _) ->
+ (* ignoring extraAttrs b/c we're just trying to come up with a list
+ * of substitutions, and there's no unify_attributes function, and
+ * I don't care at this time about checking that they are equal .. *)
+ (unifyString name1 name2) @
+ (unifyList fields1 fields2 unifyField)
+ | Tunion(name1, None, _), Tstruct(name2, None, _) ->
+ (unifyString name1 name2)
+ | Tunion(name1, Some(fields1), _), Tunion(name2, Some(fields2), _) ->
+ (unifyString name1 name2) @
+ (unifyList fields1 fields2 unifyField)
+ | Tenum(name1, None, _), Tenum(name2, None, _) ->
+ (unifyString name1 name2)
+ | Tenum(name1, Some(items1), _), Tenum(name2, Some(items2), _) ->
+ (mustEq items1 items2); (* enum items *)
+ (unifyString name1 name2)
+ | TtypeofE(exp1), TtypeofE(exp2) ->
+ (unifyExpr exp1 exp2)
+ | TtypeofT(spec1, dtype1), TtypeofT(spec2, dtype2) ->
+ (unifySpecifiers spec1 spec2) @
+ (unifyDeclType dtype1 dtype2)
+ | _ -> (
+ if verbose then (trace "patchDebug" (dprintf "mismatching typeSpecifiers\n"));
+ raise NoMatch
+ )
+end
+
+and unifyField (pat : field_group) (tgt : field_group) : binding list =
+begin
+ match pat,tgt with (spec1, list1), (spec2, list2) -> (
+ (unifySpecifiers spec1 spec2) @
+ (unifyList list1 list2 unifyNameExprOpt)
+ )
+end
+
+and unifyNameExprOpt (pat : name * expression option)
+ (tgt : name * expression option) : binding list =
+begin
+ match pat,tgt with
+ | (name1, None), (name2, None) -> (unifyName name1 name2)
+ | (name1, Some(exp1)), (name2, Some(exp2)) ->
+ (unifyName name1 name2) @
+ (unifyExpr exp1 exp2)
+ | _,_ -> []
+end
+
+and unifyName (pat : name) (tgt : name) : binding list =
+begin
+ match pat,tgt with (pstr, pdtype, pattrs, ploc), (tstr, tdtype, tattrs, tloc) ->
+ (mustEq pattrs tattrs);
+ (unifyString pstr tstr) @
+ (unifyDeclType pdtype tdtype)
+end
+
+and unifyInitDeclarators (pat : init_name list) (tgt : init_name list) : binding list =
+begin
+ (*
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyInitDeclarators, pat %d, tgt %d\n"
+ (List.length pat) (List.length tgt)));
+ *)
+
+ match pat, tgt with
+ | ((pdecl, piexpr) :: prest),
+ ((tdecl, tiexpr) :: trest) ->
+ (unifyDeclarator pdecl tdecl) @
+ (unifyInitExpr piexpr tiexpr) @
+ (unifyInitDeclarators prest trest)
+ | [], [] -> []
+ | _, _ -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching init declarators\n"));
+ raise NoMatch
+ )
+end
+
+and unifyDeclarators (pat : name list) (tgt : name list) : binding list =
+ (unifyList pat tgt unifyDeclarator)
+
+and unifyDeclarator (pat : name) (tgt : name) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyDeclarator\n"));
+ (printDecl pat tgt);
+
+ match pat, tgt with
+ | (pname, pdtype, pattr, ploc),
+ (tname, tdtype, tattr, tloc) ->
+ (mustEq pattr tattr);
+ (unifyDeclType pdtype tdtype) @
+ (unifyString pname tname)
+end
+
+and unifyDeclType (pat : decl_type) (tgt : decl_type) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifyDeclType\n"));
+ (printDeclType pat tgt);
+
+ match pat, tgt with
+ | JUSTBASE, JUSTBASE -> []
+ | PARENTYPE(pattr1, ptype, pattr2),
+ PARENTYPE(tattr1, ttype, tattr2) ->
+ (mustEq pattr1 tattr1);
+ (mustEq pattr2 tattr2);
+ (unifyDeclType ptype ttype)
+ | ARRAY(ptype, pattr, psz),
+ ARRAY(ttype, tattr, tsz) ->
+ (mustEq pattr tattr);
+ (unifyDeclType ptype ttype) @
+ (unifyExpr psz tsz)
+ | PTR(pattr, ptype),
+ PTR(tattr, ttype) ->
+ (mustEq pattr tattr);
+ (unifyDeclType ptype ttype)
+ | PROTO(ptype, pformals, pva),
+ PROTO(ttype, tformals, tva) ->
+ (mustEq pva tva);
+ (unifyDeclType ptype ttype) @
+ (unifySingleNames pformals tformals)
+ | _ -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching decl_types\n"));
+ raise NoMatch
+ )
+end
+
+and unifySingleNames (pat : single_name list) (tgt : single_name list) : binding list =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "unifySingleNames, pat %d, tgt %d\n"
+ (List.length pat) (List.length tgt)));
+
+ match pat, tgt with
+ | [], [] -> []
+ | (pspec, pdecl) :: prest,
+ (tspec, tdecl) :: trest ->
+ (unifySpecifiers pspec tspec) @
+ (unifyDeclarator pdecl tdecl) @
+ (unifySingleNames prest trest)
+ | _, _ -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching single_name lists\n"));
+ raise NoMatch
+ )
+end
+
+and unifyString (pat : string) (tgt : string) : binding list =
+begin
+ (* equal? match with no further ado *)
+ if (pat = tgt) then [] else
+
+ (* is the pattern a variable? *)
+ if (isPatternVar pat) then
+ (* pat is actually "@name(blah)"; extract the 'blah' *)
+ let varname = (extractPatternVar pat) in
+
+ (* when substituted, this name becomes 'tgt' *)
+ if verbose then
+ (trace "patchDebug" (dprintf "found name match for %s\n" varname));
+ [BName(varname, tgt)]
+
+ else (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching names: %s and %s\n" pat tgt));
+ raise NoMatch
+ )
+end
+
+and unifyExpr (pat : expression) (tgt : expression) : binding list =
+begin
+ (* if they're equal, that's good enough *)
+ if (pat = tgt) then [] else
+
+ (* shorter name *)
+ let ue = unifyExpr in
+
+ (* because of the equality check above, I can omit some cases *)
+ match pat, tgt with
+ | UNARY(pop, pexpr),
+ UNARY(top, texpr) ->
+ (mustEq pop top);
+ (ue pexpr texpr)
+ | BINARY(pop, pexp1, pexp2),
+ BINARY(top, texp1, texp2) ->
+ (mustEq pop top);
+ (ue pexp1 texp1) @
+ (ue pexp2 texp2)
+ | QUESTION(p1, p2, p3),
+ QUESTION(t1, t2, t3) ->
+ (ue p1 t1) @
+ (ue p2 t2) @
+ (ue p3 t3)
+ | CAST((pspec, ptype), piexpr),
+ CAST((tspec, ttype), tiexpr) ->
+ (mustEq ptype ttype);
+ (unifySpecifiers pspec tspec) @
+ (unifyInitExpr piexpr tiexpr)
+ | CALL(pfunc, pargs),
+ CALL(tfunc, targs) ->
+ (ue pfunc tfunc) @
+ (unifyExprs pargs targs)
+ | COMMA(pexprs),
+ COMMA(texprs) ->
+ (unifyExprs pexprs texprs)
+ | EXPR_SIZEOF(pexpr),
+ EXPR_SIZEOF(texpr) ->
+ (ue pexpr texpr)
+ | TYPE_SIZEOF(pspec, ptype),
+ TYPE_SIZEOF(tspec, ttype) ->
+ (mustEq ptype ttype);
+ (unifySpecifiers pspec tspec)
+ | EXPR_ALIGNOF(pexpr),
+ EXPR_ALIGNOF(texpr) ->
+ (ue pexpr texpr)
+ | TYPE_ALIGNOF(pspec, ptype),
+ TYPE_ALIGNOF(tspec, ttype) ->
+ (mustEq ptype ttype);
+ (unifySpecifiers pspec tspec)
+ | INDEX(parr, pindex),
+ INDEX(tarr, tindex) ->
+ (ue parr tarr) @
+ (ue pindex tindex)
+ | MEMBEROF(pexpr, pfield),
+ MEMBEROF(texpr, tfield) ->
+ (mustEq pfield tfield);
+ (ue pexpr texpr)
+ | MEMBEROFPTR(pexpr, pfield),
+ MEMBEROFPTR(texpr, tfield) ->
+ (mustEq pfield tfield);
+ (ue pexpr texpr)
+ | GNU_BODY(pblock),
+ GNU_BODY(tblock) ->
+ (mustEq pblock tblock);
+ []
+ | EXPR_PATTERN(name), _ ->
+ (* match, and contribute binding *)
+ if verbose then
+ (trace "patchDebug" (dprintf "found expr match for %s\n" name));
+ [BExpr(name, tgt)]
+ | a, b ->
+ if (verbose && traceActive "patchDebug") then (
+ (trace "patchDebug" (dprintf "mismatching expression\n"));
+ (printExpr a);
+ (printExpr b)
+ );
+ raise NoMatch
+end
+
+and unifyInitExpr (pat : init_expression) (tgt : init_expression) : binding list =
+begin
+ (*
+ Cprint.print_init_expression pat; Cprint.force_new_line ();
+ Cprint.print_init_expression tgt; Cprint.force_new_line ();
+ Cprint.flush ();
+ *)
+
+ match pat, tgt with
+ | NO_INIT, NO_INIT -> []
+ | SINGLE_INIT(pe), SINGLE_INIT(te) ->
+ (unifyExpr pe te)
+ | COMPOUND_INIT(plist),
+ COMPOUND_INIT(tlist) -> (
+ let rec loop plist tlist =
+ match plist, tlist with
+ | ((pwhat, piexpr) :: prest),
+ ((twhat, tiexpr) :: trest) ->
+ (mustEq pwhat twhat);
+ (unifyInitExpr piexpr tiexpr) @
+ (loop prest trest)
+ | [], [] -> []
+ | _, _ -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching compound init exprs\n"));
+ raise NoMatch
+ )
+ in
+ (loop plist tlist)
+ )
+ | _,_ -> (
+ if verbose then
+ (trace "patchDebug" (dprintf "mismatching init exprs\n"));
+ raise NoMatch
+ )
+end
+
+and unifyExprs (pat : expression list) (tgt : expression list) : binding list =
+ (unifyList pat tgt unifyExpr)
+
+
+(* given the list of bindings 'b', substitute them into 'd' to yield a new definition *)
+and substDefn (bindings : binding list) (defn : definition) : definition =
+begin
+ if verbose then
+ (trace "patchDebug" (dprintf "substDefn with %d bindings\n" (List.length bindings)));
+ (printDefn defn);
+
+ (* apply the transformation *)
+ match (visitCabsDefinition (new substitutor bindings :> cabsVisitor) defn) with
+ | [d] -> d (* expect a singleton list *)
+ | _ -> (failwith "didn't get a singleton list where I expected one")
+end
+
+
+(* end of file *)
diff --git a/cil/src/frontc/patch.mli b/cil/src/frontc/patch.mli
new file mode 100644
index 0000000..4f32870
--- /dev/null
+++ b/cil/src/frontc/patch.mli
@@ -0,0 +1,42 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+
+(* patch.mli *)
+(* interface for patch.ml *)
+
+val applyPatch : Cabs.file -> Cabs.file -> Cabs.file
diff --git a/cil/src/libmaincil.ml b/cil/src/libmaincil.ml
new file mode 100644
index 0000000..952c013
--- /dev/null
+++ b/cil/src/libmaincil.ml
@@ -0,0 +1,108 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* libmaincil *)
+(* this is a replacement for maincil.ml, for the case when we're
+ * creating a C-callable library (libcil.a); all it does is register
+ * a couple of functions and initialize CIL *)
+
+
+module E = Errormsg
+
+open Cil
+
+
+(* print a Cil 'file' to stdout *)
+let unparseToStdout (cil : file) : unit =
+begin
+ dumpFile defaultCilPrinter stdout cil
+end;;
+
+(* a visitor to unroll all types - may need to do some magic to keep attributes *)
+class unrollVisitorClass = object (self)
+ inherit nopCilVisitor
+
+ (* variable declaration *)
+ method vvdec (vi : varinfo) : varinfo visitAction =
+ begin
+ vi.vtype <- unrollTypeDeep vi.vtype;
+ (*ignore (E.log "varinfo for %s in file '%s' line %d byte %d\n" vi.vname vi.vdecl.file vi.vdecl.line vi.vdecl.byte);*)
+ SkipChildren
+ end
+
+ (* global: need to unroll fields of compinfo *)
+ method vglob (g : global) : global list visitAction =
+ begin
+ match g with
+ GCompTag(ci, loc) as g ->
+ let doFieldinfo (fi : fieldinfo) : unit =
+ fi.ftype <- unrollTypeDeep fi.ftype
+ in begin
+ ignore(List.map doFieldinfo ci.cfields);
+ (*ChangeTo [g]*)
+ SkipChildren
+ end
+ | _ -> DoChildren
+ end
+end;;
+
+
+let unrollVisitor = new unrollVisitorClass;;
+
+(* open and parse a C file into a Cil 'file', unroll all typedefs *)
+let parseOneFile (fname: string) : file =
+ let ast : file = Frontc.parse fname () in
+ begin
+ visitCilFile unrollVisitor ast;
+ ast
+ end
+;;
+
+let getDummyTypes () : typ * typ =
+ ( TPtr(TVoid [], []), TInt(IInt, []) )
+;;
+
+(* register some functions - these may be called from C code *)
+Callback.register "cil_parse" parseOneFile;
+Callback.register "cil_unparse" unparseToStdout;
+(* Callback.register "unroll_type_deep" unrollTypeDeep; *)
+Callback.register "get_dummy_types" getDummyTypes;
+
+(* initalize CIL *)
+initCIL ();
+
+
diff --git a/cil/src/machdep.c b/cil/src/machdep.c
new file mode 100644
index 0000000..1134865
--- /dev/null
+++ b/cil/src/machdep.c
@@ -0,0 +1,220 @@
+/*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ */
+
+#include "../config.h"
+
+#include <stdio.h>
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef HAVE_WCHAR_H
+#include <wchar.h>
+#endif
+
+#ifdef _GNUCC
+#define LONGLONG long long
+#define CONST_STRING_LITERALS "true"
+#define VERSION __VERSION__
+#define VERSION_MAJOR __GNUC__
+#define VERSION_MINOR __GNUC_MINOR__
+#endif
+
+#ifdef _MSVC
+#define LONGLONG __int64
+#define CONST_STRING_LITERALS "false"
+#define VERSION "0"
+#define VERSION_MAJOR 0
+#define VERSION_MINOR 0
+#endif
+
+/* The type for the machine dependency structure is generated from the
+ Makefile */
+int main() {
+ fprintf(stderr, "Generating machine dependency information for CIL\n");
+
+ printf("(* Generated by code in %s *)\n", __FILE__);
+ printf("\t version_major = %d;\n", VERSION_MAJOR);
+ printf("\t version_minor = %d;\n", VERSION_MINOR);
+ printf("\t version = \"%s\";\n", VERSION);
+ // Size of certain types
+ printf("\t sizeof_short = %d;\n", sizeof(short));
+ printf("\t sizeof_int = %d;\n", sizeof(int));
+ printf("\t sizeof_long = %d;\n", sizeof(long));
+ printf("\t sizeof_longlong = %d;\n", sizeof(LONGLONG));
+ printf("\t sizeof_ptr = %d;\n", sizeof(int *));
+ printf("\t sizeof_enum = %d;\n", sizeof(enum e { ONE, TWO }));
+ printf("\t sizeof_float = %d;\n", sizeof(float));
+ printf("\t sizeof_double = %d;\n", sizeof(double));
+ printf("\t sizeof_longdouble = %d;\n", sizeof(long double));
+ printf("\t sizeof_sizeof = %d;\n", sizeof(sizeof(int)));
+ printf("\t sizeof_wchar = %d;\n", sizeof(wchar_t));
+ printf("\t sizeof_void = %d;\n", sizeof(void));
+ printf("\t sizeof_fun = %d;\n",
+#ifdef __GNUC__
+ sizeof(main)
+#else
+ 0
+#endif
+ );
+
+ // The alignment of a short
+ {
+ struct shortstruct {
+ char c;
+ short s;
+ };
+ printf("\t alignof_short = %d;\n",
+ (int)(&((struct shortstruct*)0)->s));
+ }
+
+ // The alignment of an int
+ {
+ struct intstruct {
+ char c;
+ int i;
+ };
+ printf("\t alignof_int = %d;\n",
+ (int)(&((struct intstruct*)0)->i));
+ }
+
+ // The alignment of a long
+ {
+ struct longstruct {
+ char c;
+ long l;
+ };
+ printf("\t alignof_long = %d;\n",
+ (int)(&((struct longstruct*)0)->l));
+ }
+
+ // The alignment of long long
+ {
+ struct longlong {
+ char c;
+ LONGLONG ll;
+ };
+ printf("\t alignof_longlong = %d;\n",
+ (int)(&((struct longlong*)0)->ll));
+ }
+
+ // The alignment of a ptr
+ {
+ struct ptrstruct {
+ char c;
+ int * p;
+ };
+ printf("\t alignof_ptr = %d;\n",
+ (int)(&((struct ptrstruct*)0)->p));
+ }
+
+ // The alignment of an enum
+ {
+ struct enumstruct {
+ char c;
+ enum e2 { THREE, FOUR, FIVE } e;
+ };
+ printf("\t alignof_enum = %d;\n",
+ (int)(&((struct enumstruct*)0)->e));
+ }
+
+ // The alignment of a float
+ {
+ struct floatstruct {
+ char c;
+ float f;
+ };
+ printf("\t alignof_float = %d;\n",
+ (int)(&((struct floatstruct*)0)->f));
+ }
+
+ // The alignment of double
+ {
+ struct s1 {
+ char c;
+ double d;
+ };
+ printf("\t alignof_double = %d;\n",
+ (int)(&((struct s1*)0)->d));
+ }
+
+ // The alignment of long double
+ {
+ struct s1 {
+ char c;
+ long double ld;
+ };
+ printf("\t alignof_longdouble = %d;\n",
+ (int)(&((struct s1*)0)->ld));
+ }
+
+ printf("\t alignof_str = %d;\n",
+#ifdef __GNUC__
+ __alignof("a string")
+#else
+ 0
+#endif
+ );
+
+ printf("\t alignof_fun = %d;\n",
+#ifdef __GNUC__
+ __alignof(main)
+#else
+ 0
+#endif
+ );
+
+ // Whether char is unsigned
+ printf("\t char_is_unsigned = %s;\n",
+ ((char)0xff) > 0 ? "true" : "false");
+
+
+ // Whether string literals contain constant characters
+ puts("\t const_string_literals = " CONST_STRING_LITERALS ";");
+
+
+ // endianity
+ {
+ int e = 0x11223344;
+ printf("\t little_endian = %s;\n",
+ (0x44 == *(char*)&e) ? "true" :
+ ((0x11 == *(char*)&e) ? "false" : (exit(1), "false")));
+ }
+
+ exit(0);
+}
diff --git a/cil/src/main.ml b/cil/src/main.ml
new file mode 100644
index 0000000..bbdb730
--- /dev/null
+++ b/cil/src/main.ml
@@ -0,0 +1,288 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* maincil *)
+(* this module is the program entry point for the 'cilly' program, *)
+(* which reads a C program file, parses it, translates it to the CIL *)
+(* intermediate language, and then renders that back into C *)
+
+
+module F = Frontc
+module C = Cil
+module CK = Check
+module E = Errormsg
+open Pretty
+open Trace
+
+type outfile =
+ { fname: string;
+ fchan: out_channel }
+let outChannel : outfile option ref = ref None
+let mergedChannel : outfile option ref = ref None
+
+
+let parseOneFile (fname: string) : C.file =
+ (* PARSE and convert to CIL *)
+ if !Cilutil.printStages then ignore (E.log "Parsing %s\n" fname);
+ let cil = F.parse fname () in
+
+ if (not !Epicenter.doEpicenter) then (
+ (* sm: remove unused temps to cut down on gcc warnings *)
+ (* (Stats.time "usedVar" Rmtmps.removeUnusedTemps cil); *)
+ (trace "sm" (dprintf "removing unused temporaries\n"));
+ (Rmtmps.removeUnusedTemps cil)
+ );
+ cil
+
+(** These are the statically-configured features. To these we append the
+ * features defined in Feature_config.ml (from Makefile) *)
+
+let makeCFGFeature : C.featureDescr =
+ { C.fd_name = "makeCFG";
+ C.fd_enabled = Cilutil.makeCFG;
+ C.fd_description = "make the program look more like a CFG" ;
+ C.fd_extraopt = [];
+ C.fd_doit = (fun f ->
+ ignore (Partial.calls_end_basic_blocks f) ;
+ ignore (Partial.globally_unique_vids f) ;
+ Cil.iterGlobals f (fun glob -> match glob with
+ Cil.GFun(fd,_) -> Cil.prepareCFG fd ;
+ (* jc: blockinggraph depends on this "true" arg *)
+ ignore (Cil.computeCFGInfo fd true)
+ | _ -> ())
+ );
+ C.fd_post_check = true;
+ }
+
+let features : C.featureDescr list =
+ [ Epicenter.feature;
+ Simplify.feature;
+ Canonicalize.feature;
+ Callgraph.feature;
+ Logwrites.feature;
+ Heapify.feature1;
+ Heapify.feature2;
+ Oneret.feature;
+ makeCFGFeature; (* ww: make CFG *must* come before Partial *)
+ Partial.feature;
+ Simplemem.feature;
+ Sfi.feature;
+ Dataslicing.feature;
+ Logcalls.feature;
+ Ptranal.feature;
+ Liveness.feature;
+ ]
+ @ Feature_config.features
+
+let rec processOneFile (cil: C.file) =
+ begin
+
+ if !Cilutil.doCheck then begin
+ ignore (E.log "First CIL check\n");
+ ignore (CK.checkFile [] cil);
+ end;
+
+ (* Scan all the features configured from the Makefile and, if they are
+ * enabled then run them on the current file *)
+ List.iter
+ (fun fdesc ->
+ if ! (fdesc.C.fd_enabled) then begin
+ if !E.verboseFlag then
+ ignore (E.log "Running CIL feature %s (%s)\n"
+ fdesc.C.fd_name fdesc.C.fd_description);
+ (* Run the feature, and see how long it takes. *)
+ Stats.time fdesc.C.fd_name
+ fdesc.C.fd_doit cil;
+ (* See if we need to do some checking *)
+ if !Cilutil.doCheck && fdesc.C.fd_post_check then begin
+ ignore (E.log "CIL check after %s\n" fdesc.C.fd_name);
+ ignore (CK.checkFile [] cil);
+ end
+ end)
+ features;
+
+
+ (match !outChannel with
+ None -> ()
+ | Some c -> Stats.time "printCIL"
+ (C.dumpFile (!C.printerForMaincil) c.fchan c.fname) cil);
+
+ if !E.hadErrors then
+ E.s (E.error "Error while processing file; see above for details.");
+
+ end
+
+(***** MAIN *****)
+let rec theMain () =
+ let usageMsg = "Usage: cilly [options] source-files" in
+ (* Processign of output file arguments *)
+ let openFile (what: string) (takeit: outfile -> unit) (fl: string) =
+ if !E.verboseFlag then
+ ignore (Printf.printf "Setting %s to %s\n" what fl);
+ (try takeit { fname = fl;
+ fchan = open_out fl }
+ with _ ->
+ raise (Arg.Bad ("Cannot open " ^ what ^ " file " ^ fl)))
+ in
+ let outName = ref "" in
+ (* sm: enabling this by default, since I think usually we
+ * want 'cilly' transformations to preserve annotations; I
+ * can easily add a command-line flag if someone sometimes
+ * wants these suppressed *)
+ C.print_CIL_Input := true;
+
+ (*********** COMMAND LINE ARGUMENTS *****************)
+ (* Construct the arguments for the features configured from the Makefile *)
+ let blankLine = ("", Arg.Unit (fun _ -> ()), "") in
+ let featureArgs =
+ List.fold_right
+ (fun fdesc acc ->
+ if !(fdesc.C.fd_enabled) then
+ (* The feature is enabled by default *)
+ blankLine ::
+ ("--dont" ^ fdesc.C.fd_name, Arg.Clear(fdesc.C.fd_enabled),
+ " Disable " ^ fdesc.C.fd_description) ::
+ fdesc.C.fd_extraopt @ acc
+ else
+ (* Disabled by default *)
+ blankLine ::
+ ("--do" ^ fdesc.C.fd_name, Arg.Set(fdesc.C.fd_enabled),
+ " Enable " ^ fdesc.C.fd_description) ::
+ fdesc.C.fd_extraopt @ acc
+ )
+ features
+ [blankLine]
+ in
+ let featureArgs =
+ ("", Arg.Unit (fun () -> ()), "\n\t\tCIL Features") :: featureArgs
+ in
+
+ let argDescr = Ciloptions.options @
+ [
+ "--out", Arg.String (openFile "output"
+ (fun oc -> outChannel := Some oc)),
+ "the name of the output CIL file. The cilly script sets this for you.";
+ "--mergedout", Arg.String (openFile "merged output"
+ (fun oc -> mergedChannel := Some oc)),
+ "specify the name of the merged file";
+ ]
+ @ F.args @ featureArgs in
+ begin
+ (* this point in the code is the program entry point *)
+
+ Stats.reset (Stats.has_performance_counters ());
+
+ (* parse the command-line arguments *)
+ Arg.parse argDescr Ciloptions.recordFile usageMsg;
+ Cil.initCIL ();
+
+ Ciloptions.fileNames := List.rev !Ciloptions.fileNames;
+
+ if !Cilutil.testcil <> "" then begin
+ Testcil.doit !Cilutil.testcil
+ end else
+ (* parse each of the files named on the command line, to CIL *)
+ let files = List.map parseOneFile !Ciloptions.fileNames in
+
+ (* if there's more than one source file, merge them together; *)
+ (* now we have just one CIL "file" to deal with *)
+ let one =
+ match files with
+ [one] -> one
+ | [] -> E.s (E.error "No arguments for CIL\n")
+ | _ ->
+ let merged =
+ Stats.time "merge" (Mergecil.merge files)
+ (if !outName = "" then "stdout" else !outName) in
+ if !E.hadErrors then
+ E.s (E.error "There were errors during merging\n");
+ (* See if we must save the merged file *)
+ (match !mergedChannel with
+ None -> ()
+ | Some mc -> begin
+ let oldpci = !C.print_CIL_Input in
+ C.print_CIL_Input := true;
+ Stats.time "printMerged"
+ (C.dumpFile !C.printerForMaincil mc.fchan mc.fname) merged;
+ C.print_CIL_Input := oldpci
+ end);
+ merged
+ in
+
+ if !E.hadErrors then
+ E.s (E.error "Cabs2cil had some errors");
+
+ (* process the CIL file (merged if necessary) *)
+ processOneFile one
+ end
+;;
+ (* Define a wrapper for main to
+ * intercept the exit *)
+let failed = ref false
+
+let cleanup () =
+ if !E.verboseFlag || !Cilutil.printStats then
+ Stats.print stderr "Timings:\n";
+ if !E.logChannel != stderr then
+ close_out (! E.logChannel);
+ (match ! outChannel with Some c -> close_out c.fchan | _ -> ())
+
+
+(* Without this handler, cilly.asm.exe will quit silently with return code 0
+ when a segfault happens. *)
+let handleSEGV code =
+ if !Cil.currentLoc == Cil.locUnknown then
+ E.log "**** Segmentation fault (possibly a stack overflow)\n"
+ else begin
+ E.log ("**** Segmentation fault (possibly a stack overflow) "^^
+ "while processing %a\n")
+ Cil.d_loc !Cil.currentLoc
+ end;
+ exit code
+
+let _ = Sys.set_signal Sys.sigsegv (Sys.Signal_handle handleSEGV);
+
+;;
+
+begin
+ try
+ theMain ();
+ with F.CabsOnly -> (* this is OK *) ()
+end;
+cleanup ();
+exit (if !failed then 1 else 0)
+
diff --git a/cil/src/mergecil.ml b/cil/src/mergecil.ml
new file mode 100644
index 0000000..dee519e
--- /dev/null
+++ b/cil/src/mergecil.ml
@@ -0,0 +1,1770 @@
+(* MODIF: Loop constructor replaced by 3 constructors: While, DoWhile, For. *)
+
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* mergecil.ml *)
+(* This module is responsible for merging multiple CIL source trees into
+ * a single, coherent CIL tree which contains the union of all the
+ * definitions in the source files. It effectively acts like a linker,
+ * but at the source code level instead of the object code level. *)
+
+
+module P = Pretty
+open Cil
+module E = Errormsg
+module H = Hashtbl
+module A = Alpha
+open Trace
+
+let debugMerge = false
+let debugInlines = false
+
+let ignore_merge_conflicts = ref false
+
+(* Try to merge structure with the same name. However, do not complain if
+ * they are not the same *)
+let mergeSynonyms = true
+
+
+(** Whether to use path compression *)
+let usePathCompression = false
+
+(* Try to merge definitions of inline functions. They can appear in multiple
+ * files and we would like them all to be the same. This can slow down the
+ * merger an order of magnitude !!! *)
+let mergeInlines = true
+
+let mergeInlinesRepeat = mergeInlines && true
+
+let mergeInlinesWithAlphaConvert = mergeInlines && true
+
+(* when true, merge duplicate definitions of externally-visible functions;
+ * this uses a mechanism which is faster than the one for inline functions,
+ * but only probabilistically accurate *)
+let mergeGlobals = true
+
+
+(* Return true if 's' starts with the prefix 'p' *)
+let prefix p s =
+ let lp = String.length p in
+ let ls = String.length s in
+ lp <= ls && String.sub s 0 lp = p
+
+
+
+(* A name is identified by the index of the file in which it occurs (starting
+ * at 0 with the first file) and by the actual name. We'll keep name spaces
+ * separate *)
+
+(* We define a data structure for the equivalence classes *)
+type 'a node =
+ { nname: string; (* The actual name *)
+ nfidx: int; (* The file index *)
+ ndata: 'a; (* Data associated with the node *)
+ mutable nloc: (location * int) option;
+ (* location where defined and index within the file of the definition.
+ * If None then it means that this node actually DOES NOT appear in the
+ * given file. In rare occasions we need to talk in a given file about
+ * types that are not defined in that file. This happens with undefined
+ * structures but also due to cross-contamination of types in a few of
+ * the cases of combineType (see the definition of combineTypes). We
+ * try never to choose as representatives nodes without a definition.
+ * We also choose as representative the one that appears earliest *)
+ mutable nrep: 'a node; (* A pointer to another node in its class (one
+ * closer to the representative). The nrep node
+ * is always in an earlier file, except for the
+ * case where a name is undefined in one file
+ * and defined in a later file. If this pointer
+ * points to the node itself then this is the
+ * representative. *)
+ mutable nmergedSyns: bool (* Whether we have merged the synonyms for
+ * the node of this name *)
+ }
+
+let d_nloc () (lo: (location * int) option) : P.doc =
+ match lo with
+ None -> P.text "None"
+ | Some (l, idx) -> P.dprintf "Some(%d at %a)" idx d_loc l
+
+(* Make a node with a self loop. This is quite tricky. *)
+let mkSelfNode (eq: (int * string, 'a node) H.t) (* The equivalence table *)
+ (syn: (string, 'a node) H.t) (* The synonyms table *)
+ (fidx: int) (name: string) (data: 'a)
+ (l: (location * int) option) =
+ let res = { nname = name; nfidx = fidx; ndata = data; nloc = l;
+ nrep = Obj.magic 1; nmergedSyns = false; } in
+ res.nrep <- res; (* Make the self cycle *)
+ H.add eq (fidx, name) res; (* Add it to the proper table *)
+ if mergeSynonyms && not (prefix "__anon" name) then
+ H.add syn name res;
+ res
+
+let debugFind = false
+
+(* Find the representative with or without path compression *)
+let rec find (pathcomp: bool) (nd: 'a node) =
+ if debugFind then
+ ignore (E.log " find %s(%d)\n" nd.nname nd.nfidx);
+ if nd.nrep == nd then begin
+ if debugFind then
+ ignore (E.log " = %s(%d)\n" nd.nname nd.nfidx);
+ nd
+ end else begin
+ let res = find pathcomp nd.nrep in
+ if usePathCompression && pathcomp && nd.nrep != res then
+ nd.nrep <- res; (* Compress the paths *)
+ res
+ end
+
+
+(* Union two nodes and return the new representative. We prefer as the
+ * representative a node defined earlier. We try not to use as
+ * representatives nodes that are not defined in their files. We return a
+ * function for undoing the union. Make sure that between the union and the
+ * undo you do not do path compression *)
+let union (nd1: 'a node) (nd2: 'a node) : 'a node * (unit -> unit) =
+ (* Move to the representatives *)
+ let nd1 = find true nd1 in
+ let nd2 = find true nd2 in
+ if nd1 == nd2 then begin
+ (* It can happen that we are trying to union two nodes that are already
+ * equivalent. This is because between the time we check that two nodes
+ * are not already equivalent and the time we invoke the union operation
+ * we check type isomorphism which might change the equivalence classes *)
+(*
+ ignore (warn "unioning already equivalent nodes for %s(%d)"
+ nd1.nname nd1.nfidx);
+*)
+ nd1, fun x -> x
+ end else begin
+ let rep, norep = (* Choose the representative *)
+ if (nd1.nloc != None) = (nd2.nloc != None) then
+ (* They have the same defined status. Choose the earliest *)
+ if nd1.nfidx < nd2.nfidx then nd1, nd2
+ else if nd1.nfidx > nd2.nfidx then nd2, nd1
+ else (* In the same file. Choose the one with the earliest index *) begin
+ match nd1.nloc, nd2.nloc with
+ Some (_, didx1), Some (_, didx2) ->
+ if didx1 < didx2 then nd1, nd2 else
+ if didx1 > didx2 then nd2, nd1
+ else begin
+ ignore (warn
+ "Merging two elements (%s and %s) in the same file (%d) with the same idx (%d) within the file"
+ nd1.nname nd2.nname nd1.nfidx didx1);
+ nd1, nd2
+ end
+ | _, _ -> (* both none. Does not matter which one we choose. Should
+ * not happen though. *)
+ (* sm: it does happen quite a bit when, e.g. merging STLport with
+ * some client source; I'm disabling the warning since it supposedly
+ * is harmless anyway, so is useless noise *)
+ (* sm: re-enabling on claim it now will probably not happen *)
+ ignore (warn "Merging two undefined elements in the same file: %s and %s\n" nd1.nname nd2.nname);
+ nd1, nd2
+ end
+ else (* One is defined, the other is not. Choose the defined one *)
+ if nd1.nloc != None then nd1, nd2 else nd2, nd1
+ in
+ let oldrep = norep.nrep in
+ norep.nrep <- rep;
+ rep, (fun () -> norep.nrep <- oldrep)
+ end
+(*
+let union (nd1: 'a node) (nd2: 'a node) : 'a node * (unit -> unit) =
+ if nd1 == nd2 && nd1.nname = "!!!intEnumInfo!!!" then begin
+ ignore (warn "unioning two identical nodes for %s(%d)"
+ nd1.nname nd1.nfidx);
+ nd1, fun x -> x
+ end else
+ union nd1 nd2
+*)
+(* Find the representative for a node and compress the paths in the process *)
+let findReplacement
+ (pathcomp: bool)
+ (eq: (int * string, 'a node) H.t)
+ (fidx: int)
+ (name: string) : ('a * int) option =
+ if debugFind then
+ ignore (E.log "findReplacement for %s(%d)\n" name fidx);
+ try
+ let nd = H.find eq (fidx, name) in
+ if nd.nrep == nd then begin
+ if debugFind then
+ ignore (E.log " is a representative\n");
+ None (* No replacement if this is the representative of its class *)
+ end else
+ let rep = find pathcomp nd in
+ if rep != rep.nrep then
+ E.s (bug "find does not return the representative\n");
+ if debugFind then
+ ignore (E.log " RES = %s(%d)\n" rep.nname rep.nfidx);
+ Some (rep.ndata, rep.nfidx)
+ with Not_found -> begin
+ if debugFind then
+ ignore (E.log " not found in the map\n");
+ None
+ end
+
+(* Make a node if one does not already exist. Otherwise return the
+ * representative *)
+let getNode (eq: (int * string, 'a node) H.t)
+ (syn: (string, 'a node) H.t)
+ (fidx: int) (name: string) (data: 'a)
+ (l: (location * int) option) =
+ let debugGetNode = false in
+ if debugGetNode then
+ ignore (E.log "getNode(%s(%d), %a)\n"
+ name fidx d_nloc l);
+ try
+ let res = H.find eq (fidx, name) in
+
+ (match res.nloc, l with
+ (* Maybe we have a better location now *)
+ None, Some _ -> res.nloc <- l
+ | Some (old_l, old_idx), Some (l, idx) ->
+ if old_idx != idx then
+ ignore (warn "Duplicate definition of node %s(%d) at indices %d(%a) and %d(%a)"
+ name fidx old_idx d_loc old_l idx d_loc l)
+ else
+ ()
+
+ | _, _ -> ());
+ if debugGetNode then
+ ignore (E.log " node already found\n");
+ find false res (* No path compression *)
+ with Not_found -> begin
+ let res = mkSelfNode eq syn fidx name data l in
+ if debugGetNode then
+ ignore (E.log " made a new one\n");
+ res
+ end
+
+
+
+(* Dump a graph *)
+let dumpGraph (what: string) (eq: (int * string, 'a node) H.t) : unit =
+ ignore (E.log "Equivalence graph for %s is:\n" what);
+ H.iter (fun (fidx, name) nd ->
+ ignore (E.log " %s(%d) %s-> "
+ name fidx (if nd.nloc = None then "(undef)" else ""));
+ if nd.nrep == nd then
+ ignore (E.log "*\n")
+ else
+ ignore (E.log " %s(%d)\n" nd.nrep.nname nd.nrep.nfidx ))
+ eq
+
+
+
+
+(* For each name space we define a set of equivalence classes *)
+let vEq: (int * string, varinfo node) H.t = H.create 111 (* Vars *)
+let sEq: (int * string, compinfo node) H.t = H.create 111 (* Struct + union *)
+let eEq: (int * string, enuminfo node) H.t = H.create 111 (* Enums *)
+let tEq: (int * string, typeinfo node) H.t = H.create 111 (* Type names*)
+let iEq: (int * string, varinfo node) H.t = H.create 111 (* Inlines *)
+
+(* Sometimes we want to merge synonyms. We keep some tables indexed by names.
+ * Each name is mapped to multiple exntries *)
+let vSyn: (string, varinfo node) H.t = H.create 111 (* Not actually used *)
+let iSyn: (string, varinfo node) H.t = H.create 111 (* Inlines *)
+let sSyn: (string, compinfo node) H.t = H.create 111
+let eSyn: (string, enuminfo node) H.t = H.create 111
+let tSyn: (string, typeinfo node) H.t = H.create 111
+
+(** A global environment for variables. Put in here only the non-static
+ * variables, indexed by their name. *)
+let vEnv : (string, varinfo node) H.t = H.create 111
+
+
+(* A set of inline functions indexed by their printout ! *)
+let inlineBodies : (P.doc, varinfo node) H.t = H.create 111
+
+(** A number of alpha conversion tables. We ought to keep one table for each
+ * name space. Unfortunately, because of the way the C lexer works, type
+ * names must be different from variable names!! We one alpha table both for
+ * variables and types. *)
+let vtAlpha : (string, location A.alphaTableData ref) H.t
+ = H.create 57 (* Variables and
+ * types *)
+let sAlpha : (string, location A.alphaTableData ref) H.t
+ = H.create 57 (* Structures and
+ * unions have
+ * the same name
+ * space *)
+let eAlpha : (string, location A.alphaTableData ref) H.t
+ = H.create 57 (* Enumerations *)
+
+
+(** Keep track, for all global function definitions, of the names of the formal
+ * arguments. They might change during merging of function types if the
+ * prototype occurs after the function definition and uses different names.
+ * We'll restore the names at the end *)
+let formalNames: (int * string, string list) H.t = H.create 111
+
+
+(* Accumulate here the globals in the merged file *)
+let theFileTypes = ref []
+let theFile = ref []
+
+(* add 'g' to the merged file *)
+let mergePushGlobal (g: global) : unit =
+ pushGlobal g ~types:theFileTypes ~variables:theFile
+
+let mergePushGlobals gl = List.iter mergePushGlobal gl
+
+
+(* The index of the current file being scanned *)
+let currentFidx = ref 0
+
+let currentDeclIdx = ref 0 (* The index of the definition in a file. This is
+ * maintained both in pass 1 and in pass 2. Make
+ * sure you count the same things in both passes. *)
+(* Keep here the file names *)
+let fileNames : (int, string) H.t = H.create 113
+
+
+
+(* Remember the composite types that we have already declared *)
+let emittedCompDecls: (string, bool) H.t = H.create 113
+(* Remember the variables also *)
+let emittedVarDecls: (string, bool) H.t = H.create 113
+
+(* also keep track of externally-visible function definitions;
+ * name maps to declaration, location, and semantic checksum *)
+let emittedFunDefn: (string, fundec * location * int) H.t = H.create 113
+(* and same for variable definitions; name maps to GVar fields *)
+let emittedVarDefn: (string, varinfo * init option * location) H.t = H.create 113
+
+(** A mapping from the new names to the original names. Used in PASS2 when we
+ * rename variables. *)
+let originalVarNames: (string, string) H.t = H.create 113
+
+(* Initialize the module *)
+let init () =
+ H.clear sAlpha;
+ H.clear eAlpha;
+ H.clear vtAlpha;
+
+ H.clear vEnv;
+
+ H.clear vEq;
+ H.clear sEq;
+ H.clear eEq;
+ H.clear tEq;
+ H.clear iEq;
+
+ H.clear vSyn;
+ H.clear sSyn;
+ H.clear eSyn;
+ H.clear tSyn;
+ H.clear iSyn;
+
+ theFile := [];
+ theFileTypes := [];
+
+ H.clear formalNames;
+ H.clear inlineBodies;
+
+ currentFidx := 0;
+ currentDeclIdx := 0;
+ H.clear fileNames;
+
+ H.clear emittedVarDecls;
+ H.clear emittedCompDecls;
+
+ H.clear emittedFunDefn;
+ H.clear emittedVarDefn;
+
+ H.clear originalVarNames
+
+
+(* Some enumerations have to be turned into an integer. We implement this by
+ * introducing a special enumeration type which we'll recognize later to be
+ * an integer *)
+let intEnumInfo =
+ { ename = "!!!intEnumInfo!!!"; (* This is otherwise invalid *)
+ eitems = [];
+ eattr = [];
+ ereferenced = false;
+ }
+(* And add it to the equivalence graph *)
+let intEnumInfoNode =
+ getNode eEq eSyn 0 intEnumInfo.ename intEnumInfo
+ (Some (locUnknown, 0))
+
+ (* Combine the types. Raises the Failure exception with an error message.
+ * isdef says whether the new type is for a definition *)
+type combineWhat =
+ CombineFundef (* The new definition is for a function definition. The old
+ * is for a prototype *)
+ | CombineFunarg (* Comparing a function argument type with an old prototype
+ * arg *)
+ | CombineFunret (* Comparing the return of a function with that from an old
+ * prototype *)
+ | CombineOther
+
+
+let rec combineTypes (what: combineWhat)
+ (oldfidx: int) (oldt: typ)
+ (fidx: int) (t: typ) : typ =
+ match oldt, t with
+ | TVoid olda, TVoid a -> TVoid (addAttributes olda a)
+ | TInt (oldik, olda), TInt (ik, a) ->
+ let combineIK oldk k =
+ if oldk == k then oldk else
+ (* GCC allows a function definition to have a more precise integer
+ * type than a prototype that says "int" *)
+ if not !msvcMode && oldk = IInt && bitsSizeOf t <= 32
+ && (what = CombineFunarg || what = CombineFunret)
+ then
+ k
+ else (
+ let msg =
+ P.sprint ~width:80
+ (P.dprintf
+ "(different integer types %a and %a)"
+ d_type oldt d_type t) in
+ raise (Failure msg)
+ )
+ in
+ TInt (combineIK oldik ik, addAttributes olda a)
+
+ | TFloat (oldfk, olda), TFloat (fk, a) ->
+ let combineFK oldk k =
+ if oldk == k then oldk else
+ (* GCC allows a function definition to have a more precise integer
+ * type than a prototype that says "double" *)
+ if not !msvcMode && oldk = FDouble && k = FFloat
+ && (what = CombineFunarg || what = CombineFunret)
+ then
+ k
+ else
+ raise (Failure "(different floating point types)")
+ in
+ TFloat (combineFK oldfk fk, addAttributes olda a)
+
+ | TEnum (oldei, olda), TEnum (ei, a) ->
+ (* Matching enumerations always succeeds. But sometimes it maps both
+ * enumerations to integers *)
+ matchEnumInfo oldfidx oldei fidx ei;
+ TEnum (oldei, addAttributes olda a)
+
+
+ (* Strange one. But seems to be handled by GCC *)
+ | TEnum (oldei, olda) , TInt(IInt, a) -> TEnum(oldei,
+ addAttributes olda a)
+
+ (* Strange one. But seems to be handled by GCC. Warning. Here we are
+ * leaking types from new to old *)
+ | TInt(IInt, olda), TEnum (ei, a) -> TEnum(ei, addAttributes olda a)
+
+ | TComp (oldci, olda) , TComp (ci, a) ->
+ matchCompInfo oldfidx oldci fidx ci;
+ (* If we get here we were successful *)
+ TComp (oldci, addAttributes olda a)
+
+ | TArray (oldbt, oldsz, olda), TArray (bt, sz, a) ->
+ let combbt = combineTypes CombineOther oldfidx oldbt fidx bt in
+ let combinesz =
+ match oldsz, sz with
+ None, Some _ -> sz
+ | Some _, None -> oldsz
+ | None, None -> oldsz
+ | Some oldsz', Some sz' ->
+ let samesz =
+ match constFold true oldsz', constFold true sz' with
+ Const(CInt64(oldi, _, _)), Const(CInt64(i, _, _)) -> oldi = i
+ | _, _ -> false
+ in
+ if samesz then oldsz else
+ raise (Failure "(different array sizes)")
+ in
+ TArray (combbt, combinesz, addAttributes olda a)
+
+ | TPtr (oldbt, olda), TPtr (bt, a) ->
+ TPtr (combineTypes CombineOther oldfidx oldbt fidx bt,
+ addAttributes olda a)
+
+ (* WARNING: In this case we are leaking types from new to old !! *)
+ | TFun (_, _, _, [Attr("missingproto",_)]), TFun _ -> t
+
+
+ | TFun _, TFun (_, _, _, [Attr("missingproto",_)]) -> oldt
+
+ | TFun (oldrt, oldargs, oldva, olda), TFun (rt, args, va, a) ->
+ let newrt =
+ combineTypes
+ (if what = CombineFundef then CombineFunret else CombineOther)
+ oldfidx oldrt fidx rt
+ in
+ if oldva != va then
+ raise (Failure "(diferent vararg specifiers)");
+ (* If one does not have arguments, believe the one with the
+ * arguments *)
+ let newargs =
+ if oldargs = None then args else
+ if args = None then oldargs else
+ let oldargslist = argsToList oldargs in
+ let argslist = argsToList args in
+ if List.length oldargslist <> List.length argslist then
+ raise (Failure "(different number of arguments)")
+ else begin
+ (* Go over the arguments and update the old ones with the
+ * adjusted types *)
+ Some
+ (List.map2
+ (fun (on, ot, oa) (an, at, aa) ->
+ let n = if an <> "" then an else on in
+ let t =
+ combineTypes
+ (if what = CombineFundef then
+ CombineFunarg else CombineOther)
+ oldfidx ot fidx at
+ in
+ let a = addAttributes oa aa in
+ (n, t, a))
+ oldargslist argslist)
+ end
+ in
+ TFun (newrt, newargs, oldva, addAttributes olda a)
+
+ | TBuiltin_va_list olda, TBuiltin_va_list a ->
+ TBuiltin_va_list (addAttributes olda a)
+
+ | TNamed (oldt, olda), TNamed (t, a) ->
+ matchTypeInfo oldfidx oldt fidx t;
+ (* If we get here we were able to match *)
+ TNamed(oldt, addAttributes olda a)
+
+ (* Unroll first the new type *)
+ | _, TNamed (t, a) ->
+ let res = combineTypes what oldfidx oldt fidx t.ttype in
+ typeAddAttributes a res
+
+ (* And unroll the old type as well if necessary *)
+ | TNamed (oldt, a), _ ->
+ let res = combineTypes what oldfidx oldt.ttype fidx t in
+ typeAddAttributes a res
+
+ | _ -> (
+ (* raise (Failure "(different type constructors)") *)
+ let msg:string = (P.sprint 1000 (P.dprintf "(different type constructors: %a vs. %a)"
+ d_type oldt d_type t)) in
+ raise (Failure msg)
+ )
+
+
+(* Match two compinfos and throw a Failure if they do not match *)
+and matchCompInfo (oldfidx: int) (oldci: compinfo)
+ (fidx: int) (ci: compinfo) : unit =
+ if oldci.cstruct <> ci.cstruct then
+ raise (Failure "(different struct/union types)");
+ (* See if we have a mapping already *)
+ (* Make the nodes if not already made. Actually return the
+ * representatives *)
+ let oldcinode = getNode sEq sSyn oldfidx oldci.cname oldci None in
+ let cinode = getNode sEq sSyn fidx ci.cname ci None in
+ if oldcinode == cinode then (* We already know they are the same *)
+ ()
+ else begin
+ (* Replace with the representative data *)
+ let oldci = oldcinode.ndata in
+ let oldfidx = oldcinode.nfidx in
+ let ci = cinode.ndata in
+ let fidx = cinode.nfidx in
+
+ let old_len = List.length oldci.cfields in
+ let len = List.length ci.cfields in
+ (* It is easy to catch here the case when the new structure is undefined
+ * and the old one was defined. We just reuse the old *)
+ (* More complicated is the case when the old one is not defined but the
+ * new one is. We still reuse the old one and we'll take care of defining
+ * it later with the new fields.
+ * GN: 7/10/04, I could not find when is "later", so I added it below *)
+ if len <> 0 && old_len <> 0 && old_len <> len then (
+ let curLoc = !currentLoc in (* d_global blows this away.. *)
+ (trace "merge" (P.dprintf "different # of fields\n%d: %a\n%d: %a\n"
+ old_len d_global (GCompTag(oldci,locUnknown))
+ len d_global (GCompTag(ci,locUnknown))
+ ));
+ currentLoc := curLoc;
+ let msg = Printf.sprintf
+ "(different number of fields in %s and %s: %d != %d.)"
+ oldci.cname ci.cname old_len len in
+ raise (Failure msg)
+ );
+ (* We check that they are defined in the same way. While doing this there
+ * might be recursion and we have to watch for going into an infinite
+ * loop. So we add the assumption that they are equal *)
+ let newrep, undo = union oldcinode cinode in
+ (* We check the fields but watch for Failure. We only do the check when
+ * the lengths are the same. Due to the code above this the other
+ * possibility is that one of the length is 0, in which case we reuse the
+ * old compinfo. *)
+ (* But what if the old one is the empty one ? *)
+ if old_len = len then begin
+ (try
+ List.iter2
+ (fun oldf f ->
+ if oldf.fbitfield <> f.fbitfield then
+ raise (Failure "(different bitfield info)");
+ if oldf.fattr <> f.fattr then
+ raise (Failure "(different field attributes)");
+ (* Make sure the types are compatible *)
+ let newtype =
+ combineTypes CombineOther oldfidx oldf.ftype fidx f.ftype
+ in
+ (* Change the type in the representative *)
+ oldf.ftype <- newtype;
+ )
+ oldci.cfields ci.cfields
+ with Failure reason -> begin
+ (* Our assumption was wrong. Forget the isomorphism *)
+ undo ();
+ let msg =
+ P.sprint ~width:80
+ (P.dprintf
+ "\n\tFailed assumption that %s and %s are isomorphic %s@!%a@!%a"
+ (compFullName oldci) (compFullName ci) reason
+ dn_global (GCompTag(oldci,locUnknown))
+ dn_global (GCompTag(ci,locUnknown)))
+ in
+ raise (Failure msg)
+ end)
+ end else begin
+ (* We will reuse the old one. One of them is empty. If the old one is
+ * empty, copy over the fields from the new one. Won't this result in
+ * all sorts of undefined types??? *)
+ if old_len = 0 then
+ oldci.cfields <- ci.cfields;
+ end;
+ (* We get here when we succeeded checking that they are equal, or one of
+ * them was empty *)
+ newrep.ndata.cattr <- addAttributes oldci.cattr ci.cattr;
+ ()
+ end
+
+(* Match two enuminfos and throw a Failure if they do not match *)
+and matchEnumInfo (oldfidx: int) (oldei: enuminfo)
+ (fidx: int) (ei: enuminfo) : unit =
+ (* Find the node for this enum, no path compression. *)
+ let oldeinode = getNode eEq eSyn oldfidx oldei.ename oldei None in
+ let einode = getNode eEq eSyn fidx ei.ename ei None in
+ if oldeinode == einode then (* We already know they are the same *)
+ ()
+ else begin
+ (* Replace with the representative data *)
+ let oldei = oldeinode.ndata in
+ let ei = einode.ndata in
+ (* Try to match them. But if you cannot just make them both integers *)
+ try
+ (* We do not have a mapping. They better be defined in the same way *)
+ if List.length oldei.eitems <> List.length ei.eitems then
+ raise (Failure "(different number of enumeration elements)");
+ (* We check that they are defined in the same way. This is a fairly
+ * conservative check. *)
+ List.iter2
+ (fun (old_iname, old_iv, _) (iname, iv, _) ->
+ if old_iname <> iname then
+ raise (Failure "(different names for enumeration items)");
+ let samev =
+ match constFold true old_iv, constFold true iv with
+ Const(CInt64(oldi, _, _)), Const(CInt64(i, _, _)) -> oldi = i
+ | _ -> false
+ in
+ if not samev then
+ raise (Failure "(different values for enumeration items)"))
+ oldei.eitems ei.eitems;
+ (* Set the representative *)
+ let newrep, _ = union oldeinode einode in
+ (* We get here if the enumerations match *)
+ newrep.ndata.eattr <- addAttributes oldei.eattr ei.eattr;
+ ()
+ with Failure msg -> begin
+ (* Get here if you cannot merge two enumeration nodes *)
+ if oldeinode != intEnumInfoNode then begin
+ let _ = union oldeinode intEnumInfoNode in ()
+ end;
+ if einode != intEnumInfoNode then begin
+ let _ = union einode intEnumInfoNode in ()
+ end;
+ end
+ end
+
+
+(* Match two typeinfos and throw a Failure if they do not match *)
+and matchTypeInfo (oldfidx: int) (oldti: typeinfo)
+ (fidx: int) (ti: typeinfo) : unit =
+ if oldti.tname = "" || ti.tname = "" then
+ E.s (bug "matchTypeInfo for anonymous type\n");
+ (* Find the node for this enum, no path compression. *)
+ let oldtnode = getNode tEq tSyn oldfidx oldti.tname oldti None in
+ let tnode = getNode tEq tSyn fidx ti.tname ti None in
+ if oldtnode == tnode then (* We already know they are the same *)
+ ()
+ else begin
+ (* Replace with the representative data *)
+ let oldti = oldtnode.ndata in
+ let oldfidx = oldtnode.nfidx in
+ let ti = tnode.ndata in
+ let fidx = tnode.nfidx in
+ (* Check that they are the same *)
+ (try
+ ignore (combineTypes CombineOther oldfidx oldti.ttype fidx ti.ttype);
+ with Failure reason -> begin
+ let msg =
+ P.sprint ~width:80
+ (P.dprintf
+ "\n\tFailed assumption that %s and %s are isomorphic %s"
+ oldti.tname ti.tname reason) in
+ raise (Failure msg)
+ end);
+ let _ = union oldtnode tnode in
+ ()
+ end
+
+(* Scan all files and do two things *)
+(* 1. Initialize the alpha renaming tables with the names of the globals so
+ * that when we come in the second pass to generate new names, we do not run
+ * into conflicts. *)
+(* 2. For all declarations of globals unify their types. In the process
+ * construct a set of equivalence classes on type names, structure and
+ * enumeration tags *)
+(* 3. We clean the referenced flags *)
+
+let rec oneFilePass1 (f:file) : unit =
+ H.add fileNames !currentFidx f.fileName;
+ if debugMerge || !E.verboseFlag then
+ ignore (E.log "Pre-merging (%d) %s\n" !currentFidx f.fileName);
+ currentDeclIdx := 0;
+ if f.globinitcalled || f.globinit <> None then
+ E.s (E.warn "Merging file %s has global initializer" f.fileName);
+
+ (* We scan each file and we look at all global varinfo. We see if globals
+ * with the same name have been encountered before and we merge those types
+ * *)
+ let matchVarinfo (vi: varinfo) (l: location * int) =
+ ignore (Alpha.registerAlphaName vtAlpha None vi.vname !currentLoc);
+ (* Make a node for it and put it in vEq *)
+ let vinode = mkSelfNode vEq vSyn !currentFidx vi.vname vi (Some l) in
+ try
+ let oldvinode = find true (H.find vEnv vi.vname) in
+ let oldloc, _ =
+ match oldvinode.nloc with
+ None -> E.s (bug "old variable is undefined")
+ | Some l -> l
+ in
+ let oldvi = oldvinode.ndata in
+ (* There is an old definition. We must combine the types. Do this first
+ * because it might fail *)
+ let newtype =
+ try
+ combineTypes CombineOther
+ oldvinode.nfidx oldvi.vtype
+ !currentFidx vi.vtype;
+ with (Failure reason) -> begin
+ (* Go ahead *)
+ let f = if !ignore_merge_conflicts then warn else error in
+ ignore (f "Incompatible declaration for %s (from %s(%d)).@! Previous was at %a (from %s (%d)) %s "
+ vi.vname (H.find fileNames !currentFidx) !currentFidx
+ d_loc oldloc
+ (H.find fileNames oldvinode.nfidx) oldvinode.nfidx
+ reason);
+ raise Not_found
+ end
+ in
+ let newrep, _ = union oldvinode vinode in
+ (* We do not want to turn non-"const" globals into "const" one. That
+ * can happen if one file declares the variable a non-const while
+ * others declare it as "const". *)
+ if hasAttribute "const" (typeAttrs vi.vtype) !=
+ hasAttribute "const" (typeAttrs oldvi.vtype) then begin
+ newrep.ndata.vtype <- typeRemoveAttributes ["const"] newtype;
+ end else begin
+ newrep.ndata.vtype <- newtype;
+ end;
+ (* clean up the storage. *)
+ let newstorage =
+ if vi.vstorage = oldvi.vstorage || vi.vstorage = Extern then
+ oldvi.vstorage
+ else if oldvi.vstorage = Extern then vi.vstorage
+ (* Sometimes we turn the NoStorage specifier into Static for inline
+ * functions *)
+ else if oldvi.vstorage = Static &&
+ vi.vstorage = NoStorage then Static
+ else begin
+ ignore (warn "Inconsistent storage specification for %s. Now is %a and previous was %a at %a"
+ vi.vname d_storage vi.vstorage d_storage oldvi.vstorage
+ d_loc oldloc);
+ vi.vstorage
+ end
+ in
+ newrep.ndata.vstorage <- newstorage;
+ newrep.ndata.vattr <- addAttributes oldvi.vattr vi.vattr;
+ ()
+ with Not_found -> (* Not present in the previous files. Remember it for
+ * later *)
+ H.add vEnv vi.vname vinode
+
+ in
+ List.iter
+ (function
+ | GVarDecl (vi, l) | GVar (vi, _, l) ->
+ currentLoc := l;
+ incr currentDeclIdx;
+ vi.vreferenced <- false;
+ if vi.vstorage <> Static then begin
+ matchVarinfo vi (l, !currentDeclIdx);
+ end
+
+ | GFun (fdec, l) ->
+ currentLoc := l;
+ incr currentDeclIdx;
+ (* Save the names of the formal arguments *)
+ let _, args, _, _ = splitFunctionTypeVI fdec.svar in
+ H.add formalNames (!currentFidx, fdec.svar.vname)
+ (List.map (fun (fn, _, _) -> fn) (argsToList args));
+ fdec.svar.vreferenced <- false;
+ (* Force inline functions to be static. *)
+ (* GN: This turns out to be wrong. inline functions are external,
+ * unless specified to be static. *)
+ (*
+ if fdec.svar.vinline && fdec.svar.vstorage = NoStorage then
+ fdec.svar.vstorage <- Static;
+ *)
+ if fdec.svar.vstorage <> Static then begin
+ matchVarinfo fdec.svar (l, !currentDeclIdx)
+ end else begin
+ if fdec.svar.vinline && mergeInlines then
+ (* Just create the nodes for inline functions *)
+ ignore (getNode iEq iSyn !currentFidx
+ fdec.svar.vname fdec.svar (Some (l, !currentDeclIdx)))
+ end
+ (* Make nodes for the defined type and structure tags *)
+ | GType (t, l) ->
+ incr currentDeclIdx;
+ t.treferenced <- false;
+ if t.tname <> "" then (* The empty names are just for introducing
+ * undefined comp tags *)
+ ignore (getNode tEq tSyn !currentFidx t.tname t
+ (Some (l, !currentDeclIdx)))
+ else begin (* Go inside and clean the referenced flag for the
+ * declared tags *)
+ match t.ttype with
+ TComp (ci, _) ->
+ ci.creferenced <- false;
+ (* Create a node for it *)
+ ignore (getNode sEq sSyn !currentFidx ci.cname ci None)
+
+ | TEnum (ei, _) ->
+ ei.ereferenced <- false;
+ ignore (getNode eEq eSyn !currentFidx ei.ename ei None);
+
+ | _ -> E.s (bug "Anonymous Gtype is not TComp")
+ end
+
+ | GCompTag (ci, l) ->
+ incr currentDeclIdx;
+ ci.creferenced <- false;
+ ignore (getNode sEq sSyn !currentFidx ci.cname ci
+ (Some (l, !currentDeclIdx)))
+ | GEnumTag (ei, l) ->
+ incr currentDeclIdx;
+ ei.ereferenced <- false;
+ ignore (getNode eEq eSyn !currentFidx ei.ename ei
+ (Some (l, !currentDeclIdx)))
+
+ | _ -> ())
+ f.globals
+
+
+(* Try to merge synonyms. Do not give an error if they fail to merge *)
+let doMergeSynonyms
+ (syn : (string, 'a node) H.t)
+ (eq : (int * string, 'a node) H.t)
+ (compare : int -> 'a -> int -> 'a -> unit) (* A comparison function that
+ * throws Failure if no match *)
+ : unit =
+ H.iter (fun n node ->
+ if not node.nmergedSyns then begin
+ (* find all the nodes for the same name *)
+ let all = H.find_all syn n in
+ let rec tryone (classes: 'a node list) (* A number of representatives
+ * for this name *)
+ (nd: 'a node) : 'a node list (* Returns an expanded set
+ * of classes *) =
+ nd.nmergedSyns <- true;
+ (* Compare in turn with all the classes we have so far *)
+ let rec compareWithClasses = function
+ [] -> [nd](* No more classes. Add this as a new class *)
+ | c :: restc ->
+ try
+ compare c.nfidx c.ndata nd.nfidx nd.ndata;
+ (* Success. Stop here the comparison *)
+ c :: restc
+ with Failure _ -> (* Failed. Try next class *)
+ c :: (compareWithClasses restc)
+ in
+ compareWithClasses classes
+ in
+ (* Start with an empty set of classes for this name *)
+ let _ = List.fold_left tryone [] all in
+ ()
+ end)
+ syn
+
+
+let matchInlines (oldfidx: int) (oldi: varinfo)
+ (fidx: int) (i: varinfo) =
+ let oldinode = getNode iEq iSyn oldfidx oldi.vname oldi None in
+ let inode = getNode iEq iSyn fidx i.vname i None in
+ if oldinode == inode then
+ ()
+ else begin
+ (* Replace with the representative data *)
+ let oldi = oldinode.ndata in
+ let oldfidx = oldinode.nfidx in
+ let i = inode.ndata in
+ let fidx = inode.nfidx in
+ (* There is an old definition. We must combine the types. Do this first
+ * because it might fail *)
+ oldi.vtype <-
+ combineTypes CombineOther
+ oldfidx oldi.vtype fidx i.vtype;
+ (* We get here if we have success *)
+ (* Combine the attributes as well *)
+ oldi.vattr <- addAttributes oldi.vattr i.vattr;
+ (* Do not union them yet because we do not know that they are the same.
+ * We have checked only the types so far *)
+ ()
+ end
+
+(************************************************************
+ *
+ * PASS 2
+ *
+ *
+ ************************************************************)
+
+(** Keep track of the functions we have used already in the file. We need
+ * this to avoid removing an inline function that has been used already.
+ * This can only occur if the inline function is defined after it is used
+ * already; a bad style anyway *)
+let varUsedAlready: (string, unit) H.t = H.create 111
+
+(** A visitor that renames uses of variables and types *)
+class renameVisitorClass = object (self)
+ inherit nopCilVisitor
+
+ (* This is either a global variable which we took care of, or a local
+ * variable. Must do its type and attributes. *)
+ method vvdec (vi: varinfo) = DoChildren
+
+ (* This is a variable use. See if we must change it *)
+ method vvrbl (vi: varinfo) : varinfo visitAction =
+ if not vi.vglob then DoChildren else
+ if vi.vreferenced then begin
+ H.add varUsedAlready vi.vname ();
+ DoChildren
+ end else begin
+ match findReplacement true vEq !currentFidx vi.vname with
+ None -> DoChildren
+ | Some (vi', oldfidx) ->
+ if debugMerge then
+ ignore (E.log "Renaming use of var %s(%d) to %s(%d)\n"
+ vi.vname !currentFidx vi'.vname oldfidx);
+ vi'.vreferenced <- true;
+ H.add varUsedAlready vi'.vname ();
+ ChangeTo vi'
+ end
+
+
+ (* The use of a type. Change only those types whose underlying info
+ * is not a root. *)
+ method vtype (t: typ) =
+ match t with
+ TComp (ci, a) when not ci.creferenced -> begin
+ match findReplacement true sEq !currentFidx ci.cname with
+ None -> DoChildren
+ | Some (ci', oldfidx) ->
+ if debugMerge then
+ ignore (E.log "Renaming use of %s(%d) to %s(%d)\n"
+ ci.cname !currentFidx ci'.cname oldfidx);
+ ChangeTo (TComp (ci', visitCilAttributes (self :> cilVisitor) a))
+ end
+ | TEnum (ei, a) when not ei.ereferenced -> begin
+ match findReplacement true eEq !currentFidx ei.ename with
+ None -> DoChildren
+ | Some (ei', _) ->
+ if ei' == intEnumInfo then
+ (* This is actually our friend intEnumInfo *)
+ ChangeTo (TInt(IInt, visitCilAttributes (self :> cilVisitor) a))
+ else
+ ChangeTo (TEnum (ei', visitCilAttributes (self :> cilVisitor) a))
+ end
+
+ | TNamed (ti, a) when not ti.treferenced -> begin
+ match findReplacement true tEq !currentFidx ti.tname with
+ None -> DoChildren
+ | Some (ti', _) ->
+ ChangeTo (TNamed (ti', visitCilAttributes (self :> cilVisitor) a))
+ end
+
+ | _ -> DoChildren
+
+ (* The Field offset might need to be changed to use new compinfo *)
+ method voffs = function
+ Field (f, o) -> begin
+ (* See if the compinfo was changed *)
+ if f.fcomp.creferenced then
+ DoChildren
+ else begin
+ match findReplacement true sEq !currentFidx f.fcomp.cname with
+ None -> DoChildren (* We did not replace it *)
+ | Some (ci', oldfidx) -> begin
+ (* First, find out the index of the original field *)
+ let rec indexOf (i: int) = function
+ [] ->
+ E.s (bug "Cannot find field %s in %s(%d)\n"
+ f.fname (compFullName f.fcomp) !currentFidx)
+ | f' :: rest when f' == f -> i
+ | _ :: rest -> indexOf (i + 1) rest
+ in
+ let index = indexOf 0 f.fcomp.cfields in
+ if List.length ci'.cfields <= index then
+ E.s (bug "Too few fields in replacement %s(%d) for %s(%d)\n"
+ (compFullName ci') oldfidx
+ (compFullName f.fcomp) !currentFidx);
+ let f' = List.nth ci'.cfields index in
+ ChangeDoChildrenPost (Field (f', o), fun x -> x)
+ end
+ end
+ end
+ | _ -> DoChildren
+
+ method vinitoffs o =
+ (self#voffs o) (* treat initializer offsets same as lvalue offsets *)
+
+end
+
+let renameVisitor = new renameVisitorClass
+
+
+(** A visitor that renames uses of inline functions that were discovered in
+ * pass 2 to be used before they are defined. This is like the renameVisitor
+ * except it only looks at the variables (thus it is a bit more efficient)
+ * and it also renames forward declarations of the inlines to be removed. *)
+
+class renameInlineVisitorClass = object (self)
+ inherit nopCilVisitor
+
+ (* This is a variable use. See if we must change it *)
+ method vvrbl (vi: varinfo) : varinfo visitAction =
+ if not vi.vglob then DoChildren else
+ if vi.vreferenced then begin (* Already renamed *)
+ DoChildren
+ end else begin
+ match findReplacement true vEq !currentFidx vi.vname with
+ None -> DoChildren
+ | Some (vi', oldfidx) ->
+ if debugMerge then
+ ignore (E.log "Renaming var %s(%d) to %s(%d)\n"
+ vi.vname !currentFidx vi'.vname oldfidx);
+ vi'.vreferenced <- true;
+ ChangeTo vi'
+ end
+
+ (* And rename some declarations of inlines to remove. We cannot drop this
+ * declaration (see small1/combineinline6) *)
+ method vglob = function
+ GVarDecl(vi, l) when vi.vinline -> begin
+ (* Get the original name *)
+ let origname =
+ try H.find originalVarNames vi.vname
+ with Not_found -> vi.vname
+ in
+ (* Now see if this must be replaced *)
+ match findReplacement true vEq !currentFidx origname with
+ None -> DoChildren
+ | Some (vi', _) -> ChangeTo [GVarDecl (vi', l)]
+ end
+ | _ -> DoChildren
+
+end
+let renameInlinesVisitor = new renameInlineVisitorClass
+
+
+(* sm: First attempt at a semantic checksum for function bodies.
+ * Ideally, two function's checksums would be equal only when their
+ * bodies were provably equivalent; but I'm using a much simpler and
+ * less accurate heuristic here. It should be good enough for the
+ * purpose I have in mind, which is doing duplicate removal of
+ * multiply-instantiated template functions. *)
+let functionChecksum (dec: fundec) : int =
+begin
+ (* checksum the structure of the statements (only) *)
+ let rec stmtListSum (lst : stmt list) : int =
+ (List.fold_left (fun acc s -> acc + (stmtSum s)) 0 lst)
+ and stmtSum (s: stmt) : int =
+ (* strategy is to just throw a lot of prime numbers into the
+ * computation in hopes of avoiding accidental collision.. *)
+ match s.skind with
+ | Instr(l) -> 13 + 67*(List.length l)
+ | Return(_) -> 17
+ | Goto(_) -> 19
+ | Break(_) -> 23
+ | Continue(_) -> 29
+ | If(_,b1,b2,_) -> 31 + 37*(stmtListSum b1.bstmts)
+ + 41*(stmtListSum b2.bstmts)
+ | Switch(_,b,_,_) -> 43 + 47*(stmtListSum b.bstmts)
+ (* don't look at stmt list b/c is not part of tree *)
+(*
+ | Loop(b,_,_,_) -> 49 + 53*(stmtListSum b.bstmts)
+*)
+ | While(_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
+ | DoWhile(_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
+ | For(_,_,_,b,_) -> 49 + 53*(stmtListSum b.bstmts)
+ | Block(b) -> 59 + 61*(stmtListSum b.bstmts)
+ | TryExcept (b, (il, e), h, _) ->
+ 67 + 83*(stmtListSum b.bstmts) + 97*(stmtListSum h.bstmts)
+ | TryFinally (b, h, _) ->
+ 103 + 113*(stmtListSum b.bstmts) + 119*(stmtListSum h.bstmts)
+ in
+
+ (* disabled 2nd and 3rd measure because they appear to get different
+ * values, for the same code, depending on whether the code was just
+ * parsed into CIL or had previously been parsed into CIL, printed
+ * out, then re-parsed into CIL *)
+ let a,b,c,d,e =
+ (List.length dec.sformals), (* # formals *)
+ 0 (*(List.length dec.slocals)*), (* # locals *)
+ 0 (*dec.smaxid*), (* estimate of internal statement count *)
+ (List.length dec.sbody.bstmts), (* number of statements at outer level *)
+ (stmtListSum dec.sbody.bstmts) in (* checksum of statement structure *)
+ (*(trace "sm" (P.dprintf "sum: %s is %d %d %d %d %d\n"*)
+ (* dec.svar.vname a b c d e));*)
+ 2*a + 3*b + 5*c + 7*d + 11*e
+end
+
+
+(* sm: equality for initializers, etc.; this is like '=', except
+ * when we reach shared pieces (like references into the type
+ * structure), we use '==', to prevent circularity *)
+(* update: that's no good; I'm using this to find things which
+ * are equal but from different CIL trees, so nothing will ever
+ * be '=='.. as a hack I'll just change those places to 'true',
+ * so these functions are not now checking proper equality..
+ * places where equality is not complete are marked "INC" *)
+let rec equalInits (x: init) (y: init) : bool =
+begin
+ match x,y with
+ | SingleInit(xe), SingleInit(ye) -> (equalExps xe ye)
+ | CompoundInit(xt, xoil), CompoundInit(yt, yoil) ->
+ (*(xt == yt) &&*) (* INC *) (* types need to be identically equal *)
+ let rec equalLists xoil yoil : bool =
+ match xoil,yoil with
+ | ((xo,xi) :: xrest), ((yo,yi) :: yrest) ->
+ (equalOffsets xo yo) &&
+ (equalInits xi yi) &&
+ (equalLists xrest yrest)
+ | [], [] -> true
+ | _, _ -> false
+ in
+ (equalLists xoil yoil)
+ | _, _ -> false
+end
+
+and equalOffsets (x: offset) (y: offset) : bool =
+begin
+ match x,y with
+ | NoOffset, NoOffset -> true
+ | Field(xfi,xo), Field(yfi,yo) ->
+ (xfi.fname = yfi.fname) && (* INC: same fieldinfo name.. *)
+ (equalOffsets xo yo)
+ | Index(xe,xo), Index(ye,yo) ->
+ (equalExps xe ye) &&
+ (equalOffsets xo yo)
+ | _,_ -> false
+end
+
+and equalExps (x: exp) (y: exp) : bool =
+begin
+ match x,y with
+ | Const(xc), Const(yc) -> xc = yc || (* safe to use '=' on literals *)
+ (
+ (* CIL changes (unsigned)0 into 0U during printing.. *)
+ match xc,yc with
+ | CInt64(xv,_,_),CInt64(yv,_,_) ->
+ (Int64.to_int xv) = 0 && (* ok if they're both 0 *)
+ (Int64.to_int yv) = 0
+ | _,_ -> false
+ )
+ | Lval(xl), Lval(yl) -> (equalLvals xl yl)
+ | SizeOf(xt), SizeOf(yt) -> true (*INC: xt == yt*) (* identical types *)
+ | SizeOfE(xe), SizeOfE(ye) -> (equalExps xe ye)
+ | AlignOf(xt), AlignOf(yt) -> true (*INC: xt == yt*)
+ | AlignOfE(xe), AlignOfE(ye) -> (equalExps xe ye)
+ | UnOp(xop,xe,xt), UnOp(yop,ye,yt) ->
+ xop = yop &&
+ (equalExps xe ye) &&
+ true (*INC: xt == yt*)
+ | BinOp(xop,xe1,xe2,xt), BinOp(yop,ye1,ye2,yt) ->
+ xop = yop &&
+ (equalExps xe1 ye1) &&
+ (equalExps xe2 ye2) &&
+ true (*INC: xt == yt*)
+ | CastE(xt,xe), CastE(yt,ye) ->
+ (*INC: xt == yt &&*)
+ (equalExps xe ye)
+ | AddrOf(xl), AddrOf(yl) -> (equalLvals xl yl)
+ | StartOf(xl), StartOf(yl) -> (equalLvals xl yl)
+
+ (* initializers that go through CIL multiple times sometimes lose casts they
+ * had the first time; so allow a different of a cast *)
+ | CastE(xt,xe), ye ->
+ (equalExps xe ye)
+ | xe, CastE(yt,ye) ->
+ (equalExps xe ye)
+
+ | _,_ -> false
+end
+
+and equalLvals (x: lval) (y: lval) : bool =
+begin
+ match x,y with
+ | (Var(xv),xo), (Var(yv),yo) ->
+ (* I tried, I really did.. the problem is I see these names
+ * before merging collapses them, so __T123 != __T456,
+ * so whatever *)
+ (*(xv.vname = vy.vname) && (* INC: same varinfo names.. *)*)
+ (equalOffsets xo yo)
+
+ | (Mem(xe),xo), (Mem(ye),yo) ->
+ (equalExps xe ye) &&
+ (equalOffsets xo yo)
+ | _,_ -> false
+end
+
+let equalInitOpts (x: init option) (y: init option) : bool =
+begin
+ match x,y with
+ | None,None -> true
+ | Some(xi), Some(yi) -> (equalInits xi yi)
+ | _,_ -> false
+end
+
+
+ (* Now we go once more through the file and we rename the globals that we
+ * keep. We also scan the entire body and we replace references to the
+ * representative types or variables. We set the referenced flags once we
+ * have replaced the names. *)
+let oneFilePass2 (f: file) =
+ if debugMerge || !E.verboseFlag then
+ ignore (E.log "Final merging phase (%d): %s\n"
+ !currentFidx f.fileName);
+ currentDeclIdx := 0; (* Even though we don't need it anymore *)
+ H.clear varUsedAlready;
+ H.clear originalVarNames;
+ (* If we find inline functions that are used before being defined, and thus
+ * before knowing that we can throw them away, then we mark this flag so
+ * that we can make another pass over the file *)
+ let repeatPass2 = ref false in
+ (* Keep a pointer to the contents of the file so far *)
+ let savedTheFile = !theFile in
+
+ let processOneGlobal (g: global) : unit =
+ (* Process a varinfo. Reuse an old one, or rename it if necessary *)
+ let processVarinfo (vi: varinfo) (vloc: location) : varinfo =
+ if vi.vreferenced then
+ vi (* Already done *)
+ else begin
+ (* Maybe it is static. Rename it then *)
+ if vi.vstorage = Static then begin
+ let newName, _ = A.newAlphaName vtAlpha None vi.vname !currentLoc in
+ (* Remember the original name *)
+ H.add originalVarNames newName vi.vname;
+ if debugMerge then ignore (E.log "renaming %s at %a to %s\n"
+ vi.vname d_loc vloc newName);
+ vi.vname <- newName;
+ vi.vid <- newVID ();
+ vi.vreferenced <- true;
+ vi
+ end else begin
+ (* Find the representative *)
+ match findReplacement true vEq !currentFidx vi.vname with
+ None -> vi (* This is the representative *)
+ | Some (vi', _) -> (* Reuse some previous one *)
+ vi'.vreferenced <- true; (* Mark it as done already *)
+ vi'.vaddrof <- vi.vaddrof || vi'.vaddrof;
+ vi'
+ end
+ end
+ in
+ try
+ match g with
+ | GVarDecl (vi, l) as g ->
+ currentLoc := l;
+ incr currentDeclIdx;
+ let vi' = processVarinfo vi l in
+ if vi != vi' then (* Drop this declaration *) ()
+ else if H.mem emittedVarDecls vi'.vname then (* No need to keep it *)
+ ()
+ else begin
+ H.add emittedVarDecls vi'.vname true; (* Remember that we emitted
+ * it *)
+ mergePushGlobals (visitCilGlobal renameVisitor g)
+ end
+
+ | GVar (vi, init, l) ->
+ currentLoc := l;
+ incr currentDeclIdx;
+ let vi' = processVarinfo vi l in
+ (* We must keep this definition even if we reuse this varinfo,
+ * because maybe the previous one was a declaration *)
+ H.add emittedVarDecls vi.vname true; (* Remember that we emitted it*)
+
+ let emitIt:bool = (not mergeGlobals) ||
+ try
+ let prevVar, prevInitOpt, prevLoc =
+ (H.find emittedVarDefn vi'.vname) in
+ (* previously defined; same initializer? *)
+ if (equalInitOpts prevInitOpt init.init)
+ || (init.init = None) then (
+ (trace "mergeGlob"
+ (P.dprintf "dropping global var %s at %a in favor of the one at %a\n"
+ vi'.vname d_loc l d_loc prevLoc));
+ false (* do not emit *)
+ )
+ else if prevInitOpt = None then (
+ (* We have an initializer, but the previous one didn't.
+ We should really convert the previous global from GVar
+ to GVarDecl, but that's not convenient to do here. *)
+ true
+ )
+ else (
+ (* Both GVars have initializers. *)
+ (E.s (error "global var %s at %a has different initializer than %a\n"
+ vi'.vname d_loc l d_loc prevLoc));
+ )
+ with Not_found -> (
+ (* no previous definition *)
+ (H.add emittedVarDefn vi'.vname (vi', init.init, l));
+ true (* emit it *)
+ )
+ in
+
+ if emitIt then
+ mergePushGlobals (visitCilGlobal renameVisitor (GVar(vi', init, l)))
+
+ | GFun (fdec, l) as g ->
+ currentLoc := l;
+ incr currentDeclIdx;
+ (* We apply the renaming *)
+ fdec.svar <- processVarinfo fdec.svar l;
+ (* Get the original name. *)
+ let origname =
+ try H.find originalVarNames fdec.svar.vname
+ with Not_found -> fdec.svar.vname
+ in
+ (* Go in there and rename everything as needed *)
+ let fdec' =
+ match visitCilGlobal renameVisitor g with
+ [GFun(fdec', _)] -> fdec'
+ | _ -> E.s (unimp "renameVisitor for GFun returned something else")
+ in
+ let g' = GFun(fdec', l) in
+ (* Now restore the parameter names *)
+ let _, args, _, _ = splitFunctionTypeVI fdec'.svar in
+ let oldnames, foundthem =
+ try H.find formalNames (!currentFidx, origname), true
+ with Not_found -> begin
+ ignore (warnOpt "Cannot find %s in formalNames" origname);
+ [], false
+ end
+ in
+ if foundthem then begin
+ let argl = argsToList args in
+ if List.length oldnames <> List.length argl then
+ E.s (unimp "After merging the function has more arguments");
+ List.iter2
+ (fun oldn a -> if oldn <> "" then a.vname <- oldn)
+ oldnames fdec.sformals;
+ (* Reflect them in the type *)
+ setFormals fdec fdec.sformals
+ end;
+ (** See if we can remove this inline function *)
+ if fdec'.svar.vinline && mergeInlines then begin
+ let printout =
+ (* Temporarily turn of printing of lines *)
+ let oldprintln = !lineDirectiveStyle in
+ lineDirectiveStyle := None;
+ (* Temporarily set the name to all functions in the same way *)
+ let newname = fdec'.svar.vname in
+ fdec'.svar.vname <- "@@alphaname@@";
+ (* If we must do alpha conversion then temporarily set the
+ * names of the local variables and formals in a standard way *)
+ let nameId = ref 0 in
+ let oldNames : string list ref = ref [] in
+ let renameOne (v: varinfo) =
+ oldNames := v.vname :: !oldNames;
+ incr nameId;
+ v.vname <- "___alpha" ^ string_of_int !nameId
+ in
+ let undoRenameOne (v: varinfo) =
+ match !oldNames with
+ n :: rest ->
+ oldNames := rest;
+ v.vname <- n
+ | _ -> E.s (bug "undoRenameOne")
+ in
+ (* Remember the original type *)
+ let origType = fdec'.svar.vtype in
+ if mergeInlinesWithAlphaConvert then begin
+ (* Rename the formals *)
+ List.iter renameOne fdec'.sformals;
+ (* Reflect in the type *)
+ setFormals fdec' fdec'.sformals;
+ (* Now do the locals *)
+ List.iter renameOne fdec'.slocals
+ end;
+ (* Now print it *)
+ let res = d_global () g' in
+ lineDirectiveStyle := oldprintln;
+ fdec'.svar.vname <- newname;
+ if mergeInlinesWithAlphaConvert then begin
+ (* Do the locals in reverse order *)
+ List.iter undoRenameOne (List.rev fdec'.slocals);
+ (* Do the formals in reverse order *)
+ List.iter undoRenameOne (List.rev fdec'.sformals);
+ (* Restore the type *)
+ fdec'.svar.vtype <- origType;
+ end;
+ res
+ in
+ (* Make a node for this inline function using the original name. *)
+ let inode =
+ getNode vEq vSyn !currentFidx origname fdec'.svar
+ (Some (l, !currentDeclIdx))
+ in
+ if debugInlines then begin
+ ignore (E.log "getNode %s(%d) with loc=%a. declidx=%d\n"
+ inode.nname inode.nfidx
+ d_nloc inode.nloc
+ !currentDeclIdx);
+ ignore (E.log
+ "Looking for previous definition of inline %s(%d)\n"
+ origname !currentFidx);
+ end;
+ try
+ let oldinode = H.find inlineBodies printout in
+ if debugInlines then
+ ignore (E.log " Matches %s(%d)\n"
+ oldinode.nname oldinode.nfidx);
+ (* There is some other inline function with the same printout.
+ * We should reuse this, but watch for the case when the inline
+ * was already used. *)
+ if H.mem varUsedAlready fdec'.svar.vname then begin
+ if mergeInlinesRepeat then begin
+ repeatPass2 := true
+ end else begin
+ ignore (warn "Inline function %s because it is used before it is defined" fdec'.svar.vname);
+ raise Not_found
+ end
+ end;
+ let _ = union oldinode inode in
+ (* Clean up the vreferenced bit in the new inline, so that we
+ * can rename it. Reset the name to the original one so that
+ * we can find the replacement name. *)
+ fdec'.svar.vreferenced <- false;
+ fdec'.svar.vname <- origname;
+ () (* Drop this definition *)
+ with Not_found -> begin
+ if debugInlines then ignore (E.log " Not found\n");
+ H.add inlineBodies printout inode;
+ mergePushGlobal g'
+ end
+ end else begin
+ (* either the function is not inline, or we're not attempting to
+ * merge inlines *)
+ if (mergeGlobals &&
+ not fdec'.svar.vinline &&
+ fdec'.svar.vstorage <> Static) then
+ begin
+ (* sm: this is a non-inline, non-static function. I want to
+ * consider dropping it if a same-named function has already
+ * been put into the merged file *)
+ let curSum = (functionChecksum fdec') in
+ (*(trace "mergeGlob" (P.dprintf "I see extern function %s, sum is %d\n"*)
+ (* fdec'.svar.vname curSum));*)
+ try
+ let prevFun, prevLoc, prevSum =
+ (H.find emittedFunDefn fdec'.svar.vname) in
+ (* previous was found *)
+ if (curSum = prevSum) then
+ (trace "mergeGlob"
+ (P.dprintf "dropping duplicate def'n of func %s at %a in favor of that at %a\n"
+ fdec'.svar.vname d_loc l d_loc prevLoc))
+ else begin
+ (* the checksums differ, so print a warning but keep the
+ * older one to avoid a link error later. I think this is
+ * a reasonable approximation of what ld does. *)
+ (ignore (warn "def'n of func %s at %a (sum %d) conflicts with the one at %a (sum %d); keeping the one at %a.\n"
+ fdec'.svar.vname d_loc l curSum d_loc prevLoc
+ prevSum d_loc prevLoc))
+ end
+ with Not_found -> begin
+ (* there was no previous definition *)
+ (mergePushGlobal g');
+ (H.add emittedFunDefn fdec'.svar.vname (fdec', l, curSum))
+ end
+ end else begin
+ (* not attempting to merge global functions, or it was static
+ * or inline *)
+ mergePushGlobal g'
+ end
+ end
+
+ | GCompTag (ci, l) as g -> begin
+ currentLoc := l;
+ incr currentDeclIdx;
+ if ci.creferenced then
+ ()
+ else begin
+ match findReplacement true sEq !currentFidx ci.cname with
+ None ->
+ (* A new one, we must rename it and keep the definition *)
+ (* Make sure this is root *)
+ (try
+ let nd = H.find sEq (!currentFidx, ci.cname) in
+ if nd.nrep != nd then
+ E.s (bug "Setting creferenced for struct %s(%d) which is not root!\n"
+ ci.cname !currentFidx);
+ with Not_found -> begin
+ E.s (bug "Setting creferenced for struct %s(%d) which is not in the sEq!\n"
+ ci.cname !currentFidx);
+ end);
+ let newname, _ =
+ A.newAlphaName sAlpha None ci.cname !currentLoc in
+ ci.cname <- newname;
+ ci.creferenced <- true;
+ ci.ckey <- H.hash (compFullName ci);
+ (* Now we should visit the fields as well *)
+ H.add emittedCompDecls ci.cname true; (* Remember that we
+ * emitted it *)
+ mergePushGlobals (visitCilGlobal renameVisitor g)
+ | Some (oldci, oldfidx) -> begin
+ (* We are not the representative. Drop this declaration
+ * because we'll not be using it. *)
+ ()
+ end
+ end
+ end
+ | GEnumTag (ei, l) as g -> begin
+ currentLoc := l;
+ incr currentDeclIdx;
+ if ei.ereferenced then
+ ()
+ else begin
+ match findReplacement true eEq !currentFidx ei.ename with
+ None -> (* We must rename it *)
+ let newname, _ =
+ A.newAlphaName eAlpha None ei.ename !currentLoc in
+ ei.ename <- newname;
+ ei.ereferenced <- true;
+ (* And we must rename the items to using the same name space
+ * as the variables *)
+ ei.eitems <-
+ List.map
+ (fun (n, i, loc) ->
+ let newname, _ =
+ A.newAlphaName vtAlpha None n !currentLoc in
+ newname, i, loc)
+ ei.eitems;
+ mergePushGlobals (visitCilGlobal renameVisitor g);
+ | Some (ei', _) -> (* Drop this since we are reusing it from
+ * before *)
+ ()
+ end
+ end
+ | GCompTagDecl (ci, l) -> begin
+ currentLoc := l; (* This is here just to introduce an undefined
+ * structure. But maybe the structure was defined
+ * already. *)
+ (* Do not increment currentDeclIdx because it is not incremented in
+ * pass 1*)
+ if H.mem emittedCompDecls ci.cname then
+ () (* It was already declared *)
+ else begin
+ H.add emittedCompDecls ci.cname true;
+ (* Keep it as a declaration *)
+ mergePushGlobal g;
+ end
+ end
+
+ | GEnumTagDecl (ei, l) ->
+ currentLoc := l;
+ (* Do not increment currentDeclIdx because it is not incremented in
+ * pass 1*)
+ (* Keep it as a declaration *)
+ mergePushGlobal g
+
+
+ | GType (ti, l) as g -> begin
+ currentLoc := l;
+ incr currentDeclIdx;
+ if ti.treferenced then
+ ()
+ else begin
+ match findReplacement true tEq !currentFidx ti.tname with
+ None -> (* We must rename it and keep it *)
+ let newname, _ =
+ A.newAlphaName vtAlpha None ti.tname !currentLoc in
+ ti.tname <- newname;
+ ti.treferenced <- true;
+ mergePushGlobals (visitCilGlobal renameVisitor g);
+ | Some (ti', _) ->(* Drop this since we are reusing it from
+ * before *)
+ ()
+ end
+ end
+ | g -> mergePushGlobals (visitCilGlobal renameVisitor g)
+ with e -> begin
+ let globStr:string = (P.sprint 1000 (P.dprintf
+ "error when merging global %a: %s"
+ d_global g (Printexc.to_string e))) in
+ ignore (E.log "%s\n" globStr);
+ (*"error when merging global: %s\n" (Printexc.to_string e);*)
+ mergePushGlobal (GText (P.sprint 80
+ (P.dprintf "/* error at %t:" d_thisloc)));
+ mergePushGlobal g;
+ mergePushGlobal (GText ("*************** end of error*/"));
+ raise e
+ end
+ in
+ (* Now do the real PASS 2 *)
+ List.iter processOneGlobal f.globals;
+ (* See if we must re-visit the globals in this file because an inline that
+ * is being removed was used before we saw the definition and we decided to
+ * remove it *)
+ if mergeInlinesRepeat && !repeatPass2 then begin
+ if debugMerge || !E.verboseFlag then
+ ignore (E.log "Repeat final merging phase (%d): %s\n"
+ !currentFidx f.fileName);
+ (* We are going to rescan the globals we have added while processing this
+ * file. *)
+ let theseGlobals : global list ref = ref [] in
+ (* Scan a list of globals until we hit a given tail *)
+ let rec scanUntil (tail: 'a list) (l: 'a list) =
+ if tail == l then ()
+ else
+ match l with
+ | [] -> E.s (bug "mergecil: scanUntil could not find the marker\n")
+ | g :: rest ->
+ theseGlobals := g :: !theseGlobals;
+ scanUntil tail rest
+ in
+ (* Collect in theseGlobals all the globals from this file *)
+ theseGlobals := [];
+ scanUntil savedTheFile !theFile;
+ (* Now reprocess them *)
+ theFile := savedTheFile;
+ List.iter (fun g ->
+ theFile := (visitCilGlobal renameInlinesVisitor g) @ !theFile)
+ !theseGlobals;
+ (* Now check if we have inlines that we could not remove
+ H.iter (fun name _ ->
+ if not (H.mem inlinesRemoved name) then
+ ignore (warn "Could not remove inline %s. I have no idea why!\n"
+ name))
+ inlinesToRemove *)
+ end
+
+
+let merge (files: file list) (newname: string) : file =
+ init ();
+
+ (* Make the first pass over the files *)
+ currentFidx := 0;
+ List.iter (fun f -> oneFilePass1 f; incr currentFidx) files;
+
+ (* Now maybe try to force synonyms to be equal *)
+ if mergeSynonyms then begin
+ doMergeSynonyms sSyn sEq matchCompInfo;
+ doMergeSynonyms eSyn eEq matchEnumInfo;
+ doMergeSynonyms tSyn tEq matchTypeInfo;
+ if mergeInlines then begin
+ (* Copy all the nodes from the iEq to vEq as well. This is needed
+ * because vEq will be used for variable renaming *)
+ H.iter (fun k n -> H.add vEq k n) iEq;
+ doMergeSynonyms iSyn iEq matchInlines;
+ end
+ end;
+
+ (* Now maybe dump the graph *)
+ if debugMerge then begin
+ dumpGraph "type" tEq;
+ dumpGraph "struct and union" sEq;
+ dumpGraph "enum" eEq;
+ dumpGraph "variable" vEq;
+ if mergeInlines then dumpGraph "inline" iEq;
+ end;
+ (* Make the second pass over the files. This is when we start rewriting the
+ * file *)
+ currentFidx := 0;
+ List.iter (fun f -> oneFilePass2 f; incr currentFidx) files;
+
+ (* Now reverse the result and return the resulting file *)
+ let rec revonto acc = function
+ [] -> acc
+ | x :: t -> revonto (x :: acc) t
+ in
+ let res =
+ { fileName = newname;
+ globals = revonto (revonto [] !theFile) !theFileTypes;
+ globinit = None;
+ globinitcalled = false;} in
+ init (); (* Make the GC happy *)
+ (* We have made many renaming changes and sometimes we have just guessed a
+ * name wrong. Make sure now that the local names are unique. *)
+ uniqueVarNames res;
+ res
+
+
+
+
+
diff --git a/cil/src/mergecil.mli b/cil/src/mergecil.mli
new file mode 100644
index 0000000..a864c69
--- /dev/null
+++ b/cil/src/mergecil.mli
@@ -0,0 +1,42 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(** Set this to true to ignore the merge conflicts *)
+val ignore_merge_conflicts: bool ref
+
+(** Merge a number of CIL files *)
+val merge: Cil.file list -> string -> Cil.file
diff --git a/cil/src/rmtmps.ml b/cil/src/rmtmps.ml
new file mode 100644
index 0000000..b7dea93
--- /dev/null
+++ b/cil/src/rmtmps.ml
@@ -0,0 +1,778 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* rmtmps.ml *)
+(* implementation for rmtmps.mli *)
+
+open Pretty
+open Cil
+module H = Hashtbl
+module E = Errormsg
+module U = Util
+
+(* Set on the command-line: *)
+let keepUnused = ref false
+let rmUnusedInlines = ref false
+
+
+let trace = Trace.trace "rmtmps"
+
+
+
+(***********************************************************************
+ *
+ * Clearing of "referenced" bits
+ *
+ *)
+
+
+let clearReferencedBits file =
+ let considerGlobal global =
+ match global with
+ | GType (info, _) ->
+ trace (dprintf "clearing mark: %a\n" d_shortglobal global);
+ info.treferenced <- false
+
+ | GEnumTag (info, _)
+ | GEnumTagDecl (info, _) ->
+ trace (dprintf "clearing mark: %a\n" d_shortglobal global);
+ info.ereferenced <- false
+
+ | GCompTag (info, _)
+ | GCompTagDecl (info, _) ->
+ trace (dprintf "clearing mark: %a\n" d_shortglobal global);
+ info.creferenced <- false
+
+ | GVar ({vname = name} as info, _, _)
+ | GVarDecl ({vname = name} as info, _) ->
+ trace (dprintf "clearing mark: %a\n" d_shortglobal global);
+ info.vreferenced <- false
+
+ | GFun ({svar = info} as func, _) ->
+ trace (dprintf "clearing mark: %a\n" d_shortglobal global);
+ info.vreferenced <- false;
+ let clearMark local =
+ trace (dprintf "clearing mark: local %s\n" local.vname);
+ local.vreferenced <- false
+ in
+ List.iter clearMark func.slocals
+
+ | _ ->
+ ()
+ in
+ iterGlobals file considerGlobal
+
+
+(***********************************************************************
+ *
+ * Scanning and categorization of pragmas
+ *
+ *)
+
+
+(* collections of names of things to keep *)
+type collection = (string, unit) H.t
+type keepers = {
+ typedefs : collection;
+ enums : collection;
+ structs : collection;
+ unions : collection;
+ defines : collection;
+ }
+
+
+(* rapid transfer of control when we find a malformed pragma *)
+exception Bad_pragma
+
+let ccureddeepcopystring = "ccureddeepcopy"
+(* Save this length so we don't recompute it each time. *)
+let ccureddeepcopystring_length = String.length ccureddeepcopystring
+
+(* CIL and CCured define several pragmas which prevent removal of
+ * various global symbols. Here we scan for those pragmas and build
+ * up collections of the corresponding symbols' names.
+ *)
+
+let categorizePragmas file =
+
+ (* names of things which should be retained *)
+ let keepers = {
+ typedefs = H.create 0;
+ enums = H.create 0;
+ structs = H.create 0;
+ unions = H.create 0;
+ defines = H.create 1
+ } in
+
+ (* populate these name collections in light of each pragma *)
+ let considerPragma =
+
+ let badPragma location pragma =
+ ignore (warnLoc location "Invalid argument to pragma %s" pragma)
+ in
+
+ function
+ | GPragma (Attr ("cilnoremove" as directive, args), location) ->
+ (* a very flexible pragma: can retain typedefs, enums,
+ * structs, unions, or globals (functions or variables) *)
+ begin
+ let processArg arg =
+ try
+ match arg with
+ | AStr specifier ->
+ (* isolate and categorize one symbol name *)
+ let collection, name =
+ (* Two words denotes a typedef, enum, struct, or
+ * union, as in "type foo" or "enum bar". A
+ * single word denotes a global function or
+ * variable. *)
+ let whitespace = Str.regexp "[ \t]+" in
+ let words = Str.split whitespace specifier in
+ match words with
+ | ["type"; name] ->
+ keepers.typedefs, name
+ | ["enum"; name] ->
+ keepers.enums, name
+ | ["struct"; name] ->
+ keepers.structs, name
+ | ["union"; name] ->
+ keepers.unions, name
+ | [name] ->
+ keepers.defines, name
+ | _ ->
+ raise Bad_pragma
+ in
+ H.add collection name ()
+ | _ ->
+ raise Bad_pragma
+ with Bad_pragma ->
+ badPragma location directive
+ in
+ List.iter processArg args
+ end
+ | GVarDecl (v, _) -> begin
+ (* Look for alias attributes, e.g. Linux modules *)
+ match filterAttributes "alias" v.vattr with
+ [] -> () (* ordinary prototype. *)
+ | [Attr("alias", [AStr othername])] ->
+ H.add keepers.defines othername ()
+ | _ -> E.s (error "Bad alias attribute at %a" d_loc !currentLoc)
+ end
+
+ (*** Begin CCured-specific checks: ***)
+ (* these pragmas indirectly require that we keep the function named in
+ -- the first arguments of boxmodelof and ccuredwrapperof, and
+ -- the third argument of ccureddeepcopy*. *)
+ | GPragma (Attr("ccuredwrapper" as directive, attribute :: _), location) ->
+ begin
+ match attribute with
+ | AStr name ->
+ H.add keepers.defines name ()
+ | _ ->
+ badPragma location directive
+ end
+ | GPragma (Attr("ccuredvararg", funcname :: (ASizeOf t) :: _), location) ->
+ begin
+ match t with
+ | TComp(c,_) when c.cstruct -> (* struct *)
+ H.add keepers.structs c.cname ()
+ | TComp(c,_) -> (* union *)
+ H.add keepers.unions c.cname ()
+ | TNamed(ti,_) ->
+ H.add keepers.typedefs ti.tname ()
+ | TEnum(ei, _) ->
+ H.add keepers.enums ei.ename ()
+ | _ ->
+ ()
+ end
+ | GPragma (Attr(directive, _ :: _ :: attribute :: _), location)
+ when String.length directive > ccureddeepcopystring_length
+ && (Str.first_chars directive ccureddeepcopystring_length)
+ = ccureddeepcopystring ->
+ begin
+ match attribute with
+ | AStr name ->
+ H.add keepers.defines name ()
+ | _ ->
+ badPragma location directive
+ end
+ (** end CCured-specific stuff **)
+ | _ ->
+ ()
+ in
+ iterGlobals file considerPragma;
+ keepers
+
+
+
+(***********************************************************************
+ *
+ * Function body elimination from pragmas
+ *
+ *)
+
+
+(* When performing global slicing, any functions not explicitly marked
+ * as pragma roots are reduced to mere declarations. This leaves one
+ * with a reduced source file that still compiles to object code, but
+ * which contains the bodies of only explicitly retained functions.
+ *)
+
+let amputateFunctionBodies keptGlobals file =
+ let considerGlobal = function
+ | GFun ({svar = {vname = name} as info}, location)
+ when not (H.mem keptGlobals name) ->
+ trace (dprintf "slicing: reducing to prototype: function %s\n" name);
+ GVarDecl (info, location)
+ | other ->
+ other
+ in
+ mapGlobals file considerGlobal
+
+
+
+(***********************************************************************
+ *
+ * Root collection from pragmas
+ *
+ *)
+
+
+let isPragmaRoot keepers = function
+ | GType ({tname = name}, _) ->
+ H.mem keepers.typedefs name
+ | GEnumTag ({ename = name}, _)
+ | GEnumTagDecl ({ename = name}, _) ->
+ H.mem keepers.enums name
+ | GCompTag ({cname = name; cstruct = structure}, _)
+ | GCompTagDecl ({cname = name; cstruct = structure}, _) ->
+ let collection = if structure then keepers.structs else keepers.unions in
+ H.mem collection name
+ | GVar ({vname = name}, _, _)
+ | GVarDecl ({vname = name}, _)
+ | GFun ({svar = {vname = name}}, _) ->
+ H.mem keepers.defines name
+ | _ ->
+ false
+
+
+
+(***********************************************************************
+ *
+ * Common root collecting utilities
+ *
+ *)
+
+
+let traceRoot reason global =
+ trace (dprintf "root (%s): %a@!" reason d_shortglobal global);
+ true
+
+
+let traceNonRoot reason global =
+ trace (dprintf "non-root (%s): %a@!" reason d_shortglobal global);
+ false
+
+
+let hasExportingAttribute funvar =
+ let rec isExportingAttribute = function
+ | Attr ("constructor", []) -> true
+ | Attr ("destructor", []) -> true
+ | _ -> false
+ in
+ List.exists isExportingAttribute funvar.vattr
+
+
+
+(***********************************************************************
+ *
+ * Root collection from external linkage
+ *
+ *)
+
+
+(* Exported roots are those global symbols which are visible to the
+ * linker and dynamic loader. For variables, this consists of
+ * anything that is not "static". For functions, this consists of:
+ *
+ * - functions bearing a "constructor" or "destructor" attribute
+ * - functions declared extern but not inline
+ * - functions declared neither inline nor static
+ *
+ * gcc incorrectly (according to C99) makes inline functions visible to
+ * the linker. So we can only remove inline functions on MSVC.
+ *)
+
+let isExportedRoot global =
+ let result, reason = match global with
+ | GVar ({vstorage = Static}, _, _) ->
+ false, "static variable"
+ | GVar _ ->
+ true, "non-static variable"
+ | GFun ({svar = v}, _) -> begin
+ if hasExportingAttribute v then
+ true, "constructor or destructor function"
+ else if v.vstorage = Static then
+ false, "static function"
+ else if v.vinline && v.vstorage != Extern
+ && (!msvcMode || !rmUnusedInlines) then
+ false, "inline function"
+ else
+ true, "other function"
+ end
+ | GVarDecl(v,_) when hasAttribute "alias" v.vattr ->
+ true, "has GCC alias attribute"
+ | _ ->
+ false, "neither function nor variable"
+ in
+ trace (dprintf "isExportedRoot %a -> %b, %s@!"
+ d_shortglobal global result reason);
+ result
+
+
+
+(***********************************************************************
+ *
+ * Root collection for complete programs
+ *
+ *)
+
+
+(* Exported roots are "main()" and functions bearing a "constructor"
+ * or "destructor" attribute. These are the only things which must be
+ * retained in a complete program.
+ *)
+
+let isCompleteProgramRoot global =
+ let result = match global with
+ | GFun ({svar = {vname = "main"; vstorage = vstorage}}, _) ->
+ vstorage <> Static
+ | GFun (fundec, _)
+ when hasExportingAttribute fundec.svar ->
+ true
+ | _ ->
+ false
+ in
+ trace (dprintf "complete program root -> %b for %a@!" result d_shortglobal global);
+ result
+
+
+(***********************************************************************
+ *
+ * Transitive reachability closure from roots
+ *
+ *)
+
+
+(* This visitor recursively marks all reachable types and variables as used. *)
+class markReachableVisitor
+ ((globalMap: (string, Cil.global) H.t),
+ (currentFunc: fundec option ref)) = object (self)
+ inherit nopCilVisitor
+
+ method vglob = function
+ | GType (typeinfo, _) ->
+ typeinfo.treferenced <- true;
+ DoChildren
+ | GCompTag (compinfo, _)
+ | GCompTagDecl (compinfo, _) ->
+ compinfo.creferenced <- true;
+ DoChildren
+ | GEnumTag (enuminfo, _)
+ | GEnumTagDecl (enuminfo, _) ->
+ enuminfo.ereferenced <- true;
+ DoChildren
+ | GVar (varinfo, _, _)
+ | GVarDecl (varinfo, _)
+ | GFun ({svar = varinfo}, _) ->
+ varinfo.vreferenced <- true;
+ DoChildren
+ | _ ->
+ SkipChildren
+
+ method vinst = function
+ Asm (_, tmpls, _, _, _, _) when !msvcMode ->
+ (* If we have inline assembly on MSVC, we cannot tell which locals
+ * are referenced. Keep thsem all *)
+ (match !currentFunc with
+ Some fd ->
+ List.iter (fun v ->
+ let vre = Str.regexp_string (Str.quote v.vname) in
+ if List.exists (fun tmp ->
+ try ignore (Str.search_forward vre tmp 0); true
+ with Not_found -> false)
+ tmpls
+ then
+ v.vreferenced <- true) fd.slocals
+ | _ -> assert false);
+ DoChildren
+ | _ -> DoChildren
+
+ method vvrbl v =
+ if not v.vreferenced then
+ begin
+ let name = v.vname in
+ if v.vglob then
+ trace (dprintf "marking transitive use: global %s\n" name)
+ else
+ trace (dprintf "marking transitive use: local %s\n" name);
+
+ (* If this is a global, we need to keep everything used in its
+ * definition and declarations. *)
+ if v.vglob then
+ begin
+ trace (dprintf "descending: global %s\n" name);
+ let descend global =
+ ignore (visitCilGlobal (self :> cilVisitor) global)
+ in
+ let globals = Hashtbl.find_all globalMap name in
+ List.iter descend globals
+ end
+ else
+ v.vreferenced <- true;
+ end;
+ SkipChildren
+
+ method vexpr (e: exp) =
+ match e with
+ Const (CEnum (_, _, ei)) -> ei.ereferenced <- true;
+ DoChildren
+ | _ -> DoChildren
+
+ method vtype typ =
+ let old : bool =
+ let visitAttrs attrs =
+ ignore (visitCilAttributes (self :> cilVisitor) attrs)
+ in
+ let visitType typ =
+ ignore (visitCilType (self :> cilVisitor) typ)
+ in
+ match typ with
+ | TEnum(e, attrs) ->
+ let old = e.ereferenced in
+ if not old then
+ begin
+ trace (dprintf "marking transitive use: enum %s\n" e.ename);
+ e.ereferenced <- true;
+ visitAttrs attrs;
+ visitAttrs e.eattr
+ end;
+ old
+
+ | TComp(c, attrs) ->
+ let old = c.creferenced in
+ if not old then
+ begin
+ trace (dprintf "marking transitive use: compound %s\n" c.cname);
+ c.creferenced <- true;
+
+ (* to recurse, we must ask explicitly *)
+ let recurse f = visitType f.ftype in
+ List.iter recurse c.cfields;
+ visitAttrs attrs;
+ visitAttrs c.cattr
+ end;
+ old
+
+ | TNamed(ti, attrs) ->
+ let old = ti.treferenced in
+ if not old then
+ begin
+ trace (dprintf "marking transitive use: typedef %s\n" ti.tname);
+ ti.treferenced <- true;
+
+ (* recurse deeper into the type referred-to by the typedef *)
+ (* to recurse, we must ask explicitly *)
+ visitType ti.ttype;
+ visitAttrs attrs
+ end;
+ old
+
+ | _ ->
+ (* for anything else, just look inside it *)
+ false
+ in
+ if old then
+ SkipChildren
+ else
+ DoChildren
+end
+
+
+let markReachable file isRoot =
+ (* build a mapping from global names back to their definitions &
+ * declarations *)
+ let globalMap = Hashtbl.create 137 in
+ let considerGlobal global =
+ match global with
+ | GFun ({svar = info}, _)
+ | GVar (info, _, _)
+ | GVarDecl (info, _) ->
+ Hashtbl.add globalMap info.vname global
+ | _ ->
+ ()
+ in
+ iterGlobals file considerGlobal;
+
+ let currentFunc = ref None in
+
+ (* mark everything reachable from the global roots *)
+ let visitor = new markReachableVisitor (globalMap, currentFunc) in
+ let visitIfRoot global =
+ if isRoot global then
+ begin
+ trace (dprintf "traversing root global: %a\n" d_shortglobal global);
+ (match global with
+ GFun(fd, _) -> currentFunc := Some fd
+ | _ -> currentFunc := None);
+ ignore (visitCilGlobal visitor global)
+ end
+ else
+ trace (dprintf "skipping non-root global: %a\n" d_shortglobal global)
+ in
+ iterGlobals file visitIfRoot
+
+
+(**********************************************************************
+ *
+ * Marking and removing of unused labels
+ *
+ **********************************************************************)
+
+(* We keep only one label, preferably one that was not introduced by CIL.
+ * Scan a list of labels and return the data for the label that should be
+ * kept, and the remaining filtered list of labels *)
+let labelsToKeep (ll: label list) : (string * location * bool) * label list =
+ let rec loop (sofar: string * location * bool) = function
+ [] -> sofar, []
+ | l :: rest ->
+ let newlabel, keepl =
+ match l with
+ | Case _ | Default _ -> sofar, true
+ | Label (ln, lloc, isorig) -> begin
+ match isorig, sofar with
+ | false, ("", _, _) ->
+ (* keep this one only if we have no label so far *)
+ (ln, lloc, isorig), false
+ | false, _ -> sofar, false
+ | true, (_, _, false) ->
+ (* this is an original label; prefer it to temporary or
+ * missing labels *)
+ (ln, lloc, isorig), false
+ | true, _ -> sofar, false
+ end
+ in
+ let newlabel', rest' = loop newlabel rest in
+ newlabel', (if keepl then l :: rest' else rest')
+ in
+ loop ("", locUnknown, false) ll
+
+class markUsedLabels (labelMap: (string, unit) H.t) = object
+ inherit nopCilVisitor
+
+ method vstmt (s: stmt) =
+ match s.skind with
+ Goto (dest, _) ->
+ let (ln, _, _), _ = labelsToKeep !dest.labels in
+ if ln = "" then
+ E.s (E.bug "rmtmps: destination of statement does not have labels");
+ (* Mark it as used *)
+ H.replace labelMap ln ();
+ DoChildren
+
+ | _ -> DoChildren
+
+ (* No need to go into expressions or instructions *)
+ method vexpr _ = SkipChildren
+ method vinst _ = SkipChildren
+ method vtype _ = SkipChildren
+end
+
+class removeUnusedLabels (labelMap: (string, unit) H.t) = object
+ inherit nopCilVisitor
+
+ method vstmt (s: stmt) =
+ let (ln, lloc, lorig), lrest = labelsToKeep s.labels in
+ s.labels <-
+ (if ln <> "" && H.mem labelMap ln then (* We had labels *)
+ (Label(ln, lloc, lorig) :: lrest)
+ else
+ lrest);
+ DoChildren
+
+ (* No need to go into expressions or instructions *)
+ method vexpr _ = SkipChildren
+ method vinst _ = SkipChildren
+ method vtype _ = SkipChildren
+end
+
+(***********************************************************************
+ *
+ * Removal of unused symbols
+ *
+ *)
+
+
+(* regular expression matching names of uninteresting locals *)
+let uninteresting =
+ let names = [
+ (* Cil.makeTempVar *)
+ "__cil_tmp";
+
+ (* sm: I don't know where it comes from but these show up all over. *)
+ (* this doesn't seem to do what I wanted.. *)
+ "iter";
+
+ (* various macros in glibc's <bits/string2.h> *)
+ "__result";
+ "__s"; "__s1"; "__s2";
+ "__s1_len"; "__s2_len";
+ "__retval"; "__len";
+
+ (* various macros in glibc's <ctype.h> *)
+ "__c"; "__res";
+
+ (* We remove the __malloc variables *)
+ ] in
+
+ (* optional alpha renaming *)
+ let alpha = "\\(___[0-9]+\\)?" in
+
+ let pattern = "\\(" ^ (String.concat "\\|" names) ^ "\\)" ^ alpha ^ "$" in
+ Str.regexp pattern
+
+
+let removeUnmarked file =
+ let removedLocals = ref [] in
+
+ let filterGlobal global =
+ match global with
+ (* unused global types, variables, and functions are simply removed *)
+ | GType ({treferenced = false}, _)
+ | GCompTag ({creferenced = false}, _)
+ | GCompTagDecl ({creferenced = false}, _)
+ | GEnumTag ({ereferenced = false}, _)
+ | GEnumTagDecl ({ereferenced = false}, _)
+ | GVar ({vreferenced = false}, _, _)
+ | GVarDecl ({vreferenced = false}, _)
+ | GFun ({svar = {vreferenced = false}}, _) ->
+ trace (dprintf "removing global: %a\n" d_shortglobal global);
+ false
+
+ (* retained functions may wish to discard some unused locals *)
+ | GFun (func, _) ->
+ let rec filterLocal local =
+ if not local.vreferenced then
+ begin
+ (* along the way, record the interesting locals that were removed *)
+ let name = local.vname in
+ trace (dprintf "removing local: %s\n" name);
+ if not (Str.string_match uninteresting name 0) then
+ removedLocals := (func.svar.vname ^ "::" ^ name) :: !removedLocals;
+ end;
+ local.vreferenced
+ in
+ func.slocals <- List.filter filterLocal func.slocals;
+ (* We also want to remove unused labels. We do it all here, including
+ * marking the used labels *)
+ let usedLabels:(string, unit) H.t = H.create 13 in
+ ignore (visitCilBlock (new markUsedLabels usedLabels) func.sbody);
+ (* And now we scan again and we remove them *)
+ ignore (visitCilBlock (new removeUnusedLabels usedLabels) func.sbody);
+ true
+
+ (* all other globals are retained *)
+ | _ ->
+ trace (dprintf "keeping global: %a\n" d_shortglobal global);
+ true
+ in
+ file.globals <- List.filter filterGlobal file.globals;
+ !removedLocals
+
+
+(***********************************************************************
+ *
+ * Exported interface
+ *
+ *)
+
+
+type rootsFilter = global -> bool
+
+let isDefaultRoot = isExportedRoot
+
+let rec removeUnusedTemps ?(isRoot : rootsFilter = isDefaultRoot) file =
+ if !keepUnused || Trace.traceActive "disableTmpRemoval" then
+ Trace.trace "disableTmpRemoval" (dprintf "temp removal disabled\n")
+ else
+ begin
+ if !E.verboseFlag then
+ ignore (E.log "Removing unused temporaries\n" );
+
+ if Trace.traceActive "printCilTree" then
+ dumpFile defaultCilPrinter stdout "stdout" file;
+
+ (* digest any pragmas that would create additional roots *)
+ let keepers = categorizePragmas file in
+
+ (* if slicing, remove the bodies of non-kept functions *)
+ if !Cilutil.sliceGlobal then
+ amputateFunctionBodies keepers.defines file;
+
+ (* build up the root set *)
+ let isRoot global =
+ isPragmaRoot keepers global ||
+ isRoot global
+ in
+
+ (* mark everything reachable from the global roots *)
+ clearReferencedBits file;
+ markReachable file isRoot;
+
+ (* take out the trash *)
+ let removedLocals = removeUnmarked file in
+
+ (* print which original source variables were removed *)
+ if false && removedLocals != [] then
+ let count = List.length removedLocals in
+ if count > 2000 then
+ ignore (E.warn "%d unused local variables removed" count)
+ else
+ ignore (E.warn "%d unused local variables removed:@!%a"
+ count (docList ~sep:(chr ',' ++ break) text) removedLocals)
+ end
diff --git a/cil/src/rmtmps.mli b/cil/src/rmtmps.mli
new file mode 100644
index 0000000..e29f0c6
--- /dev/null
+++ b/cil/src/rmtmps.mli
@@ -0,0 +1,82 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * Ben Liblit <liblit@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* rmtmps.mli *)
+(* remove unused things from cil files: *)
+(* - local temporaries introduced but not used *)
+(* - global declarations that are not used *)
+(* - types that are not used *)
+(* - labels that are not used (gn) *)
+
+
+(* Some clients may wish to augment or replace the standard strategy
+ * for finding the initially reachable roots. The optional
+ * "isRoot" argument to Rmtmps.removeUnusedTemps grants this
+ * flexibility. If given, it should name a function which will return
+ * true if a given global should be treated as a retained root.
+ *
+ * Function Rmtmps.isDefaultRoot encapsulates the default root
+ * collection, which consists of those global variables and functions
+ * which are visible to the linker and runtime loader. A client's
+ * root filter can use this if the goal is to augment rather than
+ * replace the standard logic. Function Rmtmps.isExportedRoot is an
+ * alternate name for this same function.
+ *
+ * Function Rmtmps.isCompleteProgramRoot is an example of an alternate
+ * root collection. This function assumes that it is operating on a
+ * complete program rather than just one object file. It treats
+ * "main()" as a root, as well as any function carrying the
+ * "constructor" or "destructor" attribute. All other globals are
+ * candidates for removal, regardless of their linkage.
+ *
+ * Note that certain CIL- and CCured-specific pragmas induce
+ * additional global roots. This functionality is always present, and
+ * is not subject to replacement by "filterRoots".
+ *)
+
+type rootsFilter = Cil.global -> bool
+val isDefaultRoot : rootsFilter
+val isExportedRoot : rootsFilter
+val isCompleteProgramRoot : rootsFilter
+
+(* process a complete Cil file *)
+val removeUnusedTemps: ?isRoot:rootsFilter -> Cil.file -> unit
+
+
+val keepUnused: bool ref (* Set this to true to turn off this module *)
+val rmUnusedInlines: bool ref (* Delete unused inline funcs in gcc mode? *)
diff --git a/cil/src/testcil.ml b/cil/src/testcil.ml
new file mode 100644
index 0000000..0c0ef01
--- /dev/null
+++ b/cil/src/testcil.ml
@@ -0,0 +1,440 @@
+(*
+ *
+ * Copyright (c) 2001-2002,
+ * George C. Necula <necula@cs.berkeley.edu>
+ * Scott McPeak <smcpeak@cs.berkeley.edu>
+ * Wes Weimer <weimer@cs.berkeley.edu>
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * 3. The names of the contributors may not be used to endorse or promote
+ * products derived from this software without specific prior written
+ * permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+ * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+ * OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+ * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+ * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+ * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+ * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ *)
+
+(* A test for CIL *)
+open Pretty
+open Cil
+module E = Errormsg
+
+let lu = locUnknown
+
+(* If you have trouble try to reproduce the problem on a smaller type. Try
+ * limiting the maxNesting and integerKinds *)
+let integerKinds = [ IChar; ISChar; IUChar; IInt; IUInt; IShort; IUShort;
+ ILong; IULong; ILongLong; IULongLong ]
+let floatKinds = [ FFloat; FDouble ]
+
+let baseTypes =
+ (List.map (fun ik -> (1, fun _ -> TInt(ik, []))) integerKinds)
+ @ (List.map (fun fk -> (1, fun _ -> TFloat(fk, []))) floatKinds)
+
+
+(* Make a random struct *)
+let maxNesting = ref 3 (* Maximum number of levels for struct nesting *)
+let maxFields = ref 8 (* The maximum number of fields in a struct *)
+let useBitfields = ref false
+let useZeroBitfields = ref true
+
+
+
+(* Collect here the globals *)
+let globals: global list ref = ref []
+let addGlobal (g:global) = globals := g :: !globals
+let getGlobals () = List.rev !globals
+
+(* Collect here the statements for main *)
+let statements: stmt list ref = ref []
+let addStatement (s: stmt) = statements := s :: !statements
+let getStatements () = List.rev !statements
+
+(* Keep here the main function *)
+let main: fundec ref = ref dummyFunDec
+let mainRetVal: varinfo ref = ref dummyFunDec.svar
+
+let assertId = ref 0
+let addAssert (b: exp) (extra: stmt list) : unit =
+ incr assertId;
+ addStatement (mkStmt (If(UnOp(LNot, b, intType),
+ mkBlock (extra @
+ [mkStmt (Return (Some (integer !assertId),
+ lu))]),
+ mkBlock [], lu)))
+
+let addSetRetVal (b: exp) (extra: stmt list) : unit =
+ addStatement
+ (mkStmt (If(UnOp(LNot, b, intType),
+ mkBlock (extra @
+ [mkStmtOneInstr (Set(var !mainRetVal, one, lu))]),
+ mkBlock [], lu)))
+
+
+let printfFun: fundec =
+ let fdec = emptyFunction "printf" in
+ fdec.svar.vtype <-
+ TFun(intType, Some [ ("format", charPtrType, [])], true, []);
+ fdec
+
+
+let memsetFun: fundec =
+ let fdec = emptyFunction "memset" in
+ fdec.svar.vtype <-
+ TFun(voidPtrType, Some [ ("start", voidPtrType, []);
+ ("v", intType, []);
+ ("len", uintType, [])], false, []);
+ fdec
+
+let checkOffsetFun: fundec =
+ let fdec = emptyFunction "checkOffset" in
+ fdec.svar.vtype <-
+ TFun(voidType, Some [ ("start", voidPtrType, []);
+ ("len", uintType, []);
+ ("expected_start", intType, []);
+ ("expected_width", intType, []);
+ ("name", charPtrType, []) ], false, []);
+ fdec
+
+let checkSizeOfFun: fundec =
+ let fdec = emptyFunction "checkSizeOf" in
+ fdec.svar.vtype <-
+ TFun(voidType, Some [ ("len", uintType, []);
+ ("expected", intType, []);
+ ("name", charPtrType, []) ], false, []);
+ fdec
+
+
+let doPrintf format args =
+ mkStmtOneInstr (Call(None, Lval(var printfFun.svar),
+ (Const(CStr format)) :: args, lu))
+
+
+(* Select among the choices, each with a given weight *)
+type 'a selection = int * (unit -> 'a)
+let select (choices: 'a selection list) : 'a =
+ (* Find the total weight *)
+ let total = List.fold_left (fun sum (w, _) -> sum + w) 0 choices in
+ if total = 0 then E.s (E.bug "Total for choices = 0\n");
+ (* Pick a random number *)
+ let thechoice = Random.int total in
+ (* Now get the choice *)
+ let rec loop thechoice = function
+ [] -> E.s (E.bug "Ran out of choices\n")
+ | (w, c) :: rest ->
+ if thechoice < w then c () else loop (thechoice - w) rest
+ in
+ loop thechoice choices
+
+
+(* Generate a new name *)
+let nameId = ref 0
+let newName (base: string) =
+ incr nameId;
+ base ^ (string_of_int !nameId)
+
+
+(********** Testing of SIZEOF ***********)
+
+(* The current selection of types *)
+let typeChoices : typ selection list ref = ref []
+
+let baseTypeChoices : typ selection list ref = ref []
+
+
+let currentNesting = ref 0
+let mkCompType (iss: bool) =
+ if !currentNesting >= !maxNesting then (* Replace it with an int *)
+ select !baseTypeChoices
+ else begin
+ incr currentNesting;
+ let ci =
+ mkCompInfo iss (newName "comp")
+ (fun _ ->
+ let nrFields = 1 + (Random.int !maxFields) in
+ let rec mkFields (i: int) =
+ if i = nrFields then [] else begin
+ let ft = select !typeChoices in
+ let fname = "f" ^ string_of_int i in
+ let fname', width =
+ if not !useBitfields || not (isIntegralType ft)
+ || (Random.int 8 >= 6) then
+ fname, None
+ else begin
+ let tw = bitsSizeOf ft in (* Assume this works for TInt *)
+ let w = (if !useZeroBitfields then 0 else 1) +
+ Random.int (3 * tw / 4) in
+ (if w = 0 then "___missing_field_name" else fname), Some w
+ end
+ in
+ (fname', ft, width, [], lu) :: mkFields (i + 1)
+ end
+ in
+ mkFields 0)
+ []
+ in
+ decr currentNesting;
+ (* Register it with the file *)
+ addGlobal (GCompTag(ci, lu));
+ TComp(ci, [])
+ end
+
+(* Make a pointer type. They are all equal so make one to void *)
+let mkPtrType () = TPtr(TVoid([]), [])
+
+(* Make an array type. *)
+let mkArrayType () =
+ if !currentNesting >= !maxNesting then
+ select !baseTypeChoices
+ else begin
+ incr currentNesting;
+ let at = TArray(select !typeChoices, Some (integer (1 + (Random.int 32))),
+ []) in
+ decr currentNesting;
+ at
+ end
+
+
+let testSizeOf () =
+ let doOne (i: int) =
+(* ignore (E.log "doOne %d\n" i); *)
+ (* Make a random type *)
+ let t = select !typeChoices in
+ (* Create a global with that type *)
+ let g = makeGlobalVar (newName "g") t in
+ addGlobal (GVar(g, {init=None}, lu));
+ addStatement (mkStmtOneInstr(Call(None, Lval(var memsetFun.svar),
+ [ mkAddrOrStartOf (var g); zero;
+ SizeOfE(Lval(var g))], lu)));
+ try
+(* if i = 0 then ignore (E.log "0: %a\n" d_plaintype t); *)
+ let bsz =
+ try bitsSizeOf t (* This is what we are testing *)
+ with e -> begin
+ ignore (E.log "Exception %s caught while computing bitsSizeOf(%a)\n"
+ (Printexc.to_string e) d_type t);
+ raise (Failure "")
+ end
+ in
+(* ignore (E.log "1 "); *)
+ if bsz mod 8 <> 0 then begin
+ ignore (E.log "bitsSizeOf did not return a multiple of 8\n");
+ raise (Failure "");
+ end;
+(* ignore (E.log "2 "); *)
+ (* Check the offset of all fields in there *)
+ let rec checkOffsets (lv: lval) (lvt: typ) =
+ match lvt with
+ TComp(c, _) ->
+ List.iter
+ (fun f ->
+ if f.fname <> "___missing_field_name" then
+ checkOffsets (addOffsetLval (Field(f, NoOffset)) lv) f.ftype)
+ c.cfields
+ | TArray (bt, Some len, _) ->
+ let leni =
+ match isInteger len with
+ Some i64 -> Int64.to_int i64
+ | None -> E.s (E.bug "Array length is not a constant")
+ in
+ let i = Random.int leni in
+ checkOffsets (addOffsetLval (Index(integer i, NoOffset)) lv) bt
+
+ | _ -> (* Now a base type *)
+ let _, off = lv in
+ let start, width = bitsOffset t off in
+ let setLv (v: exp) =
+ match lvt with
+ TFloat (FFloat, _) ->
+ Set((Mem (mkCast (AddrOf lv) intPtrType), NoOffset),
+ v, lu)
+ | TFloat (FDouble, _) ->
+ Set((Mem (mkCast (AddrOf lv)
+ (TPtr(TInt(IULongLong, []), []))), NoOffset),
+ mkCast v (TInt(IULongLong, [])), lu)
+
+ | (TPtr _ | TInt((IULongLong|ILongLong), _)) ->
+ Set(lv, mkCast v lvt, lu)
+ | _ -> Set(lv, v, lu)
+ in
+ let ucharPtrType = TPtr(TInt(IUChar, []), []) in
+ let s =
+ mkStmt (Instr ([ setLv mone;
+ Call(None, Lval(var checkOffsetFun.svar),
+ [ mkCast (mkAddrOrStartOf (var g))
+ ucharPtrType;
+ SizeOfE (Lval(var g));
+ integer start;
+ integer width;
+ (Const(CStr(sprint 80
+ (d_lval () lv))))],lu);
+ setLv zero])) in
+ addStatement s
+ in
+ checkOffsets (var g) t;
+(* ignore (E.log "3 ");*)
+ (* Now check the size of *)
+ let s = mkStmtOneInstr (Call(None, Lval(var checkSizeOfFun.svar),
+ [ SizeOfE (Lval (var g));
+ integer (bitsSizeOf t);
+ mkString g.vname ], lu)) in
+ addStatement s;
+(* ignore (E.log "10\n"); *)
+ with _ -> ()
+ in
+
+ (* Make the composite choices more likely *)
+ typeChoices :=
+ [ (1, mkPtrType);
+ (5, mkArrayType);
+ (5, fun _ -> mkCompType true);
+ (5, fun _ -> mkCompType false); ]
+ @ baseTypes;
+ baseTypeChoices := baseTypes;
+ useBitfields := false;
+ maxFields := 4;
+ for i = 0 to 100 do
+ doOne i
+ done;
+
+ (* Now test the bitfields. *)
+ typeChoices := [ (1, fun _ -> mkCompType true) ];
+ baseTypeChoices := [(1, fun _ -> TInt(IInt, []))];
+ useBitfields := true;
+
+ for i = 0 to 100 do
+ doOne i
+ done;
+
+ (* Now make it a bit more complicated *)
+ baseTypeChoices :=
+ List.map (fun ik -> (1, fun _ -> TInt(ik, [])))
+ [IInt; ILong; IUInt; IULong ];
+ useBitfields := true;
+ for i = 0 to 100 do
+ doOne i
+ done;
+
+ (* An really complicated now *)
+ baseTypeChoices := baseTypes;
+ useBitfields := true;
+ for i = 0 to 100 do
+ doOne i
+ done;
+
+ ()
+
+
+(* Now the main tester. Pass to it the name of a command "cmd" that when
+ * invoked will compile "testingcil.c" and run the result *)
+let createFile () =
+
+ assertId := 0;
+ nameId := 0;
+
+ (* Start a new file *)
+ globals := [];
+ statements := [];
+
+ (* Now make a main function *)
+ main := emptyFunction "main";
+ !main.svar.vtype <- TFun(intType, None, false, []);
+ mainRetVal := makeGlobalVar "retval" intType;
+
+ addGlobal (GVar(!mainRetVal, {init=None}, lu));
+ addGlobal (GText("#include \"testcil.h\"\n"));
+ addStatement (mkStmtOneInstr(Set(var !mainRetVal, zero, lu)));
+
+ (* Add prototype for printf *)
+ addGlobal (GVar(printfFun.svar, {init=None}, lu));
+ addGlobal (GVar(memsetFun.svar, {init=None}, lu));
+
+ (* now fill in the composites and the code of main. For simplicity we add
+ * the statements of main in reverse order *)
+
+ testSizeOf ();
+
+
+ (* Now add a return 0 at the end *)
+ addStatement (mkStmt (Return(Some (Lval(var !mainRetVal)), lu)));
+
+
+ (* Add main at the end *)
+ addGlobal (GFun(!main, lu));
+ !main.sbody.bstmts <- getStatements ();
+
+ (* Now build the CIL.file *)
+ let file =
+ { fileName = "testingcil.c";
+ globals = getGlobals ();
+ globinit = None;
+ globinitcalled = false;
+ }
+ in
+ (* Print the file *)
+ let oc = open_out "testingcil.c" in
+ dumpFile defaultCilPrinter oc "testingcil.c" file;
+ close_out oc
+
+
+
+
+
+(* initialization code for the tester *)
+let randomStateFile = "testcil.random" (* The name of a file where we store
+ * the state of the random number
+ * generator last time *)
+let doit (command: string) =
+ while true do
+ (* Initialize the random no generator *)
+ begin
+ try
+ let randomFile = open_in randomStateFile in
+ (* The file exists so restore the Random state *)
+ Random.set_state (Marshal.from_channel randomFile);
+ ignore (E.log "!! Restoring Random state from %s\n" randomStateFile);
+ close_in randomFile;
+ (* Leave the file there until we succeed *)
+ with _ -> begin
+ (* The file does not exist *)
+ Random.self_init ();
+ (* Save the state of the generator *)
+ let randomFile = open_out randomStateFile in
+ Marshal.to_channel randomFile (Random.get_state()) [] ;
+ close_out randomFile;
+ end
+ end;
+ createFile ();
+ (* Now compile and run the file *)
+ ignore (E.log "Running %s\n" command);
+ let err = Sys.command command in
+ if err <> 0 then
+ E.s (E.bug "Failed to run the command: %s (errcode=%d)" command err)
+ else begin
+ ignore (E.log "Successfully ran one more round. Press CTRL-C to stop\n");
+ (* Delete the file *)
+ Sys.remove randomStateFile
+ end
+ done
+
diff --git a/cil/test/small1/func.c b/cil/test/small1/func.c
new file mode 100644
index 0000000..a0f4e4e
--- /dev/null
+++ b/cil/test/small1/func.c
@@ -0,0 +1,24 @@
+int (*pfun1)(int (*)(int), int);
+int (*pfun2)(int (*)(int), int);
+
+typedef int (*intfun)(int);
+intfun arrfun[5];
+
+int testf(int k) {
+ return k;
+}
+
+int foo(int (*bar)(int), int n) {
+
+ pfun1 = foo;
+ pfun1 = & foo;
+ pfun1 = * * * pfun2;
+
+ pfun1 = arrfun[4];
+
+ pfun2(* * testf, 5);
+
+ return 1;
+}
+
+
diff --git a/cil/test/small1/hello.c b/cil/test/small1/hello.c
new file mode 100644
index 0000000..cbe8ad0
--- /dev/null
+++ b/cil/test/small1/hello.c
@@ -0,0 +1,8 @@
+#include <stdio.h>
+
+
+
+int main() {
+ printf("Hello world\n");
+ return 0;
+}
diff --git a/cil/test/small1/init.c b/cil/test/small1/init.c
new file mode 100644
index 0000000..4578b5b
--- /dev/null
+++ b/cil/test/small1/init.c
@@ -0,0 +1,177 @@
+#ifndef __NULLTERM
+#define __NULLTERM
+#define __SIZED
+#endif
+#include "testharness.h"
+
+extern int strcmp(const char*, const char*);
+
+/* run this with COMPATMODE=1 if compiling directly, since neither GCC nor
+ * MSVCC fully support the C standard */
+static char *usageplocal = "Usage";
+static char usageescape = 'C';
+
+char *usagep = "Usage non-local";
+char *usagep1 = { "Usage in a brace" };
+int g = { 6 } ;
+
+char usages[] = "Usage string";
+char strange[] = { "several" };
+
+char *null = (void*)0;
+
+
+typedef struct s {
+ char *name;
+ int data;
+} STR;
+
+extern int afunc(int x);
+int (*fptr)(int) = afunc;
+
+STR a[] = {
+ {"first", 0},
+ {"second", 1},
+ {& usages[2], 2},
+ { & usageescape, 3},
+ { usages, 4},
+};
+
+
+typedef struct {
+ struct {
+ char * a1[10];
+ char * a2;
+ char strbuff[20] __NULLTERM;
+ } f1;
+ struct {
+ int * i1;
+ } f2[5] __SIZED;
+} NESTED;
+
+NESTED glob1;
+
+int glob3;
+int * glob2 = & glob3;
+
+int afunc(int a) {
+ NESTED loc1;
+ char locbuff[30] __NULLTERM;
+ char indexbuff[10] __SIZED;
+
+ loc1.f1.a2 = glob1.f1.a2;
+
+ return * loc1.f2[3].i1 + (locbuff[0] - indexbuff[0]);
+}
+
+
+
+// now initialization for union
+union {
+ struct {
+ int a;
+ int *b;
+ } u1;
+ int c;
+} uarray[] = { 1, 0, 2, 0, 3, 0 };
+
+
+// now some examples from the standard
+int z[4][3] =
+{ { 1 }, { 2 }, { 3 }, { 4 } };
+
+struct str1 { int a[3]; int b;};
+
+struct str1 w[] =
+{ { 1 }, { 2 } };
+
+
+short q[4][3][2] = {
+ { 1 } ,
+ { 2, 3 },
+ { 4, 5, 6}
+};
+
+short q1[4][3][2] = {
+ 1, 0, 0, 0, 0, 0,
+ 2, 3, 0, 0, 0, 0,
+ 4, 5, 6, 0, 0, 0,
+};
+
+
+
+#ifdef _GNUCC
+int a1[10] = {
+ 1, 3, 5, 7, 9, [6] = 8, 6, 4, 2};
+
+
+enum { member_one, member_two, member_three };
+char *nm[] = {
+ [member_two] = "member_two",
+ [member_three] = "member_three",
+};
+
+
+#endif
+
+
+
+#define ERROR(n) { printf("Incorrect init: %d\n", n); exit(1); }
+// Test the initialization
+int main() {
+ int i;
+
+ struct str1 astr = w[0];
+
+ if(strcmp(a[0].name, "first")) {
+ ERROR(0);
+ }
+ if(sizeof(uarray) / sizeof(uarray[0]) != 3) {
+ ERROR(1);
+ }
+ if(uarray[2].u1.a != 3) {
+ ERROR(2);
+ }
+
+ if(z[2][0] != 3 ||
+ z[2][1] != 0) {
+ ERROR(4);
+ }
+
+ if(sizeof(w) / sizeof(w[0]) != 2 ||
+ w[1].a[0] != 2) {
+ ERROR(5);
+ }
+ {
+ short * ps = (short*)q, * ps1 = (short*)q1;
+ for(i=0;i<sizeof(q) / sizeof(short); i++, ps ++, ps1 ++) {
+ if(*ps != *ps1) {
+ ERROR(6);
+ }
+ }
+ }
+
+#ifdef _GNUCC
+ if(a1[1] != 3 ||
+ a1[5] != 0 ||
+ a1[6] != 8 ||
+ a1[7] != 6) {
+ ERROR(7);
+ }
+
+
+ if(strcmp(nm[1], "member_two") ||
+ strcmp(nm[2], "member_three") ||
+ sizeof(nm) != 3 * sizeof(nm[0])) {
+ ERROR(8);
+ }
+
+#endif
+
+
+ printf("Initialization test succeeded\n");
+ return 0;
+}
+
+
+
diff --git a/cil/test/small1/init1.c b/cil/test/small1/init1.c
new file mode 100644
index 0000000..e6334df
--- /dev/null
+++ b/cil/test/small1/init1.c
@@ -0,0 +1,17 @@
+extern void exit(int);
+
+struct {
+ struct {
+ int *f1;
+ int *f2;
+ } s1;
+ struct {
+ int *f3;
+ } s2;
+} memory[10] = { 1 };
+
+int main() {
+ if(memory[0].s1.f1 != (int*)1)
+ exit(1);
+ exit(0);
+}
diff --git a/cil/test/small1/testharness.h b/cil/test/small1/testharness.h
new file mode 100644
index 0000000..a1057e3
--- /dev/null
+++ b/cil/test/small1/testharness.h
@@ -0,0 +1,17 @@
+#ifndef printf
+ /* sm: this works with gcc-2.95 */
+ extern int printf(const char * format, ...);
+# ifdef CCURED
+ #pragma ccuredvararg("printf", printf(1))
+# endif
+#else
+ /* but in gcc-3 headers it's a macro.. */
+ #include <stdio.h> /* printf */
+#endif
+
+extern void exit(int);
+
+/* Always call E with a non-zero number */
+#define E(n) { printf("Error %d\n", n); exit(n); }
+#define SUCCESS { printf("Success\n"); exit(0); }
+
diff --git a/cil/test/small1/vararg1.c b/cil/test/small1/vararg1.c
new file mode 100644
index 0000000..cc710a7
--- /dev/null
+++ b/cil/test/small1/vararg1.c
@@ -0,0 +1,47 @@
+
+/* VA.C: The program below illustrates passing a variable
+ * number of arguments using the following macros:
+ * va_start va_arg va_end
+ * va_list va_dcl (UNIX only)
+ */
+
+#include <stdio.h>
+#include <stdarg.h>
+int average( int first, ... );
+union vararg_average {
+ int ints; /* We only pass ints to this one */
+};
+
+#include "testharness.h"
+
+int main( void )
+{
+ /* Call with 3 integers (-1 is used as terminator). */
+ if(average( 2, 3, 4, -1 ) != 3) E(1);
+ if(average( 5, 7, 9, 11, 13, -1 ) != 9) E(2);
+ if(average( -1 ) != 0) E(3);
+
+ SUCCESS;
+}
+
+
+
+/* Returns the average of a variable list of integers. */
+int average( int first, ... )
+{
+ int count = 0, sum = 0, i = first;
+ va_list marker;
+
+ va_start( marker, first ); /* Initialize variable arguments. */
+ while( i != -1 )
+ {
+ sum += i;
+ count++;
+ i = va_arg( marker, int);
+ }
+ va_end( marker ); /* Reset variable arguments. */
+ return( sum ? (sum / count) : 0 );
+}
+
+// Put this intentionally at the end
+#pragma ccuredvararg("average", sizeof(union vararg_average))
diff --git a/cil/test/small1/wchar1.c b/cil/test/small1/wchar1.c
new file mode 100644
index 0000000..3306e57
--- /dev/null
+++ b/cil/test/small1/wchar1.c
@@ -0,0 +1,24 @@
+#include "testharness.h"
+#include <stddef.h>
+
+int main() {
+ wchar_t *wbase = L"Hello" L", world";
+ char * w = (char *)wbase;
+ char * s = "Hello" ", world";
+ int i;
+
+ // See if this is little or big endian
+ short foo = 0x0011;
+ char little_endian = (int) * (char*)&foo;
+
+ for (i=0; i < 10; i++) {
+ if (w[i * sizeof(wchar_t)] != (little_endian ? s[i] : 0)) {
+ E(1);
+ }
+ if (w[i * sizeof(wchar_t) + (sizeof(wchar_t)-1)]
+ != (little_endian ? 0 : s[i])) {
+ E(2);
+ }
+ }
+ SUCCESS;
+}
diff --git a/configure b/configure
index 0d71d27..fc255b2 100755
--- a/configure
+++ b/configure
@@ -12,20 +12,28 @@
# #
#######################################################################
-cildistrib=cil-1.3.5.tar.gz
prefix=/usr/local
bindir='$(PREFIX)/bin'
libdir='$(PREFIX)/lib/compcert'
target=''
-usage='Usage: ./configure [options] <target>
+prompt() {
+ echo "$1 [$x] ? " | tr -d '\n'
+ read y
+ case "$y" in
+ "") ;;
+ none) x="";;
+ *) x="$y";;
+ esac
+}
+
+usage='Usage: ./configure [options] target
Supported targets:
- macosx (PowerPC, MacOS X)
+ ppc-macosx (PowerPC, MacOS X)
ppc-linux (PowerPC, Linux)
- ppc-linux-cross (PowerPC, Linux, cross-compilation)
arm-linux (ARM, Linux)
- arm-linux-cross (ARM, Linux, cross-compilation)
+ manual (edit configuration file by hand)
Options:
-prefix <dir> Install in <dir>/bin and <dir>/lib/compcert
@@ -51,14 +59,13 @@ while : ; do
shift
done
-if test -z "$target"; then echo "$usage" 1>&2; exit 2; fi
-
# Per-target configuration
case "$target" in
- macosx)
+ ppc-macosx)
arch="powerpc"
variant="macosx"
+ system="macosx"
cc="gcc -arch ppc"
cprepro="gcc -arch ppc -U__GNUC__ -E"
casm="gcc -arch ppc -c"
@@ -67,37 +74,29 @@ case "$target" in
ppc-linux)
arch="powerpc"
variant="eabi"
+ system="linux"
cc="gcc"
cprepro="gcc -U__GNUC__ -E"
casm="gcc -c"
clinker="gcc"
libmath="-lm";;
- ppc-linux-cross)
- arch="powerpc"
- variant="eabi"
- cc="ppc-linux-gcc"
- cprepro="ppc-linux-gcc -U__GNUC__ -E"
- casm="ppc-linux-gcc -c"
- clinker="ppc-linux-gcc"
- libmath="-lm";;
arm-linux)
arch="arm"
variant="linux"
+ system="linux"
cc="gcc"
cprepro="gcc -U__GNUC__ -E"
casm="gcc -c"
clinker="gcc"
libmath="-lm";;
- arm-linux-cross)
- arch="arm"
- variant="linux"
- cc="arm-linux-gcc"
- cprepro="arm-linux-gcc -U__GNUC__ -E"
- casm="arm-linux-gcc -c"
- clinker="arm-linux-gcc"
- libmath="-lm";;
+ manual)
+ ;;
+ "")
+ echo "No target specified." 1>&2
+ echo "$usage" 1>&2
+ exit 2;;
*)
- echo "Unsupported configuration '$target'" 1>&2
+ echo "Unknown target '$target'." 1>&2
echo "$usage" 1>&2
exit 2;;
esac
@@ -109,20 +108,58 @@ cat > Makefile.config <<EOF
PREFIX=$prefix
BINDIR=$bindir
LIBDIR=$libdir
+EOF
+
+if test "$target" != "manual"; then
+cat >> Makefile.config <<EOF
ARCH=$arch
VARIANT=$variant
+SYSTEM=$system
CC=$cc
CPREPRO=$cprepro
CASM=$casm
CLINKER=$clinker
LIBMATH=$libmath
EOF
+else
+cat >> Makefile.config <<'EOF'
+
+# Target architecture
+# ARCH=powerpc
+# ARCH=arm
+ARCH=
+
+# Target ABI
+# VARIANT=macosx # for PowerPC / MacOS X
+# VARIANT=eabi # for PowerPC / Linux and other SVR4 or EABI platforms
+# VARIANT=linux # for ARM
+VARIANT=
+
+# Target operating system and development environment
+# See $(ARCH)/PrintAsm.ml for possible choices
+SYSTEM=
+
+# C compiler for compiling library files
+CC=gcc
+
+# Preprocessor for .c files
+CPREPRO=gcc -U__GNUC__ -E
+
+# Assembler for assembling .s files
+CASM=gcc -c
+
+# Linker
+CLINKER=gcc
+
+# Math library
+LIBMATH=-lm
+
+# CIL configuration target -- do not change
+EOF
+fi
# Extract and configure Cil
-set -e
-tar xzf $cildistrib
-for i in cil.patch/*; do patch -p1 < $i; done
(cd cil && ./configure)
# Extract 'ARCHOS' info from Cil configuration
@@ -131,14 +168,31 @@ grep '^ARCHOS=' cil/config.log >> Makefile.config
# Summarize configuration
+if test "$target" = "manual"; then
+cat <<EOF
+
+Please finish the configuration by editing file ./Makefile.config
+
+EOF
+
+else
+
+bindirexp=`echo "$bindir" | sed -e "s|\\\$(PREFIX)|$prefix|"`
+libdirexp=`echo "$libdir" | sed -e "s|\\\$(PREFIX)|$prefix|"`
+
cat <<EOF
CompCert configuration:
Target architecture........... $arch ($variant)
+ OS and development env........ $system
C compiler.................... $cc
C preprocessor................ $cprepro
Assembler..................... $casm
Linker........................ $clinker
Math library.................. $libmath
+ Binaries installed in......... $bindirexp
+ Library files installed in.... $libdirexp
+
+EOF
-EOF \ No newline at end of file
+fi