From c00df6f653957b91823de377a32812715615fb20 Mon Sep 17 00:00:00 2001 From: "R. Steve McKown" Date: Thu, 10 Dec 2009 13:53:38 -0700 Subject: [PATCH 1/1] Import pristine deputy-tinyos v1.1 --- .cvsignore | 4 + .distexclude | 29 + LICENSE | 35 + Makefile.in | 451 + bin/.cvsignore | 2 + bin/deputy | 60 + cil/.cvsignore | 38 + cil/Bootstrap | 3 + cil/INSTALL | 41 + cil/LICENSE | 36 + cil/Makefile.gcc | 75 + cil/Makefile.in | 663 ++ cil/Makefile.msvc | 42 + cil/NOTES | 86 + cil/README | 2 + cil/_tags | 3 + cil/aclocal.m4 | 69 + cil/bin/.cvsignore | 5 + cil/bin/CilConfig.pm.in | 6 + cil/bin/cabsxform | 16 + cil/bin/cilly | 152 + cil/bin/cilly.bat.in | 1 + cil/bin/patcher | 630 ++ cil/bin/patcher.bat.in | 1 + cil/bin/teetwo | 36 + cil/bin/test-bad | 202 + cil/cil.itarget | 2 + cil/cil.spec.in | 90 + cil/config.guess | 1497 +++ cil/config.h.in | 27 + cil/config.mk.in | 6 + cil/config.sub | 1469 +++ cil/configure | 7005 +++++++++++++ cil/configure.in | 561 ++ cil/debian/.cvsignore | 5 + cil/debian/changelog | 29 + cil/debian/cil-dev.install | 2 + cil/debian/cil.install | 2 + cil/debian/compat | 1 + cil/debian/control | 29 + cil/debian/copyright | 46 + cil/debian/rules | 90 + cil/debian/watch | 6 + cil/doc/.cvsignore | 24 + cil/doc/cil.itarget | 1 + cil/doc/cil.odocl | 11 + cil/doc/cil.tex | 3834 ++++++++ cil/doc/cilcode.pl | 102 + cil/doc/comment.sty | 278 + cil/doc/cvssetup.tex | 216 + cil/doc/fullpage.sty | 29 + cil/doc/header.html.in | 18 + cil/doc/hevea.sty | 66 + cil/doc/html/.cvsignore | 1 + cil/doc/index.html.in | 26 + cil/doc/main.html | 42 + cil/doc/makefiles.txt | 138 + cil/doc/ocamldoc.html | 88 + cil/doc/ocamldoc.patch | 141 + cil/doc/program.sty | 265 + cil/doc/proof.sty | 296 + cil/doc/sendmail.txt | 142 + cil/doc/setup.tex | 172 + cil/doc/tips-and-tricks.txt | 229 + cil/install-sh | 251 + cil/lib/.cvsignore | 5 + cil/lib/.gdbinit | 6 + cil/lib/Cilly.pm | 2237 +++++ cil/lib/KeptFile.pm | 88 + cil/lib/Makefile | 31 + cil/lib/OutputFile.pm | 213 + cil/lib/TempFile.pm | 90 + cil/myocamlbuild.ml | 42 + cil/obj/.depend/.cvsignore | 2 + cil/ocamlutil/.cvsignore | 3 + cil/ocamlutil/Makefile.ocaml | 467 + cil/ocamlutil/Makefile.ocaml.build | 56 + cil/ocamlutil/RegTest.pm | 1335 +++ cil/ocamlutil/_tags | 2 + cil/ocamlutil/alpha.ml | 174 + cil/ocamlutil/alpha.mli | 50 + cil/ocamlutil/bitmap.ml | 227 + cil/ocamlutil/bitmap.mli | 56 + cil/ocamlutil/bitvector.ml | 197 + cil/ocamlutil/bitvector.mli | 76 + cil/ocamlutil/bitvector.out | 18 + cil/ocamlutil/bitvectori.c | 395 + cil/ocamlutil/clist.ml | 183 + cil/ocamlutil/clist.mli | 97 + cil/ocamlutil/errormsg.ml | 337 + cil/ocamlutil/errormsg.mli | 164 + cil/ocamlutil/growArray.ml | 193 + cil/ocamlutil/growArray.mli | 131 + cil/ocamlutil/inthash.ml | 192 + cil/ocamlutil/inthash.mli | 28 + cil/ocamlutil/intmap.ml | 171 + cil/ocamlutil/intmap.mli | 87 + cil/ocamlutil/longarray.ml | 102 + cil/ocamlutil/longarray.mli | 20 + cil/ocamlutil/options.ml | 105 + cil/ocamlutil/options.mli | 48 + cil/ocamlutil/pa_prtype.ml | 479 + cil/ocamlutil/perfcount.c.in | 255 + cil/ocamlutil/pretty.ml | 860 ++ cil/ocamlutil/pretty.mli | 318 + cil/ocamlutil/profile.c.in | 797 ++ cil/ocamlutil/runall.pl | 431 + cil/ocamlutil/stats.ml | 207 + cil/ocamlutil/stats.mli | 90 + cil/ocamlutil/symbolrange.pl | 183 + cil/ocamlutil/trace.ml | 169 + cil/ocamlutil/trace.mli | 106 + cil/ocamlutil/util.ml | 815 ++ cil/ocamlutil/util.mli | 311 + cil/src/.cvsignore | 3 + cil/src/_tags | 8 + cil/src/check.ml | 1034 ++ cil/src/check.mli | 47 + cil/src/cil.itarget | 4 + cil/src/cil.ml | 6810 +++++++++++++ cil/src/cil.mli | 2604 +++++ cil/src/cil.mllib | 67 + cil/src/cillower.ml | 57 + cil/src/cillower.mli | 42 + cil/src/ciloptions.ml | 338 + cil/src/ciloptions.mli | 48 + cil/src/cilutil.ml | 74 + cil/src/cilversion.ml.in | 6 + cil/src/escape.ml | 93 + cil/src/escape.mli | 48 + cil/src/ext/_tags | 2 + cil/src/ext/arithabs.ml | 1103 +++ cil/src/ext/astslicer.ml | 442 + cil/src/ext/availexps.ml | 390 + cil/src/ext/availexpslv.ml | 433 + cil/src/ext/blockinggraph.ml | 769 ++ cil/src/ext/blockinggraph.mli | 40 + cil/src/ext/callgraph.ml | 250 + cil/src/ext/callgraph.mli | 123 + cil/src/ext/canonicalize.ml | 292 + cil/src/ext/canonicalize.mli | 48 + cil/src/ext/ccl.ml | 1943 ++++ cil/src/ext/ccl.mli | 40 + cil/src/ext/cfg.ml | 319 + cil/src/ext/cfg.mli | 36 + cil/src/ext/ciltools.ml | 228 + cil/src/ext/cqualann.ml | 518 + cil/src/ext/dataflow.ml | 509 + cil/src/ext/dataflow.mli | 166 + cil/src/ext/dataslicing.ml | 454 + cil/src/ext/dataslicing.mli | 41 + cil/src/ext/deadcodeelim.ml | 409 + cil/src/ext/dominators.ml | 360 + cil/src/ext/dominators.mli | 43 + cil/src/ext/epicenter.ml | 114 + cil/src/ext/expcompare.ml | 299 + cil/src/ext/heap.ml | 112 + cil/src/ext/heapify.ml | 250 + cil/src/ext/inliner.ml | 446 + cil/src/ext/liveness.ml | 337 + cil/src/ext/logcalls.ml | 268 + cil/src/ext/logcalls.mli | 41 + cil/src/ext/logwrites.ml | 139 + cil/src/ext/oneret.ml | 174 + cil/src/ext/oneret.mli | 44 + cil/src/ext/optutil.ml | 189 + cil/src/ext/optutil.mli | 83 + cil/src/ext/partial.ml | 1180 +++ cil/src/ext/predabst.ml | 917 ++ cil/src/ext/pta/golf.ml | 1657 ++++ cil/src/ext/pta/golf.mli | 83 + cil/src/ext/pta/olf.ml | 1108 +++ cil/src/ext/pta/olf.mli | 80 + cil/src/ext/pta/ptranal.ml | 595 ++ cil/src/ext/pta/ptranal.mli | 160 + cil/src/ext/pta/setp.ml | 342 + cil/src/ext/pta/setp.mli | 180 + cil/src/ext/pta/steensgaard.ml | 1417 +++ cil/src/ext/pta/steensgaard.mli | 71 + cil/src/ext/pta/uref.ml | 94 + cil/src/ext/pta/uref.mli | 65 + cil/src/ext/rand.ml | 354 + cil/src/ext/reachingdefs.ml | 568 ++ cil/src/ext/rmciltmps.ml | 1102 +++ cil/src/ext/sfi.ml | 337 + cil/src/ext/simplemem.ml | 132 + cil/src/ext/simplify.ml | 721 ++ cil/src/ext/ssa.ml | 696 ++ cil/src/ext/ssa.mli | 45 + cil/src/ext/stackoverflow.ml | 246 + cil/src/ext/stackoverflow.mli | 43 + cil/src/ext/ufsarithabs.ml | 1182 +++ cil/src/ext/usedef.ml | 245 + cil/src/formatcil.ml | 215 + cil/src/formatcil.mli | 103 + cil/src/formatlex.mll | 308 + cil/src/formatparse.mly | 1449 +++ cil/src/frontc/.cvsignore | 1 + cil/src/frontc/cabs.ml | 306 + cil/src/frontc/cabs2cil.ml | 6380 ++++++++++++ cil/src/frontc/cabs2cil.mli | 86 + cil/src/frontc/cabshelper.ml | 109 + cil/src/frontc/cabsvisit.ml | 582 ++ cil/src/frontc/cabsvisit.mli | 115 + cil/src/frontc/clexer.mli | 62 + cil/src/frontc/clexer.mll | 690 ++ cil/src/frontc/cparser.mly | 1555 +++ cil/src/frontc/cprint.ml | 918 ++ cil/src/frontc/frontc.ml | 266 + cil/src/frontc/frontc.mli | 56 + cil/src/frontc/lexerhack.ml | 22 + cil/src/frontc/patch.ml | 838 ++ cil/src/frontc/patch.mli | 42 + cil/src/frontc/whitetrack.ml | 139 + cil/src/frontc/whitetrack.mli | 22 + cil/src/libmaincil.ml | 108 + cil/src/machdep-ml.c | 239 + cil/src/machdepenv.ml | 109 + cil/src/main.ml | 295 + cil/src/mergecil.ml | 1761 ++++ cil/src/mergecil.mli | 42 + cil/src/prettytest.ml | 127 + cil/src/rmtmps.ml | 779 ++ cil/src/rmtmps.mli | 82 + cil/src/testcil.ml | 440 + cil/src/zrapp.ml | 646 ++ cil/src/zrapp.mli | 13 + cil/test/.cvsignore | 34 + cil/test/Makefile | 426 + cil/test/small1/.cvsignore | 48 + cil/test/small1/.gdbinit | 5 + cil/test/small1/GRT.c | 11 + cil/test/small1/Makefile | 6 + cil/test/small1/addr-array.c | 23 + cil/test/small1/addrof3.c | 21 + cil/test/small1/align1.c | 25 + cil/test/small1/align2.c | 335 + cil/test/small1/align3.c | 84 + cil/test/small1/apachebits.c | 106 + cil/test/small1/apachebuf.c | 33 + cil/test/small1/apachefptr.c | 22 + cil/test/small1/argcast.c | 16 + cil/test/small1/array-args.c | 8 + cil/test/small1/array-size-trick.c | 50 + cil/test/small1/array1.c | 34 + cil/test/small1/array2.c | 20 + cil/test/small1/array_formal.c | 44 + cil/test/small1/array_varsize.c | 31 + cil/test/small1/arrayinitsize.c | 34 + cil/test/small1/asm1.c | 34 + cil/test/small1/asm2.c | 8 + cil/test/small1/asm3.c | 4 + cil/test/small1/asm4.c | 53 + cil/test/small1/asm5.c | 7 + cil/test/small1/assign.c | 41 + cil/test/small1/attr.c | 39 + cil/test/small1/attr10.c | 26 + cil/test/small1/attr11.c | 14 + cil/test/small1/attr12.c | 7 + cil/test/small1/attr13.c | 7 + cil/test/small1/attr2.c | 43 + cil/test/small1/attr3.c | 32 + cil/test/small1/attr4.c | 37 + cil/test/small1/attr5.c | 12 + cil/test/small1/attr6.c | 14 + cil/test/small1/attr7.c | 8 + cil/test/small1/attr8.c | 10 + cil/test/small1/attr9.c | 49 + cil/test/small1/bf.c | 17 + cil/test/small1/bind-formatstring.c | 247 + cil/test/small1/bind-used-not-defined.c | 1696 ++++ cil/test/small1/bitfield.c | 47 + cil/test/small1/bitfield0.c | 17 + cil/test/small1/bitfield2.c | 17 + cil/test/small1/bitfield3.c | 87 + cil/test/small1/blockattr.c | 10 + cil/test/small1/builtin.c | 7 + cil/test/small1/builtin2.c | 9 + cil/test/small1/builtin3.c | 37 + cil/test/small1/builtin_choose_expr.c | 19 + cil/test/small1/call2.c | 18 + cil/test/small1/caserange.c | 19 + cil/test/small1/cast1.c | 14 + cil/test/small1/cast2.c | 6 + cil/test/small1/cast3.c | 24 + cil/test/small1/cast4.c | 33 + cil/test/small1/cast8.c | 17 + cil/test/small1/castincr.c | 18 + cil/test/small1/combine10_1.c | 7 + cil/test/small1/combine10_2.c | 6 + cil/test/small1/combine10_3.c | 12 + cil/test/small1/combine11_1.c | 15 + cil/test/small1/combine11_2.c | 19 + cil/test/small1/combine12_1.c | 14 + cil/test/small1/combine12_2.c | 13 + cil/test/small1/combine13_1.c | 6 + cil/test/small1/combine13_2.c | 13 + cil/test/small1/combine14_1.c | 21 + cil/test/small1/combine14_2.c | 11 + cil/test/small1/combine15_1.c | 38 + cil/test/small1/combine15_2.c | 8 + cil/test/small1/combine16_1.c | 17 + cil/test/small1/combine16_2.c | 15 + cil/test/small1/combine17_1.c | 9 + cil/test/small1/combine17_2.c | 10 + cil/test/small1/combine18_1.c | 16 + cil/test/small1/combine18_2.c | 8 + cil/test/small1/combine1_1.c | 27 + cil/test/small1/combine1_2.c | 10 + cil/test/small1/combine1_3.c | 13 + cil/test/small1/combine20_1.c | 7 + cil/test/small1/combine20_2.c | 16 + cil/test/small1/combine21_1.c | 17 + cil/test/small1/combine21_2.c | 11 + cil/test/small1/combine22_1.c | 8 + cil/test/small1/combine22_2.c | 14 + cil/test/small1/combine2_1.c | 11 + cil/test/small1/combine2_2.c | 13 + cil/test/small1/combine2_3.c | 10 + cil/test/small1/combine3_1.c | 8 + cil/test/small1/combine3_2.c | 15 + cil/test/small1/combine3_3.c | 18 + cil/test/small1/combine4_1.c | 6 + cil/test/small1/combine4_2.c | 9 + cil/test/small1/combine5.h | 30 + cil/test/small1/combine5_1.c | 9 + cil/test/small1/combine5_2.c | 1 + cil/test/small1/combine5_3.c | 33 + cil/test/small1/combine6_1.c | 22 + cil/test/small1/combine6_2.c | 14 + cil/test/small1/combine6_3.c | 1 + cil/test/small1/combine7_1.c | 10 + cil/test/small1/combine7_2.c | 14 + cil/test/small1/combine7_3.c | 5 + cil/test/small1/combine8_1.c | 16 + cil/test/small1/combine8_2.c | 10 + cil/test/small1/combine9_1.c | 15 + cil/test/small1/combine9_2.c | 6 + cil/test/small1/combine_allocate_1.c | 1 + cil/test/small1/combine_allocate_2.c | 24 + cil/test/small1/combine_copyptrs_1.c | 6 + cil/test/small1/combine_copyptrs_2.c | 85 + cil/test/small1/combine_init_1.c | 21 + cil/test/small1/combine_init_2.c | 12 + cil/test/small1/combine_node_alloc_1.c | 9 + cil/test/small1/combine_node_alloc_2.c | 14 + cil/test/small1/combine_samefn_1.c | 45 + cil/test/small1/combine_samefn_2.c | 31 + cil/test/small1/combine_sbumpB_1.c | 5 + cil/test/small1/combine_sbumpB_2.c | 5 + cil/test/small1/combine_sbumpB_3.c | 54 + cil/test/small1/combine_sbump_1.c | 3 + cil/test/small1/combine_sbump_2.c | 23 + cil/test/small1/combine_syserr_1.c | 7 + cil/test/small1/combine_syserr_2.c | 28 + cil/test/small1/combine_theFunc_1.c | 3 + cil/test/small1/combine_theFunc_2.c | 4 + cil/test/small1/combine_theFunc_3.c | 34 + cil/test/small1/combinealias_1.c | 7 + cil/test/small1/combinealias_2.c | 6 + cil/test/small1/combineenum1_1.c | 10 + cil/test/small1/combineenum1_2.c | 13 + cil/test/small1/combineenum2_1.c | 10 + cil/test/small1/combineenum2_2.c | 8 + cil/test/small1/combineenum3_1.c | 9 + cil/test/small1/combineenum3_2.c | 4 + cil/test/small1/combineinline1_1.c | 14 + cil/test/small1/combineinline1_2.c | 8 + cil/test/small1/combineinline2_1.c | 13 + cil/test/small1/combineinline2_2.c | 5 + cil/test/small1/combineinline3_1.c | 14 + cil/test/small1/combineinline3_2.c | 9 + cil/test/small1/combineinline4_1.c | 18 + cil/test/small1/combineinline4_2.c | 11 + cil/test/small1/combineinline6_1.c | 20 + cil/test/small1/combineinline6_2.c | 1 + cil/test/small1/combinelibrik_1.c | 40 + cil/test/small1/combinelibrik_2.c | 23 + cil/test/small1/combinestruct1_1.c | 14 + cil/test/small1/combinestruct1_2.c | 20 + cil/test/small1/combinetaggedfn_1.c | 10 + cil/test/small1/combinetaggedfn_2.c | 22 + cil/test/small1/comma1.c | 12 + cil/test/small1/comparisons.c | 50 + cil/test/small1/cond1.c | 33 + cil/test/small1/cond2.c | 30 + cil/test/small1/const-array-init.c | 20 + cil/test/small1/const-compound-cast.c | 14 + cil/test/small1/const-struct-init.c | 15 + cil/test/small1/const1.c | 27 + cil/test/small1/const10.c | 7 + cil/test/small1/const11.c | 53 + cil/test/small1/const2.c | 14 + cil/test/small1/const3.c | 9 + cil/test/small1/const4.c | 26 + cil/test/small1/const5.c | 14 + cil/test/small1/const6.c | 15 + cil/test/small1/const7.c | 2 + cil/test/small1/const8.c | 15 + cil/test/small1/const9.c | 23 + cil/test/small1/constprop.c | 13 + cil/test/small1/cpp-2.c | 6 + cil/test/small1/cpp-3.c | 11 + cil/test/small1/decl1.c | 20 + cil/test/small1/decl2.c | 50 + cil/test/small1/decl_mix_stmt.c | 15 + cil/test/small1/deref.c | 105 + cil/test/small1/duplicate.c | 29 + cil/test/small1/empty.i | 5 + cil/test/small1/enum.c | 14 + cil/test/small1/enum2.c | 33 + cil/test/small1/escapes.c | 36 + cil/test/small1/extern1.c | 6 + cil/test/small1/extern_init.c | 38 + cil/test/small1/float.c | 12 + cil/test/small1/float2.c | 8 + cil/test/small1/for1.c | 11 + cil/test/small1/formalscope.c | 23 + cil/test/small1/func.c | 24 + cil/test/small1/func10.c | 24 + cil/test/small1/func2.c | 30 + cil/test/small1/func3.c | 19 + cil/test/small1/func4.c | 24 + cil/test/small1/funcarg.c | 14 + cil/test/small1/funptr1.c | 23 + cil/test/small1/globals.c | 11 + cil/test/small1/globals2.c | 8 + cil/test/small1/hello.c | 8 + cil/test/small1/huff1.c | 14 + cil/test/small1/init.c | 179 + cil/test/small1/init1.c | 17 + cil/test/small1/init10.c | 18 + cil/test/small1/init11.c | 29 + cil/test/small1/init12.c | 22 + cil/test/small1/init13.c | 39 + cil/test/small1/init14.c | 12 + cil/test/small1/init15.c | 26 + cil/test/small1/init16.c | 12 + cil/test/small1/init17.c | 22 + cil/test/small1/init18.c | 24 + cil/test/small1/init19.c | 20 + cil/test/small1/init2.c | 13 + cil/test/small1/init20.c | 49 + cil/test/small1/init21.c | 227 + cil/test/small1/init22.c | 28 + cil/test/small1/init3.c | 51 + cil/test/small1/init4.c | 37 + cil/test/small1/init5.c | 33 + cil/test/small1/init6.c | 87 + cil/test/small1/init7.c | 34 + cil/test/small1/init8.c | 9 + cil/test/small1/init9.c | 34 + cil/test/small1/initial.c | 37 + cil/test/small1/inline1.c | 43 + cil/test/small1/inline2.c | 11 + cil/test/small1/inline3.c | 12 + cil/test/small1/jmp_buf.c | 41 + cil/test/small1/knr1.c | 36 + cil/test/small1/label1.c | 30 + cil/test/small1/label2.c | 29 + cil/test/small1/label3.c | 13 + cil/test/small1/label4.c | 41 + cil/test/small1/label5.c | 9 + cil/test/small1/li.c | 13 + cil/test/small1/lineno.i | 6 + cil/test/small1/linux_atomic.c | 12 + cil/test/small1/linux_signal.c | 28 + cil/test/small1/linuxcombine1_1.c | 3513 +++++++ cil/test/small1/list.c | 101 + cil/test/small1/local.c | 20 + cil/test/small1/local.h | 319 + cil/test/small1/localinit.c | 10 + cil/test/small1/logical.c | 14 + cil/test/small1/longBlock.ml | 17 + cil/test/small1/lstring.c | 28 + cil/test/small1/lval1.c | 54 + cil/test/small1/math1.c | 14 + cil/test/small1/matrix.c | 25 + cil/test/small1/memcpy1.c | 64 + cil/test/small1/min.c | 17 + cil/test/small1/msvc1.c | 17 + cil/test/small1/msvc2.c | 15 + cil/test/small1/msvc3.c | 35 + cil/test/small1/msvc4.c | 51 + cil/test/small1/msvc5.c | 128 + cil/test/small1/msvc6.c | 8 + cil/test/small1/msvc7.c | 24 + cil/test/small1/msvc8.c | 13 + cil/test/small1/msvc9.c | 39 + cil/test/small1/noproto.c | 15 + cil/test/small1/noproto1.c | 14 + cil/test/small1/noproto2.c | 14 + cil/test/small1/noreturn.c | 18 + cil/test/small1/offsetof.c | 21 + cil/test/small1/offsetof1.c | 18 + cil/test/small1/offsetof2.c | 29 + cil/test/small1/offsetof3.c | 34 + cil/test/small1/oom.c | 36 + cil/test/small1/order.c | 25 + cil/test/small1/outofmem.c | 18 + cil/test/small1/p04.c | 19 + cil/test/small1/packed.c | 42 + cil/test/small1/packed2.c | 77 + cil/test/small1/paper1.c | 18 + cil/test/small1/paper2.c | 14 + cil/test/small1/percent400.c | 7 + cil/test/small1/percentm.c | 7 + cil/test/small1/perror.c | 18 + cil/test/small1/perror1.c | 26 + cil/test/small1/pointers2.c | 16 + cil/test/small1/post-assign.c | 33 + cil/test/small1/power1.c | 95 + cil/test/small1/printf.c | 24 + cil/test/small1/printf2.c | 17 + cil/test/small1/printf_const.c | 20 + cil/test/small1/proto1.c | 14 + cil/test/small1/proto2.c | 13 + cil/test/small1/pure.c | 8 + cil/test/small1/question.c | 8 + cil/test/small1/question2.c | 50 + cil/test/small1/restrict.c | 14 + cil/test/small1/restrict1.c | 6 + cil/test/small1/return1.c | 9 + cil/test/small1/returnvoid.c | 16 + cil/test/small1/returnvoid1.c | 36 + cil/test/small1/retval.c | 9 + cil/test/small1/rmtmps-attr.c | 14 + cil/test/small1/rmtmps1.c | 17 + cil/test/small1/rmtmps2.c | 48 + cil/test/small1/scope1.c | 44 + cil/test/small1/scope10.c | 14 + cil/test/small1/scope11.c | 13 + cil/test/small1/scope2.c | 35 + cil/test/small1/scope3.c | 19 + cil/test/small1/scope4.c | 22 + cil/test/small1/scope5.c | 29 + cil/test/small1/scope6.c | 22 + cil/test/small1/scope7.c | 18 + cil/test/small1/scope8.c | 24 + cil/test/small1/scope9.c | 18 + cil/test/small1/semicolon.c | 11 + cil/test/small1/signs.c | 92 + cil/test/small1/simon6.c | 27 + cil/test/small1/simplify_structs1.c | 41 + cil/test/small1/simplify_structs2.c | 52 + cil/test/small1/sizeof1.c | 20 + cil/test/small1/sizeof2.c | 9 + cil/test/small1/ssa-test.c | 36 + cil/test/small1/ssa-test2.c | 15 + cil/test/small1/ssa2.c | 24 + cil/test/small1/ssa3.c | 13 + cil/test/small1/ssa4.c | 16 + cil/test/small1/ssa5.c | 15 + cil/test/small1/stack.c | 43 + cil/test/small1/static.c | 40 + cil/test/small1/static1.c | 11 + cil/test/small1/static2.c | 35 + cil/test/small1/strcpy.c | 23 + cil/test/small1/string1.c | 29 + cil/test/small1/string2.c | 14 + cil/test/small1/stringsize.c | 31 + cil/test/small1/strloop.c | 30 + cil/test/small1/strloop3.c | 51 + cil/test/small1/struct1.c | 20 + cil/test/small1/struct2.c | 335 + cil/test/small1/struct_init.c | 30 + cil/test/small1/structassign.c | 17 + cil/test/small1/tags.c | 37 + cil/test/small1/task.c | 33 + cil/test/small1/tempname.c | 9 + cil/test/small1/testharness.h | 17 + cil/test/small1/typeof1.c | 86 + cil/test/small1/typespec1.c | 55 + cil/test/small1/unimplemented.c | 30 + cil/test/small1/union1.c | 16 + cil/test/small1/union2.c | 40 + cil/test/small1/union3.c | 59 + cil/test/small1/union5.c | 37 + cil/test/small1/unsafe1.c | 31 + cil/test/small1/va-arg-1.c | 29 + cil/test/small1/va-arg-2.c | 313 + cil/test/small1/va-arg-7.c | 53 + cil/test/small1/var.c | 15 + cil/test/small1/vararg1.c | 47 + cil/test/small1/vararg10.c | 50 + cil/test/small1/vararg11.c | 31 + cil/test/small1/vararg2.c | 49 + cil/test/small1/vararg3.c | 162 + cil/test/small1/vararg4.c | 61 + cil/test/small1/vararg5.c | 48 + cil/test/small1/vararg5.h | 0 cil/test/small1/vararg6.c | 49 + cil/test/small1/vararg7.c | 68 + cil/test/small1/varargauto1.c | 63 + cil/test/small1/varied.c | 78 + cil/test/small1/version.c | 24 + cil/test/small1/void.c | 27 + cil/test/small1/voidarg.c | 12 + cil/test/small1/voidstar.c | 30 + cil/test/small1/voidtypedef.c | 14 + cil/test/small1/vsp.c | 38 + cil/test/small1/warnings-cast.c | 13 + cil/test/small1/warnings-noreturn.c | 22 + cil/test/small1/warnings-unused-label.c | 27 + cil/test/small1/wchar-bad.c | 40 + cil/test/small1/wchar1.c | 24 + cil/test/small1/wchar1_freebsd.c | 250 + cil/test/small1/wchar2.c | 11 + cil/test/small1/wchar3.c | 31 + cil/test/small1/wchar4.c | 69 + cil/test/small1/wchar5.c | 22 + cil/test/small1/wchar6.c | 35 + cil/test/small1/wchar7.c | 20 + cil/test/small1/wrongnumargs.c | 13 + cil/test/small1/zerotags.c | 25 + cil/test/small2/.cvsignore | 182 + cil/test/small2/Makefile | 24 + cil/test/small2/align.c | 14 + cil/test/small2/alpha.c | 28 + cil/test/small2/arrayinit.c | 17 + cil/test/small2/arrsize.c | 38 + cil/test/small2/asmfndecl.c | 13 + cil/test/small2/attrib.c | 8 + cil/test/small2/badasm.c | 15 + cil/test/small2/baddef1.c | 8 + cil/test/small2/baddef2.c | 30 + cil/test/small2/bisonerror.c | 16 + cil/test/small2/bogus_redef.c | 21 + cil/test/small2/brlock.c | 20 + cil/test/small2/bzero.c | 12 + cil/test/small2/checkinit.c | 70 + cil/test/small2/checkret.c | 61 + cil/test/small2/checkstore.c | 155 + cil/test/small2/checkstore2.c | 17 + cil/test/small2/checkstore3.c | 24 + cil/test/small2/checksymbol.c | 102 + cil/test/small2/cilreturn.c | 40 + cil/test/small2/cmpzero.c | 29 + cil/test/small2/cof.c | 8681 +++++++++++++++++ cil/test/small2/comb1.c | 23 + cil/test/small2/comb2.c | 26 + cil/test/small2/comb3.c | 11 + cil/test/small2/comb4.c | 11 + cil/test/small2/conset.c | 65 + cil/test/small2/constdecl.c | 23 + cil/test/small2/constfold.c | 22 + cil/test/small2/constfold2.c | 23 + cil/test/small2/ctype.c | 22 + cil/test/small2/debug_table.c | 24 + cil/test/small2/ehstack.c | 43 + cil/test/small2/enumattr.c | 13 + cil/test/small2/enumerator_sizeof.c | 31 + cil/test/small2/enuminit.c | 27 + cil/test/small2/enuminit2.c | 18 + cil/test/small2/errorinfn.c | 5 + cil/test/small2/extinline.c | 36 + cil/test/small2/fig1.c | 40 + cil/test/small2/fmtstr.c | 11 + cil/test/small2/fseq1fail.c | 59 + cil/test/small2/funcname.c | 18 + cil/test/small2/funcptr.c | 66 + cil/test/small2/funcptr2.c | 67 + cil/test/small2/funptr1.c | 18 + cil/test/small2/gimpdouble.c | 19 + cil/test/small2/globalprob.c | 12 + cil/test/small2/globinit.c | 97 + cil/test/small2/globtable.c | 14 + cil/test/small2/handler1.handlers | 7 + cil/test/small2/hashtest.c | 74 + cil/test/small2/hola.c | 76 + cil/test/small2/hufftable.c | 116 + cil/test/small2/hufftest.c | 136 + cil/test/small2/index1.c | 56 + cil/test/small2/initedextern.c | 11 + cil/test/small2/invalredef.c | 12 + cil/test/small2/invalredef2.c | 16 + cil/test/small2/jpeg_compress_struct.c | 37 + cil/test/small2/kernel1.c | 10 + cil/test/small2/kernel2.c | 16 + cil/test/small2/lexnum.c | 37 + cil/test/small2/litstruct.c | 24 + cil/test/small2/main.c | 15 + cil/test/small2/malloc1.c | 38 + cil/test/small2/memberofptr.c | 33 + cil/test/small2/memset_sizeof.c | 16 + cil/test/small2/merge-ar.c | 26 + cil/test/small2/merge-twice-1.c | 6 + cil/test/small2/merge-twice-2.c | 6 + cil/test/small2/merge-twice-3.c | 6 + cil/test/small2/mergeinline1.c | 24 + cil/test/small2/mergeinline2.c | 20 + cil/test/small2/mergestruct1.c | 26 + cil/test/small2/mergestruct2.c | 26 + cil/test/small2/metabug3.c | 24 + cil/test/small2/mode_sizes.c | 43 + cil/test/small2/multiplestatics.c | 20 + cil/test/small2/neg64.c | 18 + cil/test/small2/nested.c | 30 + cil/test/small2/nonwilderror.c | 13 + cil/test/small2/oldstyle.c | 14 + cil/test/small2/open.c | 52 + cil/test/small2/override.c | 40 + cil/test/small2/partialbracket.c | 20 + cil/test/small2/pset.c | 8 + cil/test/small2/ptrinint.c | 22 + cil/test/small2/putc.c | 31 + cil/test/small2/rbtest.c | 126 + cil/test/small2/regbeforeassign.c | 17 + cil/test/small2/regparm0.c | 25 + cil/test/small2/regthenprintf.c | 32 + cil/test/small2/runall_misc.c | 9 + cil/test/small2/rusage.c | 13 + cil/test/small2/s59.c | 25 + cil/test/small2/scary.c | 96 + cil/test/small2/segfault.c | 30 + cil/test/small2/seq_align_malloc.c | 45 + cil/test/small2/seq_align_malloc2.c | 54 + cil/test/small2/seqalign.c | 54 + cil/test/small2/sizeof3.c | 22 + cil/test/small2/sizeofchar.c | 32 + cil/test/small2/sockaddr.c | 97 + cil/test/small2/stackptr.c | 25 + cil/test/small2/stackptrptr.c | 27 + cil/test/small2/struct_cs.c | 33 + cil/test/small2/structattr.c | 55 + cil/test/small2/structattr2.c | 62 + cil/test/small2/structattr3.c | 10 + cil/test/small2/switch.c | 64 + cil/test/small2/tagfile.txt | 11 + cil/test/small2/tagfile1.c | 21 + cil/test/small2/tagfile2.c | 29 + cil/test/small2/testbtree.c | 60 + cil/test/small2/thing.c | 15 + cil/test/small2/transpunion.c | 37 + cil/test/small2/trivial-tb.c | 25 + cil/test/small2/try1.c | 64 + cil/test/small2/twoprintfs.c | 15 + cil/test/small2/typeof.c | 21 + cil/test/small2/undef_func.c | 8 + cil/test/small2/uninit_tmp.c | 39 + cil/test/small2/union2.c | 98 + cil/test/small2/union4.c | 91 + cil/test/small2/union5.c | 35 + cil/test/small2/union6.c | 54 + cil/test/small2/union7.c | 133 + cil/test/small2/union8.c | 98 + cil/test/small2/unionassign.c | 88 + cil/test/small2/unionext.c | 21 + cil/test/small2/unscomp.c | 28 + cil/test/small2/visit_col.c | 131 + cil/test/small2/voidstarint.c | 121 + cil/test/small2/volatilestruct.c | 23 + cil/test/small2/wes-hashtest.c | 534 + cil/test/small2/wes-rbtest.c | 491 + cil/test/small2/writev.c | 113 + cil/test/small2/xcheckers.c | 28 + cil/test/testcil | 3 + cil/test/testcil.bat | 1 + cil/test/testcil.h | 84 + cil/test/testcil.pl | 819 ++ config.guess | 1500 +++ config.sub | 1608 +++ configure | 4134 ++++++++ configure.ac | 187 + debian/changelog | 6 + debian/compat | 1 + debian/control | 15 + debian/copyright | 47 + debian/dirs | 1 + debian/docs | 0 debian/files | 1 + debian/rules | 107 + debian/watch | 22 + doc/.cvsignore | 22 + doc/TODO | 14 + doc/comment.sty | 278 + doc/deputy.1 | 50 + doc/deputy.tex | 3877 ++++++++ doc/deputycode.pl | 127 + doc/fullpage.sty | 29 + doc/header.html.in | 16 + doc/hevea.sty | 86 + doc/html/.cvsignore | 1 + doc/index.html.in | 24 + doc/www/bnd-be-nt.png | Bin 0 -> 693 bytes doc/www/bnd-be.png | Bin 0 -> 604 bytes doc/www/count-5.png | Bin 0 -> 461 bytes doc/www/count-nm.png | Bin 0 -> 948 bytes doc/www/deputy.css | 55 + doc/www/index.html | 112 + doc/www/manual.html | 815 ++ doc/www/quickref.html | 322 + include/.cvsignore | 1 + include/ccuredport.h | 26 + include/deputy/annots.h | 73 + include/deputy/checks.h | 291 + include/deputy/itaint.patch.h | 10 + include/deputy/lwcalls.h | 81 + include/deputy/sml_instrumenter.h | 516 + include/libc_patch.h | 563 ++ install-sh | 251 + lib/Deputy.pm | 276 + lib/deputy_libc.c | 149 + lib/deputy_linux.c | 88 + lib/instr_glob_state.c | 155 + lib/lwcalls.sml | 1261 +++ obj/.depend/.cvsignore | 1 + obj/x86_LINUX/.cvsignore | 1 + obj/x86_WIN32/.cvsignore | 1 + rpm/deputy.spec | 43 + src/dattrs.ml | 1169 +++ src/dattrs.mli | 144 + src/dcheck.ml | 1603 +++ src/dcheck.mli | 45 + src/dcheckdef.ml | 429 + src/dcheckdef.mli | 66 + src/dglobinit.ml | 261 + src/dglobinit.mli | 41 + src/dinfer.ml | 1720 ++++ src/dinfer.mli | 42 + src/dlocals.ml | 383 + src/dlocals.mli | 41 + src/doptions.ml | 228 + src/doptions.mli | 69 + src/dpatch.ml | 300 + src/dpatch.mli | 41 + src/dpoly.ml | 167 + src/dpoly.mli | 46 + src/dsolverfront.ml | 192 + src/dutil.ml | 634 ++ src/dutil.mli | 87 + src/dvararg.ml | 172 + src/dvararg.mli | 41 + src/infer/controlflow.ml | 1139 +++ src/infer/inferkinds.ml | 230 + src/infer/inferkinds.mli | 3 + src/infer/markptr.ml | 947 ++ src/infer/markptr.mli | 41 + src/infer/ptrnode.ml | 1935 ++++ src/infer/ptrnode.mli | 472 + src/infer/solver.ml | 911 ++ src/infer/solver.mli | 38 + src/infer/type.ml | 845 ++ src/infer/type.mli | 110 + src/infer/unionfind.ml | 172 + src/instrumenter/dinstrumenter.ml | 751 ++ src/instrumenter/dtaint.ml | 531 + src/main.ml | 321 + src/optimizer/dcanonexp.ml | 422 + src/optimizer/dcheckhoister.ml | 400 + src/optimizer/dcheckstrengthen.ml | 171 + src/optimizer/ddupcelim.ml | 337 + src/optimizer/dfailfinder.ml | 146 + src/optimizer/dfdatbrowser.ml | 254 + src/optimizer/dflowinsens.ml | 384 + src/optimizer/dflowsens.ml | 1801 ++++ src/optimizer/dfwdsubst.ml | 403 + src/optimizer/dloopoptim.ml | 482 + src/optimizer/dnonnullfinder.ml | 147 + src/optimizer/doptimmain.ml | 358 + src/optimizer/doptimutil.ml | 300 + src/optimizer/dprecfinder.ml | 880 ++ src/optimizer/modref/saturnModRef/dmodref.ml | 342 + src/optimizer/modref/zraModRef/dmodref.ml | 415 + .../nullSolver/nullSolverInterface.ml | 11 + src/optimizer/oct/mineOct/doctanalysis.ml | 1215 +++ src/optimizer/oct/mineOct/oct.h | 575 ++ src/optimizer/oct/mineOct/oct.ml | 376 + src/optimizer/oct/mineOct/oct.mli | 176 + src/optimizer/oct/mineOct/oct_config.h | 16 + src/optimizer/oct/mineOct/oct_config_2.h | 35 + src/optimizer/oct/mineOct/oct_num.h | 1636 ++++ src/optimizer/oct/mineOct/oct_ocaml.c | 1693 ++++ src/optimizer/oct/mineOct/oct_ocaml.h | 56 + src/optimizer/oct/mineOct/oct_private.h | 187 + src/optimizer/oct/mineOct/oct_sem.c | 4009 ++++++++ src/optimizer/oct/mineOct/oct_util.c | 383 + src/optimizer/oct/nullOct/doctanalysis.ml | 32 + src/optimizer/ptranal/cilPtrAnal/dptranal.ml | 198 + .../ptranal/saturnPtrAnal/dptranal.ml | 0 src/optimizer/solver/cvclSolver/Makefile | 69 + src/optimizer/solver/cvclSolver/cvcl.ml | 258 + .../solver/cvclSolver/cvcl_ocaml_wrappers.c | 1505 +++ .../solver/cvclSolver/cvcl_solver_test.ml | 22 + .../solver/cvclSolver/solverInterface.ml | 308 + .../solver/nullSolver/solverInterface.ml | 17 + src/optimizer/solver/yicesSolver/Makefile | 69 + .../solver/yicesSolver/solverInterface.ml | 182 + src/optimizer/solver/yicesSolver/yices.ml | 195 + .../solver/yicesSolver/yices_ocaml_wrappers.c | 1015 ++ .../solver/yicesSolver/yices_solver_test.ml | 63 + src/optimizer/xhtml/xHTML.ml | 1629 ++++ src/optimizer/xhtml/xHTML.mli | 969 ++ src/optimizer/xhtml/xML.ml | 411 + src/optimizer/xhtml/xML.mli | 126 + test/.cvsignore | 2 + test/Makefile.in | 62 + test/libc/.cvsignore | 7 + test/libc/Makefile | 22 + test/libc/crypt1.c | 28 + test/libc/ctype1.c | 26 + test/libc/fwrite1.c | 14 + test/libc/getaddrinfo1.c | 170 + test/libc/getpwnam1.c | 85 + test/libc/glob1.c | 90 + test/libc/harness.h | 13 + test/libc/hostent1.c | 49 + test/libc/hostent2.c | 99 + test/libc/malloc1.c | 21 + test/libc/malloc2.c | 15 + test/libc/memset1.c | 10 + test/libc/popen1.c | 239 + test/libc/printf1.c | 28 + test/libc/printf2.c | 6 + test/libc/readv1.c | 95 + test/libc/servent1.c | 41 + test/libc/servent2.c | 45 + test/libc/sockaddr1.c | 113 + test/libc/socket1.c | 123 + test/libc/stat1.c | 25 + test/libc/strchr1.c | 22 + test/libc/strcpy.c | 26 + test/libc/strerror1.c | 10 + test/libc/string1.c | 16 + test/libc/string2.c | 28 + test/libc/string3.c | 25 + test/libc/string4.c | 33 + test/libc/string5.c | 264 + test/libc/string6.c | 332 + test/libc/string7.c | 390 + test/libc/strlcpy.c | 29 + test/libc/strncpy1.c | 19 + test/libc/strpbrk1.c | 14 + test/libc/strspn.c | 16 + test/libc/strtok1.c | 92 + test/libc/vararg1.c | 29 + test/libc/writev1.c | 113 + test/small/.cvsignore | 7 + test/small/Makefile | 25 + test/small/abstract1.c | 28 + test/small/addrof1.c | 7 + test/small/addrof2.c | 11 + test/small/addrof3.c | 14 + test/small/addrof4.c | 14 + test/small/addrof5.c | 11 + test/small/addrof6.c | 6 + test/small/addrof7.c | 10 + test/small/align1.c | 24 + test/small/align2.c | 42 + test/small/alloc1.c | 18 + test/small/alloc10.c | 90 + test/small/alloc11.c | 9 + test/small/alloc12.c | 13 + test/small/alloc2.c | 20 + test/small/alloc3.c | 30 + test/small/alloc4.c | 16 + test/small/alloc5.c | 27 + test/small/alloc6.c | 22 + test/small/alloc7.c | 21 + test/small/alloc8.c | 26 + test/small/alloc9.c | 29 + test/small/array1.c | 64 + test/small/array2.c | 12 + test/small/array3.c | 15 + test/small/array4.c | 29 + test/small/array5.c | 14 + test/small/array6.c | 19 + test/small/array7.c | 11 + test/small/auto1.c | 68 + test/small/auto2.c | 58 + test/small/auto3.c | 66 + test/small/auto4.c | 12 + test/small/auto5.c | 22 + test/small/auto6.c | 45 + test/small/auto7.c | 15 + test/small/auto8.c | 5 + test/small/auto9.c | 24 + test/small/bound1.c | 29 + test/small/builtin1.c | 4 + test/small/call1.c | 10 + test/small/call2.c | 13 + test/small/call3.c | 14 + test/small/call4.c | 14 + test/small/call5.c | 11 + test/small/call6.c | 29 + test/small/call7.c | 15 + test/small/call8.c | 10 + test/small/cast1.c | 8 + test/small/cast10.c | 19 + test/small/cast11.c | 12 + test/small/cast12.c | 9 + test/small/cast13.c | 12 + test/small/cast14.c | 9 + test/small/cast15.c | 21 + test/small/cast16.c | 20 + test/small/cast17.c | 8 + test/small/cast18.c | 38 + test/small/cast19.c | 14 + test/small/cast2.c | 7 + test/small/cast20.c | 17 + test/small/cast3.c | 8 + test/small/cast4.c | 17 + test/small/cast5.c | 6 + test/small/cast6.c | 26 + test/small/cast7.c | 17 + test/small/cast8.c | 18 + test/small/cast9.c | 21 + test/small/deref1.c | 9 + test/small/deref2.c | 10 + test/small/deref3.c | 21 + test/small/enum1.c | 10 + test/small/extern1.c | 12 + test/small/extern2.c | 13 + test/small/extern3.c | 5 + test/small/extinline1.c | 15 + test/small/field1.c | 17 + test/small/field2.c | 18 + test/small/field3.c | 18 + test/small/field4.c | 57 + test/small/field5.c | 18 + test/small/func1.c | 14 + test/small/func2.c | 51 + test/small/func3.c | 50 + test/small/func4.c | 18 + test/small/func5.c | 38 + test/small/func6.c | 12 + test/small/func7.c | 54 + test/small/func8.c | 14 + test/small/func9.c | 15 + test/small/global1.c | 11 + test/small/global2.c | 14 + test/small/global3.c | 17 + test/small/global4.c | 19 + test/small/global5.c | 15 + test/small/global6.c | 16 + test/small/global7.c | 39 + test/small/global8.c | 6 + test/small/global9.c | 14 + test/small/harness.h | 20 + test/small/incr1.c | 23 + test/small/infer1.c | 14 + test/small/infer10.c | 15 + test/small/infer11.c | 6 + test/small/infer12.c | 8 + test/small/infer13.c | 16 + test/small/infer14.c | 19 + test/small/infer15.c | 19 + test/small/infer16.c | 13 + test/small/infer17.c | 10 + test/small/infer18.c | 9 + test/small/infer19.c | 19 + test/small/infer2.c | 12 + test/small/infer3.c | 5 + test/small/infer4.c | 29 + test/small/infer5.c | 12 + test/small/infer6.c | 12 + test/small/infer7.c | 20 + test/small/infer8.c | 17 + test/small/infer9.c | 13 + test/small/init1.c | 39 + test/small/init2.c | 17 + test/small/live1.c | 47 + test/small/live2.c | 30 + test/small/live3.c | 16 + test/small/local1.c | 26 + test/small/memcmp1.c | 60 + test/small/memcmp2.c | 36 + test/small/memcpy1.c | 60 + test/small/memcpy2.c | 17 + test/small/memset1.c | 47 + test/small/memset2.c | 29 + test/small/nonnull1.c | 32 + test/small/nonnull2.c | 21 + test/small/nonnull3.c | 24 + test/small/nonnull4.c | 19 + test/small/nullterm1.c | 32 + test/small/nullterm10.c | 5 + test/small/nullterm11.c | 22 + test/small/nullterm2.c | 31 + test/small/nullterm3.c | 12 + test/small/nullterm4.c | 17 + test/small/nullterm5.c | 5 + test/small/nullterm6.c | 66 + test/small/nullterm7.c | 19 + test/small/nullterm8.c | 33 + test/small/nullterm9.c | 21 + test/small/offset1.c | 28 + test/small/offset2.c | 29 + test/small/offset3.c | 16 + test/small/openarray1.c | 27 + test/small/openarray2.c | 31 + test/small/openarray3.c | 21 + test/small/openarray4.c | 16 + test/small/opt1.c | 7 + test/small/opt10.c | 14 + test/small/opt11.c | 14 + test/small/opt12.c | 16 + test/small/opt13.c | 15 + test/small/opt14.c | 6 + test/small/opt15.c | 18 + test/small/opt16.c | 19 + test/small/opt2.c | 18 + test/small/opt3.c | 21 + test/small/opt4.c | 34 + test/small/opt5.c | 40 + test/small/opt6.c | 13 + test/small/opt7.c | 30 + test/small/opt8.c | 39 + test/small/opt9.c | 5 + test/small/overflow1.c | 46 + test/small/overflow2.c | 24 + test/small/packed1.c | 12 + test/small/poly1.c | 9 + test/small/poly2.c | 10 + test/small/poly3.c | 13 + test/small/poly4.c | 48 + test/small/poly5.c | 19 + test/small/poly6.c | 21 + test/small/poly7.c | 16 + test/small/ptrarith1.c | 8 + test/small/ptrarith2.c | 22 + test/small/retbound1.c | 16 + test/small/return1.c | 24 + test/small/sentinel1.c | 37 + test/small/sentinel2.c | 10 + test/small/size1.c | 18 + test/small/size2.c | 30 + test/small/size3.c | 25 + test/small/size4.c | 18 + test/small/sizeof1.c | 5 + test/small/sizeof2.c | 20 + test/small/sizeof3.c | 6 + test/small/startof1.c | 6 + test/small/startof2.c | 8 + test/small/string1.c | 46 + test/small/string10.c | 11 + test/small/string12.c | 20 + test/small/string13.c | 20 + test/small/string14.c | 12 + test/small/string15.c | 5 + test/small/string16.c | 23 + test/small/string18.c | 66 + test/small/string19.c | 29 + test/small/string2.c | 11 + test/small/string20.c | 351 + test/small/string21.c | 10 + test/small/string3.c | 18 + test/small/string4.c | 20 + test/small/string5.c | 24 + test/small/string6.c | 14 + test/small/string7.c | 12 + test/small/string8.c | 21 + test/small/string9.c | 22 + test/small/struct1.c | 18 + test/small/testlib.c | 32 + test/small/trusted1.c | 10 + test/small/trusted10.c | 80 + test/small/trusted11.c | 14 + test/small/trusted12.c | 24 + test/small/trusted13.c | 8 + test/small/trusted2.c | 18 + test/small/trusted3.c | 7 + test/small/trusted4.c | 24 + test/small/trusted5.c | 15 + test/small/trusted6.c | 5 + test/small/trusted7.c | 22 + test/small/trusted8.c | 13 + test/small/trusted9.c | 13 + test/small/typedef1.c | 34 + test/small/typedef2.c | 23 + test/small/typeof1.c | 17 + test/small/types1.c | 9 + test/small/types2.c | 10 + test/small/types3.c | 8 + test/small/types4.c | 11 + test/small/types5.c | 7 + test/small/types6.c | 12 + test/small/types7.c | 9 + test/small/types8.c | 28 + test/small/types9.c | 15 + test/small/union1.c | 77 + test/small/union2.c | 45 + test/small/union3.c | 120 + test/small/union4.c | 58 + test/small/union5.c | 117 + test/small/union6.c | 18 + test/small/upcast1.c | 29 + test/small/upcast2.c | 20 + test/small/var1.c | 11 + test/small/var2.c | 13 + test/small/var3.c | 13 + test/small/var4.c | 24 + test/small/var5.c | 10 + test/small/vararg1.c | 18 + test/small/voidstar1.c | 11 + test/small/voidstar2.c | 20 + test/small/voidstar4.c | 11 + test/small/volatile1.c | 27 + test/testdeputy | 3 + test/testdeputy.pl | 494 + web/.htaccess | 1 + web/index.html | 61 + web/web-driver.cgi | 309 + 1203 files changed, 188955 insertions(+) create mode 100755 .cvsignore create mode 100644 .distexclude create mode 100644 LICENSE create mode 100644 Makefile.in create mode 100755 bin/.cvsignore create mode 100755 bin/deputy create mode 100644 cil/.cvsignore create mode 100755 cil/Bootstrap create mode 100644 cil/INSTALL create mode 100644 cil/LICENSE create mode 100644 cil/Makefile.gcc create mode 100644 cil/Makefile.in create mode 100644 cil/Makefile.msvc create mode 100644 cil/NOTES create mode 100644 cil/README create mode 100644 cil/_tags create mode 100644 cil/aclocal.m4 create mode 100644 cil/bin/.cvsignore create mode 100644 cil/bin/CilConfig.pm.in create mode 100755 cil/bin/cabsxform create mode 100755 cil/bin/cilly create mode 100755 cil/bin/cilly.bat.in create mode 100755 cil/bin/patcher create mode 100755 cil/bin/patcher.bat.in create mode 100755 cil/bin/teetwo create mode 100755 cil/bin/test-bad create mode 100644 cil/cil.itarget create mode 100644 cil/cil.spec.in create mode 100755 cil/config.guess create mode 100644 cil/config.h.in create mode 100644 cil/config.mk.in create mode 100755 cil/config.sub create mode 100755 cil/configure create mode 100644 cil/configure.in create mode 100644 cil/debian/.cvsignore create mode 100644 cil/debian/changelog create mode 100644 cil/debian/cil-dev.install create mode 100644 cil/debian/cil.install create mode 100644 cil/debian/compat create mode 100644 cil/debian/control create mode 100644 cil/debian/copyright create mode 100755 cil/debian/rules create mode 100644 cil/debian/watch create mode 100644 cil/doc/.cvsignore create mode 100644 cil/doc/cil.itarget create mode 100644 cil/doc/cil.odocl create mode 100644 cil/doc/cil.tex create mode 100644 cil/doc/cilcode.pl create mode 100644 cil/doc/comment.sty create mode 100644 cil/doc/cvssetup.tex create mode 100644 cil/doc/fullpage.sty create mode 100644 cil/doc/header.html.in create mode 100644 cil/doc/hevea.sty create mode 100644 cil/doc/html/.cvsignore create mode 100644 cil/doc/index.html.in create mode 100644 cil/doc/main.html create mode 100644 cil/doc/makefiles.txt create mode 100644 cil/doc/ocamldoc.html create mode 100644 cil/doc/ocamldoc.patch create mode 100644 cil/doc/program.sty create mode 100644 cil/doc/proof.sty create mode 100644 cil/doc/sendmail.txt create mode 100644 cil/doc/setup.tex create mode 100644 cil/doc/tips-and-tricks.txt create mode 100644 cil/install-sh create mode 100644 cil/lib/.cvsignore create mode 100644 cil/lib/.gdbinit create mode 100644 cil/lib/Cilly.pm create mode 100644 cil/lib/KeptFile.pm create mode 100644 cil/lib/Makefile create mode 100644 cil/lib/OutputFile.pm create mode 100644 cil/lib/TempFile.pm create mode 100644 cil/myocamlbuild.ml create mode 100644 cil/obj/.depend/.cvsignore create mode 100755 cil/ocamlutil/.cvsignore create mode 100644 cil/ocamlutil/Makefile.ocaml create mode 100644 cil/ocamlutil/Makefile.ocaml.build create mode 100644 cil/ocamlutil/RegTest.pm create mode 100644 cil/ocamlutil/_tags create mode 100644 cil/ocamlutil/alpha.ml create mode 100644 cil/ocamlutil/alpha.mli create mode 100644 cil/ocamlutil/bitmap.ml create mode 100644 cil/ocamlutil/bitmap.mli create mode 100644 cil/ocamlutil/bitvector.ml create mode 100644 cil/ocamlutil/bitvector.mli create mode 100644 cil/ocamlutil/bitvector.out create mode 100644 cil/ocamlutil/bitvectori.c create mode 100644 cil/ocamlutil/clist.ml create mode 100644 cil/ocamlutil/clist.mli create mode 100644 cil/ocamlutil/errormsg.ml create mode 100644 cil/ocamlutil/errormsg.mli create mode 100644 cil/ocamlutil/growArray.ml create mode 100644 cil/ocamlutil/growArray.mli create mode 100644 cil/ocamlutil/inthash.ml create mode 100644 cil/ocamlutil/inthash.mli create mode 100644 cil/ocamlutil/intmap.ml create mode 100644 cil/ocamlutil/intmap.mli create mode 100644 cil/ocamlutil/longarray.ml create mode 100644 cil/ocamlutil/longarray.mli create mode 100644 cil/ocamlutil/options.ml create mode 100644 cil/ocamlutil/options.mli create mode 100644 cil/ocamlutil/pa_prtype.ml create mode 100644 cil/ocamlutil/perfcount.c.in create mode 100644 cil/ocamlutil/pretty.ml create mode 100644 cil/ocamlutil/pretty.mli create mode 100644 cil/ocamlutil/profile.c.in create mode 100755 cil/ocamlutil/runall.pl create mode 100644 cil/ocamlutil/stats.ml create mode 100644 cil/ocamlutil/stats.mli create mode 100755 cil/ocamlutil/symbolrange.pl create mode 100644 cil/ocamlutil/trace.ml create mode 100644 cil/ocamlutil/trace.mli create mode 100644 cil/ocamlutil/util.ml create mode 100644 cil/ocamlutil/util.mli create mode 100644 cil/src/.cvsignore create mode 100644 cil/src/_tags create mode 100644 cil/src/check.ml create mode 100644 cil/src/check.mli create mode 100644 cil/src/cil.itarget create mode 100644 cil/src/cil.ml create mode 100644 cil/src/cil.mli create mode 100644 cil/src/cil.mllib create mode 100644 cil/src/cillower.ml create mode 100644 cil/src/cillower.mli create mode 100644 cil/src/ciloptions.ml create mode 100644 cil/src/ciloptions.mli create mode 100644 cil/src/cilutil.ml create mode 100644 cil/src/cilversion.ml.in create mode 100644 cil/src/escape.ml create mode 100644 cil/src/escape.mli create mode 100644 cil/src/ext/_tags create mode 100644 cil/src/ext/arithabs.ml create mode 100644 cil/src/ext/astslicer.ml create mode 100644 cil/src/ext/availexps.ml create mode 100644 cil/src/ext/availexpslv.ml create mode 100644 cil/src/ext/blockinggraph.ml create mode 100644 cil/src/ext/blockinggraph.mli create mode 100644 cil/src/ext/callgraph.ml create mode 100644 cil/src/ext/callgraph.mli create mode 100644 cil/src/ext/canonicalize.ml create mode 100644 cil/src/ext/canonicalize.mli create mode 100644 cil/src/ext/ccl.ml create mode 100644 cil/src/ext/ccl.mli create mode 100644 cil/src/ext/cfg.ml create mode 100644 cil/src/ext/cfg.mli create mode 100644 cil/src/ext/ciltools.ml create mode 100644 cil/src/ext/cqualann.ml create mode 100644 cil/src/ext/dataflow.ml create mode 100644 cil/src/ext/dataflow.mli create mode 100644 cil/src/ext/dataslicing.ml create mode 100644 cil/src/ext/dataslicing.mli create mode 100644 cil/src/ext/deadcodeelim.ml create mode 100644 cil/src/ext/dominators.ml create mode 100644 cil/src/ext/dominators.mli create mode 100644 cil/src/ext/epicenter.ml create mode 100644 cil/src/ext/expcompare.ml create mode 100644 cil/src/ext/heap.ml create mode 100644 cil/src/ext/heapify.ml create mode 100644 cil/src/ext/inliner.ml create mode 100644 cil/src/ext/liveness.ml create mode 100644 cil/src/ext/logcalls.ml create mode 100644 cil/src/ext/logcalls.mli create mode 100644 cil/src/ext/logwrites.ml create mode 100644 cil/src/ext/oneret.ml create mode 100644 cil/src/ext/oneret.mli create mode 100644 cil/src/ext/optutil.ml create mode 100644 cil/src/ext/optutil.mli create mode 100644 cil/src/ext/partial.ml create mode 100644 cil/src/ext/predabst.ml create mode 100644 cil/src/ext/pta/golf.ml create mode 100644 cil/src/ext/pta/golf.mli create mode 100644 cil/src/ext/pta/olf.ml create mode 100644 cil/src/ext/pta/olf.mli create mode 100644 cil/src/ext/pta/ptranal.ml create mode 100644 cil/src/ext/pta/ptranal.mli create mode 100644 cil/src/ext/pta/setp.ml create mode 100644 cil/src/ext/pta/setp.mli create mode 100644 cil/src/ext/pta/steensgaard.ml create mode 100644 cil/src/ext/pta/steensgaard.mli create mode 100644 cil/src/ext/pta/uref.ml create mode 100644 cil/src/ext/pta/uref.mli create mode 100644 cil/src/ext/rand.ml create mode 100644 cil/src/ext/reachingdefs.ml create mode 100644 cil/src/ext/rmciltmps.ml create mode 100644 cil/src/ext/sfi.ml create mode 100644 cil/src/ext/simplemem.ml create mode 100644 cil/src/ext/simplify.ml create mode 100644 cil/src/ext/ssa.ml create mode 100644 cil/src/ext/ssa.mli create mode 100644 cil/src/ext/stackoverflow.ml create mode 100644 cil/src/ext/stackoverflow.mli create mode 100644 cil/src/ext/ufsarithabs.ml create mode 100644 cil/src/ext/usedef.ml create mode 100644 cil/src/formatcil.ml create mode 100644 cil/src/formatcil.mli create mode 100644 cil/src/formatlex.mll create mode 100644 cil/src/formatparse.mly create mode 100644 cil/src/frontc/.cvsignore create mode 100644 cil/src/frontc/cabs.ml create mode 100644 cil/src/frontc/cabs2cil.ml create mode 100644 cil/src/frontc/cabs2cil.mli create mode 100644 cil/src/frontc/cabshelper.ml create mode 100644 cil/src/frontc/cabsvisit.ml create mode 100644 cil/src/frontc/cabsvisit.mli create mode 100644 cil/src/frontc/clexer.mli create mode 100644 cil/src/frontc/clexer.mll create mode 100644 cil/src/frontc/cparser.mly create mode 100644 cil/src/frontc/cprint.ml create mode 100644 cil/src/frontc/frontc.ml create mode 100644 cil/src/frontc/frontc.mli create mode 100644 cil/src/frontc/lexerhack.ml create mode 100644 cil/src/frontc/patch.ml create mode 100644 cil/src/frontc/patch.mli create mode 100644 cil/src/frontc/whitetrack.ml create mode 100644 cil/src/frontc/whitetrack.mli create mode 100644 cil/src/libmaincil.ml create mode 100644 cil/src/machdep-ml.c create mode 100644 cil/src/machdepenv.ml create mode 100644 cil/src/main.ml create mode 100644 cil/src/mergecil.ml create mode 100644 cil/src/mergecil.mli create mode 100644 cil/src/prettytest.ml create mode 100644 cil/src/rmtmps.ml create mode 100644 cil/src/rmtmps.mli create mode 100644 cil/src/testcil.ml create mode 100644 cil/src/zrapp.ml create mode 100644 cil/src/zrapp.mli create mode 100644 cil/test/.cvsignore create mode 100644 cil/test/Makefile create mode 100644 cil/test/small1/.cvsignore create mode 100644 cil/test/small1/.gdbinit create mode 100644 cil/test/small1/GRT.c create mode 100644 cil/test/small1/Makefile create mode 100644 cil/test/small1/addr-array.c create mode 100644 cil/test/small1/addrof3.c create mode 100644 cil/test/small1/align1.c create mode 100644 cil/test/small1/align2.c create mode 100644 cil/test/small1/align3.c create mode 100755 cil/test/small1/apachebits.c create mode 100755 cil/test/small1/apachebuf.c create mode 100755 cil/test/small1/apachefptr.c create mode 100644 cil/test/small1/argcast.c create mode 100644 cil/test/small1/array-args.c create mode 100755 cil/test/small1/array-size-trick.c create mode 100644 cil/test/small1/array1.c create mode 100644 cil/test/small1/array2.c create mode 100755 cil/test/small1/array_formal.c create mode 100755 cil/test/small1/array_varsize.c create mode 100644 cil/test/small1/arrayinitsize.c create mode 100644 cil/test/small1/asm1.c create mode 100644 cil/test/small1/asm2.c create mode 100644 cil/test/small1/asm3.c create mode 100644 cil/test/small1/asm4.c create mode 100644 cil/test/small1/asm5.c create mode 100644 cil/test/small1/assign.c create mode 100644 cil/test/small1/attr.c create mode 100755 cil/test/small1/attr10.c create mode 100755 cil/test/small1/attr11.c create mode 100755 cil/test/small1/attr12.c create mode 100755 cil/test/small1/attr13.c create mode 100644 cil/test/small1/attr2.c create mode 100644 cil/test/small1/attr3.c create mode 100644 cil/test/small1/attr4.c create mode 100644 cil/test/small1/attr5.c create mode 100644 cil/test/small1/attr6.c create mode 100755 cil/test/small1/attr7.c create mode 100755 cil/test/small1/attr8.c create mode 100755 cil/test/small1/attr9.c create mode 100644 cil/test/small1/bf.c create mode 100644 cil/test/small1/bind-formatstring.c create mode 100644 cil/test/small1/bind-used-not-defined.c create mode 100644 cil/test/small1/bitfield.c create mode 100644 cil/test/small1/bitfield0.c create mode 100755 cil/test/small1/bitfield2.c create mode 100644 cil/test/small1/bitfield3.c create mode 100644 cil/test/small1/blockattr.c create mode 100644 cil/test/small1/builtin.c create mode 100755 cil/test/small1/builtin2.c create mode 100755 cil/test/small1/builtin3.c create mode 100644 cil/test/small1/builtin_choose_expr.c create mode 100755 cil/test/small1/call2.c create mode 100644 cil/test/small1/caserange.c create mode 100644 cil/test/small1/cast1.c create mode 100644 cil/test/small1/cast2.c create mode 100644 cil/test/small1/cast3.c create mode 100644 cil/test/small1/cast4.c create mode 100755 cil/test/small1/cast8.c create mode 100644 cil/test/small1/castincr.c create mode 100644 cil/test/small1/combine10_1.c create mode 100644 cil/test/small1/combine10_2.c create mode 100644 cil/test/small1/combine10_3.c create mode 100644 cil/test/small1/combine11_1.c create mode 100644 cil/test/small1/combine11_2.c create mode 100644 cil/test/small1/combine12_1.c create mode 100644 cil/test/small1/combine12_2.c create mode 100644 cil/test/small1/combine13_1.c create mode 100644 cil/test/small1/combine13_2.c create mode 100644 cil/test/small1/combine14_1.c create mode 100644 cil/test/small1/combine14_2.c create mode 100644 cil/test/small1/combine15_1.c create mode 100644 cil/test/small1/combine15_2.c create mode 100644 cil/test/small1/combine16_1.c create mode 100644 cil/test/small1/combine16_2.c create mode 100644 cil/test/small1/combine17_1.c create mode 100644 cil/test/small1/combine17_2.c create mode 100644 cil/test/small1/combine18_1.c create mode 100644 cil/test/small1/combine18_2.c create mode 100644 cil/test/small1/combine1_1.c create mode 100644 cil/test/small1/combine1_2.c create mode 100644 cil/test/small1/combine1_3.c create mode 100644 cil/test/small1/combine20_1.c create mode 100644 cil/test/small1/combine20_2.c create mode 100755 cil/test/small1/combine21_1.c create mode 100755 cil/test/small1/combine21_2.c create mode 100755 cil/test/small1/combine22_1.c create mode 100755 cil/test/small1/combine22_2.c create mode 100644 cil/test/small1/combine2_1.c create mode 100644 cil/test/small1/combine2_2.c create mode 100644 cil/test/small1/combine2_3.c create mode 100644 cil/test/small1/combine3_1.c create mode 100644 cil/test/small1/combine3_2.c create mode 100644 cil/test/small1/combine3_3.c create mode 100644 cil/test/small1/combine4_1.c create mode 100644 cil/test/small1/combine4_2.c create mode 100644 cil/test/small1/combine5.h create mode 100644 cil/test/small1/combine5_1.c create mode 100644 cil/test/small1/combine5_2.c create mode 100644 cil/test/small1/combine5_3.c create mode 100644 cil/test/small1/combine6_1.c create mode 100644 cil/test/small1/combine6_2.c create mode 100644 cil/test/small1/combine6_3.c create mode 100644 cil/test/small1/combine7_1.c create mode 100644 cil/test/small1/combine7_2.c create mode 100644 cil/test/small1/combine7_3.c create mode 100644 cil/test/small1/combine8_1.c create mode 100644 cil/test/small1/combine8_2.c create mode 100644 cil/test/small1/combine9_1.c create mode 100644 cil/test/small1/combine9_2.c create mode 100644 cil/test/small1/combine_allocate_1.c create mode 100644 cil/test/small1/combine_allocate_2.c create mode 100644 cil/test/small1/combine_copyptrs_1.c create mode 100644 cil/test/small1/combine_copyptrs_2.c create mode 100755 cil/test/small1/combine_init_1.c create mode 100755 cil/test/small1/combine_init_2.c create mode 100644 cil/test/small1/combine_node_alloc_1.c create mode 100644 cil/test/small1/combine_node_alloc_2.c create mode 100644 cil/test/small1/combine_samefn_1.c create mode 100644 cil/test/small1/combine_samefn_2.c create mode 100644 cil/test/small1/combine_sbumpB_1.c create mode 100644 cil/test/small1/combine_sbumpB_2.c create mode 100644 cil/test/small1/combine_sbumpB_3.c create mode 100644 cil/test/small1/combine_sbump_1.c create mode 100644 cil/test/small1/combine_sbump_2.c create mode 100644 cil/test/small1/combine_syserr_1.c create mode 100644 cil/test/small1/combine_syserr_2.c create mode 100644 cil/test/small1/combine_theFunc_1.c create mode 100644 cil/test/small1/combine_theFunc_2.c create mode 100644 cil/test/small1/combine_theFunc_3.c create mode 100755 cil/test/small1/combinealias_1.c create mode 100755 cil/test/small1/combinealias_2.c create mode 100644 cil/test/small1/combineenum1_1.c create mode 100644 cil/test/small1/combineenum1_2.c create mode 100644 cil/test/small1/combineenum2_1.c create mode 100644 cil/test/small1/combineenum2_2.c create mode 100644 cil/test/small1/combineenum3_1.c create mode 100644 cil/test/small1/combineenum3_2.c create mode 100644 cil/test/small1/combineinline1_1.c create mode 100644 cil/test/small1/combineinline1_2.c create mode 100644 cil/test/small1/combineinline2_1.c create mode 100644 cil/test/small1/combineinline2_2.c create mode 100644 cil/test/small1/combineinline3_1.c create mode 100644 cil/test/small1/combineinline3_2.c create mode 100644 cil/test/small1/combineinline4_1.c create mode 100644 cil/test/small1/combineinline4_2.c create mode 100644 cil/test/small1/combineinline6_1.c create mode 100644 cil/test/small1/combineinline6_2.c create mode 100755 cil/test/small1/combinelibrik_1.c create mode 100755 cil/test/small1/combinelibrik_2.c create mode 100644 cil/test/small1/combinestruct1_1.c create mode 100644 cil/test/small1/combinestruct1_2.c create mode 100644 cil/test/small1/combinetaggedfn_1.c create mode 100644 cil/test/small1/combinetaggedfn_2.c create mode 100644 cil/test/small1/comma1.c create mode 100755 cil/test/small1/comparisons.c create mode 100644 cil/test/small1/cond1.c create mode 100644 cil/test/small1/cond2.c create mode 100644 cil/test/small1/const-array-init.c create mode 100644 cil/test/small1/const-compound-cast.c create mode 100644 cil/test/small1/const-struct-init.c create mode 100644 cil/test/small1/const1.c create mode 100755 cil/test/small1/const10.c create mode 100755 cil/test/small1/const11.c create mode 100644 cil/test/small1/const2.c create mode 100644 cil/test/small1/const3.c create mode 100644 cil/test/small1/const4.c create mode 100644 cil/test/small1/const5.c create mode 100644 cil/test/small1/const6.c create mode 100644 cil/test/small1/const7.c create mode 100755 cil/test/small1/const8.c create mode 100755 cil/test/small1/const9.c create mode 100644 cil/test/small1/constprop.c create mode 100644 cil/test/small1/cpp-2.c create mode 100755 cil/test/small1/cpp-3.c create mode 100644 cil/test/small1/decl1.c create mode 100644 cil/test/small1/decl2.c create mode 100644 cil/test/small1/decl_mix_stmt.c create mode 100644 cil/test/small1/deref.c create mode 100644 cil/test/small1/duplicate.c create mode 100755 cil/test/small1/empty.i create mode 100644 cil/test/small1/enum.c create mode 100644 cil/test/small1/enum2.c create mode 100755 cil/test/small1/escapes.c create mode 100644 cil/test/small1/extern1.c create mode 100644 cil/test/small1/extern_init.c create mode 100644 cil/test/small1/float.c create mode 100755 cil/test/small1/float2.c create mode 100644 cil/test/small1/for1.c create mode 100755 cil/test/small1/formalscope.c create mode 100644 cil/test/small1/func.c create mode 100755 cil/test/small1/func10.c create mode 100644 cil/test/small1/func2.c create mode 100644 cil/test/small1/func3.c create mode 100644 cil/test/small1/func4.c create mode 100644 cil/test/small1/funcarg.c create mode 100644 cil/test/small1/funptr1.c create mode 100644 cil/test/small1/globals.c create mode 100755 cil/test/small1/globals2.c create mode 100644 cil/test/small1/hello.c create mode 100644 cil/test/small1/huff1.c create mode 100644 cil/test/small1/init.c create mode 100644 cil/test/small1/init1.c create mode 100644 cil/test/small1/init10.c create mode 100644 cil/test/small1/init11.c create mode 100644 cil/test/small1/init12.c create mode 100644 cil/test/small1/init13.c create mode 100644 cil/test/small1/init14.c create mode 100644 cil/test/small1/init15.c create mode 100755 cil/test/small1/init16.c create mode 100755 cil/test/small1/init17.c create mode 100755 cil/test/small1/init18.c create mode 100755 cil/test/small1/init19.c create mode 100644 cil/test/small1/init2.c create mode 100755 cil/test/small1/init20.c create mode 100755 cil/test/small1/init21.c create mode 100755 cil/test/small1/init22.c create mode 100644 cil/test/small1/init3.c create mode 100644 cil/test/small1/init4.c create mode 100644 cil/test/small1/init5.c create mode 100644 cil/test/small1/init6.c create mode 100644 cil/test/small1/init7.c create mode 100644 cil/test/small1/init8.c create mode 100644 cil/test/small1/init9.c create mode 100644 cil/test/small1/initial.c create mode 100644 cil/test/small1/inline1.c create mode 100755 cil/test/small1/inline2.c create mode 100755 cil/test/small1/inline3.c create mode 100644 cil/test/small1/jmp_buf.c create mode 100644 cil/test/small1/knr1.c create mode 100644 cil/test/small1/label1.c create mode 100644 cil/test/small1/label2.c create mode 100644 cil/test/small1/label3.c create mode 100644 cil/test/small1/label4.c create mode 100755 cil/test/small1/label5.c create mode 100644 cil/test/small1/li.c create mode 100755 cil/test/small1/lineno.i create mode 100644 cil/test/small1/linux_atomic.c create mode 100644 cil/test/small1/linux_signal.c create mode 100644 cil/test/small1/linuxcombine1_1.c create mode 100644 cil/test/small1/list.c create mode 100644 cil/test/small1/local.c create mode 100644 cil/test/small1/local.h create mode 100755 cil/test/small1/localinit.c create mode 100644 cil/test/small1/logical.c create mode 100644 cil/test/small1/longBlock.ml create mode 100644 cil/test/small1/lstring.c create mode 100644 cil/test/small1/lval1.c create mode 100644 cil/test/small1/math1.c create mode 100644 cil/test/small1/matrix.c create mode 100644 cil/test/small1/memcpy1.c create mode 100755 cil/test/small1/min.c create mode 100755 cil/test/small1/msvc1.c create mode 100755 cil/test/small1/msvc2.c create mode 100755 cil/test/small1/msvc3.c create mode 100755 cil/test/small1/msvc4.c create mode 100755 cil/test/small1/msvc5.c create mode 100755 cil/test/small1/msvc6.c create mode 100755 cil/test/small1/msvc7.c create mode 100755 cil/test/small1/msvc8.c create mode 100755 cil/test/small1/msvc9.c create mode 100644 cil/test/small1/noproto.c create mode 100644 cil/test/small1/noproto1.c create mode 100644 cil/test/small1/noproto2.c create mode 100644 cil/test/small1/noreturn.c create mode 100644 cil/test/small1/offsetof.c create mode 100644 cil/test/small1/offsetof1.c create mode 100644 cil/test/small1/offsetof2.c create mode 100755 cil/test/small1/offsetof3.c create mode 100644 cil/test/small1/oom.c create mode 100644 cil/test/small1/order.c create mode 100755 cil/test/small1/outofmem.c create mode 100644 cil/test/small1/p04.c create mode 100755 cil/test/small1/packed.c create mode 100755 cil/test/small1/packed2.c create mode 100644 cil/test/small1/paper1.c create mode 100644 cil/test/small1/paper2.c create mode 100644 cil/test/small1/percent400.c create mode 100644 cil/test/small1/percentm.c create mode 100644 cil/test/small1/perror.c create mode 100644 cil/test/small1/perror1.c create mode 100644 cil/test/small1/pointers2.c create mode 100644 cil/test/small1/post-assign.c create mode 100644 cil/test/small1/power1.c create mode 100644 cil/test/small1/printf.c create mode 100644 cil/test/small1/printf2.c create mode 100755 cil/test/small1/printf_const.c create mode 100644 cil/test/small1/proto1.c create mode 100644 cil/test/small1/proto2.c create mode 100644 cil/test/small1/pure.c create mode 100755 cil/test/small1/question.c create mode 100755 cil/test/small1/question2.c create mode 100644 cil/test/small1/restrict.c create mode 100644 cil/test/small1/restrict1.c create mode 100644 cil/test/small1/return1.c create mode 100644 cil/test/small1/returnvoid.c create mode 100644 cil/test/small1/returnvoid1.c create mode 100644 cil/test/small1/retval.c create mode 100644 cil/test/small1/rmtmps-attr.c create mode 100644 cil/test/small1/rmtmps1.c create mode 100644 cil/test/small1/rmtmps2.c create mode 100644 cil/test/small1/scope1.c create mode 100755 cil/test/small1/scope10.c create mode 100755 cil/test/small1/scope11.c create mode 100644 cil/test/small1/scope2.c create mode 100644 cil/test/small1/scope3.c create mode 100644 cil/test/small1/scope4.c create mode 100644 cil/test/small1/scope5.c create mode 100644 cil/test/small1/scope6.c create mode 100644 cil/test/small1/scope7.c create mode 100644 cil/test/small1/scope8.c create mode 100644 cil/test/small1/scope9.c create mode 100755 cil/test/small1/semicolon.c create mode 100644 cil/test/small1/signs.c create mode 100644 cil/test/small1/simon6.c create mode 100755 cil/test/small1/simplify_structs1.c create mode 100755 cil/test/small1/simplify_structs2.c create mode 100644 cil/test/small1/sizeof1.c create mode 100755 cil/test/small1/sizeof2.c create mode 100644 cil/test/small1/ssa-test.c create mode 100755 cil/test/small1/ssa-test2.c create mode 100644 cil/test/small1/ssa2.c create mode 100644 cil/test/small1/ssa3.c create mode 100644 cil/test/small1/ssa4.c create mode 100755 cil/test/small1/ssa5.c create mode 100755 cil/test/small1/stack.c create mode 100644 cil/test/small1/static.c create mode 100644 cil/test/small1/static1.c create mode 100755 cil/test/small1/static2.c create mode 100644 cil/test/small1/strcpy.c create mode 100644 cil/test/small1/string1.c create mode 100755 cil/test/small1/string2.c create mode 100755 cil/test/small1/stringsize.c create mode 100644 cil/test/small1/strloop.c create mode 100644 cil/test/small1/strloop3.c create mode 100644 cil/test/small1/struct1.c create mode 100644 cil/test/small1/struct2.c create mode 100644 cil/test/small1/struct_init.c create mode 100644 cil/test/small1/structassign.c create mode 100644 cil/test/small1/tags.c create mode 100644 cil/test/small1/task.c create mode 100755 cil/test/small1/tempname.c create mode 100644 cil/test/small1/testharness.h create mode 100755 cil/test/small1/typeof1.c create mode 100644 cil/test/small1/typespec1.c create mode 100644 cil/test/small1/unimplemented.c create mode 100644 cil/test/small1/union1.c create mode 100644 cil/test/small1/union2.c create mode 100644 cil/test/small1/union3.c create mode 100755 cil/test/small1/union5.c create mode 100644 cil/test/small1/unsafe1.c create mode 100644 cil/test/small1/va-arg-1.c create mode 100644 cil/test/small1/va-arg-2.c create mode 100644 cil/test/small1/va-arg-7.c create mode 100644 cil/test/small1/var.c create mode 100644 cil/test/small1/vararg1.c create mode 100755 cil/test/small1/vararg10.c create mode 100755 cil/test/small1/vararg11.c create mode 100644 cil/test/small1/vararg2.c create mode 100644 cil/test/small1/vararg3.c create mode 100644 cil/test/small1/vararg4.c create mode 100644 cil/test/small1/vararg5.c create mode 100644 cil/test/small1/vararg5.h create mode 100644 cil/test/small1/vararg6.c create mode 100644 cil/test/small1/vararg7.c create mode 100644 cil/test/small1/varargauto1.c create mode 100644 cil/test/small1/varied.c create mode 100644 cil/test/small1/version.c create mode 100644 cil/test/small1/void.c create mode 100644 cil/test/small1/voidarg.c create mode 100644 cil/test/small1/voidstar.c create mode 100755 cil/test/small1/voidtypedef.c create mode 100644 cil/test/small1/vsp.c create mode 100755 cil/test/small1/warnings-cast.c create mode 100644 cil/test/small1/warnings-noreturn.c create mode 100644 cil/test/small1/warnings-unused-label.c create mode 100644 cil/test/small1/wchar-bad.c create mode 100644 cil/test/small1/wchar1.c create mode 100644 cil/test/small1/wchar1_freebsd.c create mode 100644 cil/test/small1/wchar2.c create mode 100644 cil/test/small1/wchar3.c create mode 100644 cil/test/small1/wchar4.c create mode 100644 cil/test/small1/wchar5.c create mode 100644 cil/test/small1/wchar6.c create mode 100644 cil/test/small1/wchar7.c create mode 100644 cil/test/small1/wrongnumargs.c create mode 100644 cil/test/small1/zerotags.c create mode 100644 cil/test/small2/.cvsignore create mode 100644 cil/test/small2/Makefile create mode 100644 cil/test/small2/align.c create mode 100755 cil/test/small2/alpha.c create mode 100644 cil/test/small2/arrayinit.c create mode 100755 cil/test/small2/arrsize.c create mode 100644 cil/test/small2/asmfndecl.c create mode 100644 cil/test/small2/attrib.c create mode 100644 cil/test/small2/badasm.c create mode 100644 cil/test/small2/baddef1.c create mode 100644 cil/test/small2/baddef2.c create mode 100644 cil/test/small2/bisonerror.c create mode 100644 cil/test/small2/bogus_redef.c create mode 100644 cil/test/small2/brlock.c create mode 100644 cil/test/small2/bzero.c create mode 100644 cil/test/small2/checkinit.c create mode 100644 cil/test/small2/checkret.c create mode 100644 cil/test/small2/checkstore.c create mode 100644 cil/test/small2/checkstore2.c create mode 100644 cil/test/small2/checkstore3.c create mode 100644 cil/test/small2/checksymbol.c create mode 100755 cil/test/small2/cilreturn.c create mode 100644 cil/test/small2/cmpzero.c create mode 100644 cil/test/small2/cof.c create mode 100644 cil/test/small2/comb1.c create mode 100644 cil/test/small2/comb2.c create mode 100755 cil/test/small2/comb3.c create mode 100755 cil/test/small2/comb4.c create mode 100644 cil/test/small2/conset.c create mode 100644 cil/test/small2/constdecl.c create mode 100644 cil/test/small2/constfold.c create mode 100755 cil/test/small2/constfold2.c create mode 100644 cil/test/small2/ctype.c create mode 100644 cil/test/small2/debug_table.c create mode 100644 cil/test/small2/ehstack.c create mode 100644 cil/test/small2/enumattr.c create mode 100644 cil/test/small2/enumerator_sizeof.c create mode 100644 cil/test/small2/enuminit.c create mode 100644 cil/test/small2/enuminit2.c create mode 100644 cil/test/small2/errorinfn.c create mode 100755 cil/test/small2/extinline.c create mode 100644 cil/test/small2/fig1.c create mode 100644 cil/test/small2/fmtstr.c create mode 100644 cil/test/small2/fseq1fail.c create mode 100644 cil/test/small2/funcname.c create mode 100644 cil/test/small2/funcptr.c create mode 100644 cil/test/small2/funcptr2.c create mode 100644 cil/test/small2/funptr1.c create mode 100644 cil/test/small2/gimpdouble.c create mode 100644 cil/test/small2/globalprob.c create mode 100644 cil/test/small2/globinit.c create mode 100644 cil/test/small2/globtable.c create mode 100644 cil/test/small2/handler1.handlers create mode 100644 cil/test/small2/hashtest.c create mode 100644 cil/test/small2/hola.c create mode 100644 cil/test/small2/hufftable.c create mode 100644 cil/test/small2/hufftest.c create mode 100644 cil/test/small2/index1.c create mode 100644 cil/test/small2/initedextern.c create mode 100644 cil/test/small2/invalredef.c create mode 100644 cil/test/small2/invalredef2.c create mode 100644 cil/test/small2/jpeg_compress_struct.c create mode 100644 cil/test/small2/kernel1.c create mode 100644 cil/test/small2/kernel2.c create mode 100644 cil/test/small2/lexnum.c create mode 100644 cil/test/small2/litstruct.c create mode 100644 cil/test/small2/main.c create mode 100644 cil/test/small2/malloc1.c create mode 100644 cil/test/small2/memberofptr.c create mode 100644 cil/test/small2/memset_sizeof.c create mode 100644 cil/test/small2/merge-ar.c create mode 100644 cil/test/small2/merge-twice-1.c create mode 100644 cil/test/small2/merge-twice-2.c create mode 100644 cil/test/small2/merge-twice-3.c create mode 100644 cil/test/small2/mergeinline1.c create mode 100644 cil/test/small2/mergeinline2.c create mode 100644 cil/test/small2/mergestruct1.c create mode 100644 cil/test/small2/mergestruct2.c create mode 100644 cil/test/small2/metabug3.c create mode 100644 cil/test/small2/mode_sizes.c create mode 100644 cil/test/small2/multiplestatics.c create mode 100644 cil/test/small2/neg64.c create mode 100644 cil/test/small2/nested.c create mode 100644 cil/test/small2/nonwilderror.c create mode 100644 cil/test/small2/oldstyle.c create mode 100644 cil/test/small2/open.c create mode 100644 cil/test/small2/override.c create mode 100644 cil/test/small2/partialbracket.c create mode 100644 cil/test/small2/pset.c create mode 100644 cil/test/small2/ptrinint.c create mode 100644 cil/test/small2/putc.c create mode 100644 cil/test/small2/rbtest.c create mode 100644 cil/test/small2/regbeforeassign.c create mode 100644 cil/test/small2/regparm0.c create mode 100644 cil/test/small2/regthenprintf.c create mode 100644 cil/test/small2/runall_misc.c create mode 100644 cil/test/small2/rusage.c create mode 100644 cil/test/small2/s59.c create mode 100644 cil/test/small2/scary.c create mode 100644 cil/test/small2/segfault.c create mode 100644 cil/test/small2/seq_align_malloc.c create mode 100644 cil/test/small2/seq_align_malloc2.c create mode 100644 cil/test/small2/seqalign.c create mode 100755 cil/test/small2/sizeof3.c create mode 100644 cil/test/small2/sizeofchar.c create mode 100644 cil/test/small2/sockaddr.c create mode 100644 cil/test/small2/stackptr.c create mode 100644 cil/test/small2/stackptrptr.c create mode 100644 cil/test/small2/struct_cs.c create mode 100644 cil/test/small2/structattr.c create mode 100644 cil/test/small2/structattr2.c create mode 100644 cil/test/small2/structattr3.c create mode 100644 cil/test/small2/switch.c create mode 100644 cil/test/small2/tagfile.txt create mode 100644 cil/test/small2/tagfile1.c create mode 100644 cil/test/small2/tagfile2.c create mode 100644 cil/test/small2/testbtree.c create mode 100644 cil/test/small2/thing.c create mode 100644 cil/test/small2/transpunion.c create mode 100644 cil/test/small2/trivial-tb.c create mode 100755 cil/test/small2/try1.c create mode 100644 cil/test/small2/twoprintfs.c create mode 100644 cil/test/small2/typeof.c create mode 100644 cil/test/small2/undef_func.c create mode 100644 cil/test/small2/uninit_tmp.c create mode 100644 cil/test/small2/union2.c create mode 100644 cil/test/small2/union4.c create mode 100644 cil/test/small2/union5.c create mode 100644 cil/test/small2/union6.c create mode 100755 cil/test/small2/union7.c create mode 100755 cil/test/small2/union8.c create mode 100644 cil/test/small2/unionassign.c create mode 100644 cil/test/small2/unionext.c create mode 100644 cil/test/small2/unscomp.c create mode 100644 cil/test/small2/visit_col.c create mode 100644 cil/test/small2/voidstarint.c create mode 100644 cil/test/small2/volatilestruct.c create mode 100644 cil/test/small2/wes-hashtest.c create mode 100644 cil/test/small2/wes-rbtest.c create mode 100644 cil/test/small2/writev.c create mode 100644 cil/test/small2/xcheckers.c create mode 100755 cil/test/testcil create mode 100755 cil/test/testcil.bat create mode 100644 cil/test/testcil.h create mode 100644 cil/test/testcil.pl create mode 100755 config.guess create mode 100755 config.sub create mode 100755 configure create mode 100644 configure.ac create mode 100644 debian/changelog create mode 100644 debian/compat create mode 100644 debian/control create mode 100644 debian/copyright create mode 100644 debian/dirs create mode 100644 debian/docs create mode 100644 debian/files create mode 100755 debian/rules create mode 100644 debian/watch create mode 100755 doc/.cvsignore create mode 100755 doc/TODO create mode 100755 doc/comment.sty create mode 100644 doc/deputy.1 create mode 100755 doc/deputy.tex create mode 100755 doc/deputycode.pl create mode 100755 doc/fullpage.sty create mode 100755 doc/header.html.in create mode 100755 doc/hevea.sty create mode 100755 doc/html/.cvsignore create mode 100755 doc/index.html.in create mode 100644 doc/www/bnd-be-nt.png create mode 100644 doc/www/bnd-be.png create mode 100644 doc/www/count-5.png create mode 100644 doc/www/count-nm.png create mode 100644 doc/www/deputy.css create mode 100644 doc/www/index.html create mode 100644 doc/www/manual.html create mode 100644 doc/www/quickref.html create mode 100755 include/.cvsignore create mode 100755 include/ccuredport.h create mode 100644 include/deputy/annots.h create mode 100755 include/deputy/checks.h create mode 100644 include/deputy/itaint.patch.h create mode 100644 include/deputy/lwcalls.h create mode 100644 include/deputy/sml_instrumenter.h create mode 100644 include/libc_patch.h create mode 100644 install-sh create mode 100644 lib/Deputy.pm create mode 100755 lib/deputy_libc.c create mode 100755 lib/deputy_linux.c create mode 100644 lib/instr_glob_state.c create mode 100644 lib/lwcalls.sml create mode 100644 obj/.depend/.cvsignore create mode 100644 obj/x86_LINUX/.cvsignore create mode 100644 obj/x86_WIN32/.cvsignore create mode 100644 rpm/deputy.spec create mode 100755 src/dattrs.ml create mode 100644 src/dattrs.mli create mode 100755 src/dcheck.ml create mode 100644 src/dcheck.mli create mode 100644 src/dcheckdef.ml create mode 100644 src/dcheckdef.mli create mode 100755 src/dglobinit.ml create mode 100644 src/dglobinit.mli create mode 100755 src/dinfer.ml create mode 100644 src/dinfer.mli create mode 100755 src/dlocals.ml create mode 100644 src/dlocals.mli create mode 100755 src/doptions.ml create mode 100644 src/doptions.mli create mode 100644 src/dpatch.ml create mode 100644 src/dpatch.mli create mode 100644 src/dpoly.ml create mode 100644 src/dpoly.mli create mode 100644 src/dsolverfront.ml create mode 100755 src/dutil.ml create mode 100644 src/dutil.mli create mode 100755 src/dvararg.ml create mode 100644 src/dvararg.mli create mode 100644 src/infer/controlflow.ml create mode 100644 src/infer/inferkinds.ml create mode 100644 src/infer/inferkinds.mli create mode 100644 src/infer/markptr.ml create mode 100644 src/infer/markptr.mli create mode 100644 src/infer/ptrnode.ml create mode 100644 src/infer/ptrnode.mli create mode 100644 src/infer/solver.ml create mode 100644 src/infer/solver.mli create mode 100644 src/infer/type.ml create mode 100644 src/infer/type.mli create mode 100644 src/infer/unionfind.ml create mode 100644 src/instrumenter/dinstrumenter.ml create mode 100644 src/instrumenter/dtaint.ml create mode 100644 src/main.ml create mode 100644 src/optimizer/dcanonexp.ml create mode 100644 src/optimizer/dcheckhoister.ml create mode 100644 src/optimizer/dcheckstrengthen.ml create mode 100644 src/optimizer/ddupcelim.ml create mode 100644 src/optimizer/dfailfinder.ml create mode 100644 src/optimizer/dfdatbrowser.ml create mode 100644 src/optimizer/dflowinsens.ml create mode 100644 src/optimizer/dflowsens.ml create mode 100644 src/optimizer/dfwdsubst.ml create mode 100644 src/optimizer/dloopoptim.ml create mode 100644 src/optimizer/dnonnullfinder.ml create mode 100644 src/optimizer/doptimmain.ml create mode 100644 src/optimizer/doptimutil.ml create mode 100644 src/optimizer/dprecfinder.ml create mode 100644 src/optimizer/modref/saturnModRef/dmodref.ml create mode 100644 src/optimizer/modref/zraModRef/dmodref.ml create mode 100644 src/optimizer/nullSolver/nullSolverInterface.ml create mode 100644 src/optimizer/oct/mineOct/doctanalysis.ml create mode 100644 src/optimizer/oct/mineOct/oct.h create mode 100644 src/optimizer/oct/mineOct/oct.ml create mode 100644 src/optimizer/oct/mineOct/oct.mli create mode 100644 src/optimizer/oct/mineOct/oct_config.h create mode 100644 src/optimizer/oct/mineOct/oct_config_2.h create mode 100644 src/optimizer/oct/mineOct/oct_num.h create mode 100644 src/optimizer/oct/mineOct/oct_ocaml.c create mode 100644 src/optimizer/oct/mineOct/oct_ocaml.h create mode 100644 src/optimizer/oct/mineOct/oct_private.h create mode 100644 src/optimizer/oct/mineOct/oct_sem.c create mode 100644 src/optimizer/oct/mineOct/oct_util.c create mode 100644 src/optimizer/oct/nullOct/doctanalysis.ml create mode 100644 src/optimizer/ptranal/cilPtrAnal/dptranal.ml create mode 100644 src/optimizer/ptranal/saturnPtrAnal/dptranal.ml create mode 100644 src/optimizer/solver/cvclSolver/Makefile create mode 100644 src/optimizer/solver/cvclSolver/cvcl.ml create mode 100644 src/optimizer/solver/cvclSolver/cvcl_ocaml_wrappers.c create mode 100644 src/optimizer/solver/cvclSolver/cvcl_solver_test.ml create mode 100644 src/optimizer/solver/cvclSolver/solverInterface.ml create mode 100644 src/optimizer/solver/nullSolver/solverInterface.ml create mode 100644 src/optimizer/solver/yicesSolver/Makefile create mode 100644 src/optimizer/solver/yicesSolver/solverInterface.ml create mode 100644 src/optimizer/solver/yicesSolver/yices.ml create mode 100644 src/optimizer/solver/yicesSolver/yices_ocaml_wrappers.c create mode 100644 src/optimizer/solver/yicesSolver/yices_solver_test.ml create mode 100644 src/optimizer/xhtml/xHTML.ml create mode 100644 src/optimizer/xhtml/xHTML.mli create mode 100644 src/optimizer/xhtml/xML.ml create mode 100644 src/optimizer/xhtml/xML.mli create mode 100755 test/.cvsignore create mode 100755 test/Makefile.in create mode 100755 test/libc/.cvsignore create mode 100755 test/libc/Makefile create mode 100755 test/libc/crypt1.c create mode 100644 test/libc/ctype1.c create mode 100755 test/libc/fwrite1.c create mode 100755 test/libc/getaddrinfo1.c create mode 100755 test/libc/getpwnam1.c create mode 100755 test/libc/glob1.c create mode 100755 test/libc/harness.h create mode 100755 test/libc/hostent1.c create mode 100755 test/libc/hostent2.c create mode 100644 test/libc/malloc1.c create mode 100644 test/libc/malloc2.c create mode 100755 test/libc/memset1.c create mode 100644 test/libc/popen1.c create mode 100755 test/libc/printf1.c create mode 100644 test/libc/printf2.c create mode 100755 test/libc/readv1.c create mode 100755 test/libc/servent1.c create mode 100755 test/libc/servent2.c create mode 100755 test/libc/sockaddr1.c create mode 100755 test/libc/socket1.c create mode 100755 test/libc/stat1.c create mode 100755 test/libc/strchr1.c create mode 100755 test/libc/strcpy.c create mode 100755 test/libc/strerror1.c create mode 100755 test/libc/string1.c create mode 100755 test/libc/string2.c create mode 100755 test/libc/string3.c create mode 100755 test/libc/string4.c create mode 100755 test/libc/string5.c create mode 100755 test/libc/string6.c create mode 100755 test/libc/string7.c create mode 100755 test/libc/strlcpy.c create mode 100644 test/libc/strncpy1.c create mode 100755 test/libc/strpbrk1.c create mode 100755 test/libc/strspn.c create mode 100644 test/libc/strtok1.c create mode 100644 test/libc/vararg1.c create mode 100644 test/libc/writev1.c create mode 100755 test/small/.cvsignore create mode 100755 test/small/Makefile create mode 100644 test/small/abstract1.c create mode 100644 test/small/addrof1.c create mode 100644 test/small/addrof2.c create mode 100644 test/small/addrof3.c create mode 100644 test/small/addrof4.c create mode 100644 test/small/addrof5.c create mode 100644 test/small/addrof6.c create mode 100644 test/small/addrof7.c create mode 100644 test/small/align1.c create mode 100644 test/small/align2.c create mode 100755 test/small/alloc1.c create mode 100644 test/small/alloc10.c create mode 100644 test/small/alloc11.c create mode 100644 test/small/alloc12.c create mode 100755 test/small/alloc2.c create mode 100644 test/small/alloc3.c create mode 100644 test/small/alloc4.c create mode 100644 test/small/alloc5.c create mode 100755 test/small/alloc6.c create mode 100755 test/small/alloc7.c create mode 100755 test/small/alloc8.c create mode 100644 test/small/alloc9.c create mode 100755 test/small/array1.c create mode 100644 test/small/array2.c create mode 100644 test/small/array3.c create mode 100755 test/small/array4.c create mode 100755 test/small/array5.c create mode 100644 test/small/array6.c create mode 100644 test/small/array7.c create mode 100755 test/small/auto1.c create mode 100755 test/small/auto2.c create mode 100755 test/small/auto3.c create mode 100644 test/small/auto4.c create mode 100755 test/small/auto5.c create mode 100755 test/small/auto6.c create mode 100644 test/small/auto7.c create mode 100644 test/small/auto8.c create mode 100644 test/small/auto9.c create mode 100755 test/small/bound1.c create mode 100644 test/small/builtin1.c create mode 100644 test/small/call1.c create mode 100644 test/small/call2.c create mode 100644 test/small/call3.c create mode 100644 test/small/call4.c create mode 100755 test/small/call5.c create mode 100755 test/small/call6.c create mode 100644 test/small/call7.c create mode 100644 test/small/call8.c create mode 100644 test/small/cast1.c create mode 100644 test/small/cast10.c create mode 100644 test/small/cast11.c create mode 100755 test/small/cast12.c create mode 100755 test/small/cast13.c create mode 100755 test/small/cast14.c create mode 100755 test/small/cast15.c create mode 100755 test/small/cast16.c create mode 100644 test/small/cast17.c create mode 100755 test/small/cast18.c create mode 100644 test/small/cast19.c create mode 100644 test/small/cast2.c create mode 100755 test/small/cast20.c create mode 100644 test/small/cast3.c create mode 100644 test/small/cast4.c create mode 100644 test/small/cast5.c create mode 100644 test/small/cast6.c create mode 100644 test/small/cast7.c create mode 100644 test/small/cast8.c create mode 100644 test/small/cast9.c create mode 100644 test/small/deref1.c create mode 100644 test/small/deref2.c create mode 100644 test/small/deref3.c create mode 100644 test/small/enum1.c create mode 100644 test/small/extern1.c create mode 100755 test/small/extern2.c create mode 100644 test/small/extern3.c create mode 100755 test/small/extinline1.c create mode 100644 test/small/field1.c create mode 100644 test/small/field2.c create mode 100644 test/small/field3.c create mode 100755 test/small/field4.c create mode 100644 test/small/field5.c create mode 100755 test/small/func1.c create mode 100755 test/small/func2.c create mode 100755 test/small/func3.c create mode 100755 test/small/func4.c create mode 100644 test/small/func5.c create mode 100644 test/small/func6.c create mode 100644 test/small/func7.c create mode 100644 test/small/func8.c create mode 100644 test/small/func9.c create mode 100644 test/small/global1.c create mode 100644 test/small/global2.c create mode 100755 test/small/global3.c create mode 100755 test/small/global4.c create mode 100755 test/small/global5.c create mode 100644 test/small/global6.c create mode 100755 test/small/global7.c create mode 100644 test/small/global8.c create mode 100644 test/small/global9.c create mode 100755 test/small/harness.h create mode 100755 test/small/incr1.c create mode 100644 test/small/infer1.c create mode 100644 test/small/infer10.c create mode 100644 test/small/infer11.c create mode 100644 test/small/infer12.c create mode 100644 test/small/infer13.c create mode 100644 test/small/infer14.c create mode 100755 test/small/infer15.c create mode 100644 test/small/infer16.c create mode 100644 test/small/infer17.c create mode 100644 test/small/infer18.c create mode 100644 test/small/infer19.c create mode 100644 test/small/infer2.c create mode 100644 test/small/infer3.c create mode 100644 test/small/infer4.c create mode 100644 test/small/infer5.c create mode 100644 test/small/infer6.c create mode 100644 test/small/infer7.c create mode 100644 test/small/infer8.c create mode 100644 test/small/infer9.c create mode 100755 test/small/init1.c create mode 100755 test/small/init2.c create mode 100755 test/small/live1.c create mode 100755 test/small/live2.c create mode 100644 test/small/live3.c create mode 100755 test/small/local1.c create mode 100644 test/small/memcmp1.c create mode 100755 test/small/memcmp2.c create mode 100644 test/small/memcpy1.c create mode 100644 test/small/memcpy2.c create mode 100644 test/small/memset1.c create mode 100755 test/small/memset2.c create mode 100755 test/small/nonnull1.c create mode 100755 test/small/nonnull2.c create mode 100755 test/small/nonnull3.c create mode 100755 test/small/nonnull4.c create mode 100644 test/small/nullterm1.c create mode 100644 test/small/nullterm10.c create mode 100644 test/small/nullterm11.c create mode 100644 test/small/nullterm2.c create mode 100644 test/small/nullterm3.c create mode 100644 test/small/nullterm4.c create mode 100644 test/small/nullterm5.c create mode 100644 test/small/nullterm6.c create mode 100755 test/small/nullterm7.c create mode 100644 test/small/nullterm8.c create mode 100755 test/small/nullterm9.c create mode 100755 test/small/offset1.c create mode 100755 test/small/offset2.c create mode 100755 test/small/offset3.c create mode 100644 test/small/openarray1.c create mode 100644 test/small/openarray2.c create mode 100644 test/small/openarray3.c create mode 100644 test/small/openarray4.c create mode 100644 test/small/opt1.c create mode 100644 test/small/opt10.c create mode 100644 test/small/opt11.c create mode 100644 test/small/opt12.c create mode 100644 test/small/opt13.c create mode 100644 test/small/opt14.c create mode 100644 test/small/opt15.c create mode 100644 test/small/opt16.c create mode 100644 test/small/opt2.c create mode 100755 test/small/opt3.c create mode 100755 test/small/opt4.c create mode 100644 test/small/opt5.c create mode 100644 test/small/opt6.c create mode 100755 test/small/opt7.c create mode 100644 test/small/opt8.c create mode 100644 test/small/opt9.c create mode 100755 test/small/overflow1.c create mode 100644 test/small/overflow2.c create mode 100644 test/small/packed1.c create mode 100644 test/small/poly1.c create mode 100644 test/small/poly2.c create mode 100644 test/small/poly3.c create mode 100644 test/small/poly4.c create mode 100644 test/small/poly5.c create mode 100644 test/small/poly6.c create mode 100644 test/small/poly7.c create mode 100644 test/small/ptrarith1.c create mode 100644 test/small/ptrarith2.c create mode 100644 test/small/retbound1.c create mode 100644 test/small/return1.c create mode 100755 test/small/sentinel1.c create mode 100755 test/small/sentinel2.c create mode 100644 test/small/size1.c create mode 100644 test/small/size2.c create mode 100644 test/small/size3.c create mode 100644 test/small/size4.c create mode 100644 test/small/sizeof1.c create mode 100644 test/small/sizeof2.c create mode 100644 test/small/sizeof3.c create mode 100644 test/small/startof1.c create mode 100644 test/small/startof2.c create mode 100755 test/small/string1.c create mode 100755 test/small/string10.c create mode 100644 test/small/string12.c create mode 100755 test/small/string13.c create mode 100755 test/small/string14.c create mode 100755 test/small/string15.c create mode 100755 test/small/string16.c create mode 100755 test/small/string18.c create mode 100755 test/small/string19.c create mode 100755 test/small/string2.c create mode 100755 test/small/string20.c create mode 100644 test/small/string21.c create mode 100644 test/small/string3.c create mode 100644 test/small/string4.c create mode 100644 test/small/string5.c create mode 100644 test/small/string6.c create mode 100644 test/small/string7.c create mode 100644 test/small/string8.c create mode 100755 test/small/string9.c create mode 100755 test/small/struct1.c create mode 100644 test/small/testlib.c create mode 100644 test/small/trusted1.c create mode 100644 test/small/trusted10.c create mode 100755 test/small/trusted11.c create mode 100644 test/small/trusted12.c create mode 100644 test/small/trusted13.c create mode 100644 test/small/trusted2.c create mode 100644 test/small/trusted3.c create mode 100755 test/small/trusted4.c create mode 100644 test/small/trusted5.c create mode 100644 test/small/trusted6.c create mode 100644 test/small/trusted7.c create mode 100644 test/small/trusted8.c create mode 100644 test/small/trusted9.c create mode 100755 test/small/typedef1.c create mode 100755 test/small/typedef2.c create mode 100644 test/small/typeof1.c create mode 100644 test/small/types1.c create mode 100644 test/small/types2.c create mode 100644 test/small/types3.c create mode 100644 test/small/types4.c create mode 100644 test/small/types5.c create mode 100644 test/small/types6.c create mode 100644 test/small/types7.c create mode 100644 test/small/types8.c create mode 100644 test/small/types9.c create mode 100755 test/small/union1.c create mode 100755 test/small/union2.c create mode 100755 test/small/union3.c create mode 100755 test/small/union4.c create mode 100755 test/small/union5.c create mode 100644 test/small/union6.c create mode 100644 test/small/upcast1.c create mode 100644 test/small/upcast2.c create mode 100644 test/small/var1.c create mode 100644 test/small/var2.c create mode 100644 test/small/var3.c create mode 100755 test/small/var4.c create mode 100644 test/small/var5.c create mode 100644 test/small/vararg1.c create mode 100755 test/small/voidstar1.c create mode 100755 test/small/voidstar2.c create mode 100644 test/small/voidstar4.c create mode 100755 test/small/volatile1.c create mode 100755 test/testdeputy create mode 100644 test/testdeputy.pl create mode 100644 web/.htaccess create mode 100644 web/index.html create mode 100644 web/web-driver.cgi diff --git a/.cvsignore b/.cvsignore new file mode 100755 index 0000000..f165631 --- /dev/null +++ b/.cvsignore @@ -0,0 +1,4 @@ +Makefile +autom4te.cache +config.log +config.status diff --git a/.distexclude b/.distexclude new file mode 100644 index 0000000..c76b3bd --- /dev/null +++ b/.distexclude @@ -0,0 +1,29 @@ +.svn +.cvsignore +.distexclude +web +debian +config.status +test/Makefile +cil/doc +cil/test +cil/config.status +cil/Makefile +cil/cil.spec +cil/config.mk +cil/bin/cilly.bat +cil/bin/patcher.bat +cil/bin/CilConfig.pm +cil/ocamlutil/perfcount.c +cil/config.h +doc/comment.sty +doc/deputycode.pl +doc/deputy.tex +doc/fullpage.sty +doc/header.html +doc/header.html.in +doc/hevea.sty +doc/html +doc/index.html +doc/index.html.in +doc/TODO diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..c9ed773 --- /dev/null +++ b/LICENSE @@ -0,0 +1,35 @@ +Copyright (c) 2006, + Jeremy Condit + Matthew Harren + Zachary Anderson + George C. Necula +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/Makefile.in b/Makefile.in new file mode 100644 index 0000000..07d4a37 --- /dev/null +++ b/Makefile.in @@ -0,0 +1,451 @@ +# Makefile for Deputy, based on the CIL Makefiles. +# Jeremy Condit +# +# +# Please edit Makefile.in, not Makefile! + +ifndef ARCHOS + ARCHOS = @ARCHOS@ +endif + +# It is important to build without NATIVECAML first,to generate the +# proper dependencies +all: patch + $(MAKE) -C cil cillib NATIVECAML= +ifndef BYTECODE + $(MAKE) -C cil cillib NATIVECAML=1 +endif + $(MAKE) deputy deputylib +ifndef BYTECODE + $(MAKE) deputy deputylib NATIVECAML=1 +# For some strange reason the bytecode cil library is remade, which triggers +# a remake of the deputy.byte.exe, but not the .asm.exe. This means that +# we keep using the bytecode version of deputy. We force the .asm version to +# be the most recent one + touch obj/$(ARCHOS)/deputy.asm.exe +endif +# $(MAKE) -f src/instrumenter/Makefile + +# 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 + @echo "Rebuilding the Makefile" + ./$< + +config.status: configure + ./$@ --recheck + +configure: configure.ac + autoconf + + +DEPUTY_VERSION = @DEPUTY_VERSION@ + +ifdef RELEASE + UNSAFE := 1 +endif + +ifndef DEPUTYHOME + DEPUTYHOME = @DEPUTYHOME@ +endif + +ifeq (@USE_CVCL@, yes) + ifndef CVCLLIB + CVCLLIB = @CVCLLIB@ + endif + ifndef CVCLINC + CVCLINC = @CVCLINC@ + endif + ifndef OCAMLINC + OCAMLINC = @OCAMLINC@ + endif +endif + +ifeq (@USE_YICES@, yes) + ifndef YICESLIB + YICESLIB = @YICESLIB@ + endif + ifndef YICESINC + YICESINC = @YICESINC@ + endif + ifndef OCAMLINC + OCAMLINC = @OCAMLINC@ + endif +endif + +ifeq (@USE_SATURN@, yes) + ifndef SATURNHOME + SATURNHOME = @SATURNHOME@ + endif +endif + +# +# Deputy executable +# + +OBJDIR = obj/$(ARCHOS) +DEPENDDIR = obj/.depend + +SOURCEDIRS = src src/infer src/optimizer src/optimizer/xhtml \ + src/optimizer/ptranal/cilPtrAnal src/instrumenter \ + src/optimizer/oct/mineOct + +ifeq (@USE_CVCL@, yes) + SOURCEDIRS += src/optimizer/solver/cvclSolver +#else +# SOURCEDIRS += src/optimizer/solver/nullSolver +endif + +ifeq (@USE_YICES@, yes) + SOURCEDIRS += src/optimizer/solver/yicesSolver +else + SOURCEDIRS += src/optimizer/solver/nullSolver +endif + +ifeq (@USE_SATURN@, yes) + SOURCEDIRS += src/optimizer/modref/saturnModRef +else + SOURCEDIRS += src/optimizer/modref/zraModRef +endif + +MODULES = doptions dutil dattrs dcanonexp dcheckdef dsolverfront +ifeq (@USE_CVCL@, yes) + MODULES += cvcl +endif + +ifeq (@USE_YICES@, yes) + MODULES += yices +endif +MODULES += solverInterface ptrnode unionfind dvararg markptr \ + type solver controlflow inferkinds \ + doptimutil dpatch dprecfinder dptranal dmodref \ + dflowinsens dflowsens dfwdsubst ddupcelim \ + dloopoptim dcheckstrengthen dcheckhoister dfailfinder\ + oct doctanalysis dnonnullfinder xML xHTML dfdatbrowser\ + doptimmain dglobinit dlocals dpoly dcheck \ + dtaint dinstrumenter dinfer main + +COMPILEFLAGS = -I cil/obj/$(ARCHOS) +LINKFLAGS = -I cil/obj/$(ARCHOS) + +# For building interface to octagon library +CAML_CFLAGS += -ccopt -Isrc/optimizer/oct/mineOct +MINE_OCT_CMODULES = oct_ocaml oct_sem oct_util + +ifeq (@USE_SATURN@, yes) + COMPILEFLAGS += -I $(SATURNHOME)/bdb + COMPILEFLAGS += -I $(SATURNHOME)/lang + COMPILEFLAGS += -I $(SATURNHOME)/util + COMPILEFLAGS += -I $(SATURNHOME)/mlevent + + LINKFLAGS += -I $(SATURNHOME)/bdb + LINKFLAGS += -I $(SATURNHOME)/lang + LINKFLAGS += -I $(SATURNHOME)/util + LINKFLAGS += -I $(SATURNHOME)/mlevent +endif + +ifeq (@USE_CVCL@, yes) + ifdef NATIVECAML + ENDLINKFLAGS = -cclib -L$(CVCLLIB) -cclib -lcvclite -cclib -lstdc++ -cclib -lgmp + else + ENDLINKFLAGS = -cclib -L$(CVCLLIB) -cclib -lcvclite -cclib -lstdc++ -cclib -lgmp + endif +else + ENDLINKFLAGS = +endif + +ifeq (@USE_YICES@, yes) + ifdef NATIVECAML + ENDLINKFLAGS = -cclib -L$(YICESLIB) -cclib -lyices -cclib -lstdc++ -cclib -lgmp + else + ENDLINKFLAGS = -cclib -L$(YICESLIB) -cclib -lyices -cclib -lstdc++ -cclib -lgmp + endif +else + ENDLINKFLAGS = +endif + +ifeq (@USE_SATURN@, yes) + ENDLINKFLAGS = -cclib -ldb -cclib -lz -cclib -levent +else + ENDLINKFLAGS = +endif + +ifeq (@USE_CVCL@, yes) + CAML_CFLAGS += -ccopt -I$(OCAMLINC) -ccopt -I$(CVCLINC) +endif + +ifeq (@USE_YICES@, yes) + CAML_CFLAGS += -ccopt -I$(OCAMLINC) -ccopt -I$(YICESINC) +endif + +include cil/ocamlutil/Makefile.ocaml + +PROJECT_EXECUTABLE = $(OBJDIR)/deputy$(EXE) +PROJECT_MODULES = $(MODULES) +ifeq (@USE_CVCL@, yes) + CVCL_CMODULES = cvcl_ocaml_wrappers +else + CVCL_CMODULES = +endif + +ifeq (@USE_YICES@, yes) + YICES_CMODULES = yices_ocaml_wrappers +else + YICES_CMODULES = +endif + +ifeq (@USE_SATURN@, yes) + SATURN_EXT_CMODS += $(SATURNHOME)/bdb/cl_bdb + SATURN_EXT_CMODS += $(SATURNHOME)/mlevent/event_stubs + SATURN_EXT_CMODS += $(SATURNHOME)/util/gzstr +endif + +PROJECT_CMODULES = $(CVCL_CMODULES) $(YICES_CMODULES) $(MINE_OCT_CMODULES) +EXT_PROJ_CMODS = $(SATURN_EXT_CMODS) + +PROJECT_LIBS = unix str cil nums + +ifeq (@USE_SATURN@, yes) + EXT_PROJ_MODS += vector prioqueue clpautil signal bdb libevent \ + flags streamio hashcons spec specio +endif + +# find the cil library +vpath %.$(CMXA) cil/obj/$(ARCHOS) + +# Make sure that the Deputy files depend on the CIL library +# Choose just one file on which everybody depends +$(OBJDIR)/doptions.$(CMO): cil.$(CMXA) +$(OBJDIR)/markptr.cmi $(OBJDIR)/ptrnode.cmi $(OBJDIR)/inferkinds.cmi: \ + cil/obj/$(ARCHOS)/cil.cmi + +$(PROJECT_EXECUTABLE) : $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC)) \ + cil.$(CMXA) + @$(NARRATIVE) "Linking $(COMPILETOWHAT) $@ $(LINKMSG)" + $(AT)$(CAMLLINK) -verbose -o $@ \ + $(PROJECT_LIBS:%=%.$(CMXA)) \ + $(EXT_PROJ_MODS:%=%.$(CMO)) \ + $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(EXT_PROJ_CMODS:%=%.$(OBJ)) \ + $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC)) \ + $(ENDLINKFLAGS) + +deputy: $(PROJECT_EXECUTABLE) + +# +# Deputy runtime library +# + +include cil/Makefile.gcc + +DEPUTY_LIBC = $(OBJDIR)/deputy_libc.$(OBJ) +DEPUTY_LIBC_DEBUG = $(OBJDIR)/deputy_libc_debug.$(OBJ) +DEPUTY_LINUX = $(OBJDIR)/deputy_linux.$(OBJ) + +#INSTR_LIB = $(OBJDIR)/instr_glob_state.$(OBJ) + +$(DEPUTY_LIBC): lib/deputy_libc.c include/deputy/checks.h + $(CC) $(CONLY) -g -O3 -D_GNUCC $(WARNALL) \ + $(INC)$(DEPUTYHOME)/include $(OBJOUT)$@ $< + +#$(INSTR_LIB): lib/instr_glob_state.c +# $(CC) $(CONLY) -g -O3 -D_GNUCC $(WARNALL) \ +# `oct-config --cflags` $(INC)$(DEPUTYHOME)/include $(OBJOUT)$@ $< + +ifeq (@USE_LINUX@, yes) # USE_LINUX +LINUX_DIR = @LINUX_DIR@ +$(DEPUTY_LINUX): lib/deputy_linux.c + $(CC) -O -g -D__KERNEL__ \ + -I$(LINUX_DIR)/include \ + -I$(LINUX_DIR)/include/asm-i386/mach-default \ + -Iinclude \ + -include $(LINUX_DIR)/include/linux/nodeputy.h \ + $(CONLY) $(OBJOUT)$@ $^ +else +$(DEPUTY_LINUX): lib/deputy_linux.c +endif + +deputylib: $(DEPUTY_LIBC) $(DEPUTY_LINUX) #$(INSTR_LIB) + +# +# Patched libc includes +# + +PATCH = $(DEPUTYHOME)/include/libc_patch.h +PATCH_PP = $(PATCH:.h=.i) + +$(PATCH_PP): $(PATCH) + $(CC) -E -include $(DEPUTYHOME)/include/deputy/annots.h -o $@ $^ + +.PHONY: patch +patch: $(PATCH_PP) + +# +# Testing and cleanup +# + +quicktest: + cd test/small && make runall/deref1 runall/infer1 && \ + echo && echo "*** Quicktest was successful" && echo + +clean: + rm -f $(OBJDIR)/*.* $(DEPENDDIR)/*.* + +realclean: cleancaml + cd cil && make clean + +# +# Distribution +# + +# Make a distribution that excludes certain files. We exclude the +# toplevel Makefile from here, since otherwise it's difficult to avoid +# excluding *all* Makefiles, which would be bad. +dist: realclean + cd .. && mv deputy deputy-$(DEPUTY_VERSION) && \ + tar zcvf deputy-$(DEPUTY_VERSION).tar.gz \ + --exclude-from deputy-$(DEPUTY_VERSION)/.distexclude \ + --exclude deputy-$(DEPUTY_VERSION)/Makefile \ + deputy-$(DEPUTY_VERSION) && \ + mv deputy-$(DEPUTY_VERSION) deputy + +# +# Documentation +# +# make doc - creates the documentation +# make publish_doc - creates the documentation and puts it on the web page +# + +doc/deputy.1.gz: doc/deputy.1 + gzip -c $< > $@ + +doc/deputypp.tex: doc/deputycode.pl doc/deputy.tex + -rm -rf doc/html/deputy + -mkdir doc/html/deputy + -mkdir doc/html/deputy/examples + cd doc; perl deputycode.pl deputy.tex deputypp.tex + +# Documentation generated from latex files using "hevea" +texdoc: doc/deputypp.tex +# Create the version document + cd doc/html/deputy; echo "\def\deputyversion{@DEPUTY_VERSION@}">deputy.version.tex + cd doc/html/deputy; hevea -exec xxdate.exe ../../deputypp + cd doc/html/deputy; hevea -exec xxdate.exe ../../deputypp + cd doc/html/deputy; mv deputypp.html deputy.html + cd doc/html/deputy; hacha -o deputytoc.html deputy.html + cp -f doc/index.html doc/html/deputy/index.html + cp -f doc/header.html doc/html/deputy + +pdfdoc: doc/deputypp.tex + cd doc; echo "\def\deputyversion{@DEPUTY_VERSION@}" >deputy.version.tex + cd doc; pdflatex deputypp.tex + cd doc; mv deputypp.pdf html/deputy/DEPUTY.pdf + +.PHONY: doc texdoc pdfdoc +doc: texdoc pdfdoc + +DEPUTY_HTML_DEST = /var/www/deputy +publish_distrib: publish_doc + +publish_doc: doc + if test -d $(DEPUTY_HTML_DEST); then \ + cp -rf doc/html/deputy/* $(DEPUTY_HTML_DEST); \ + echo "Done publishing doc"; \ + else \ + error "Cannot publish because $(DEPUTY_HTML_DEST) does not exist" ; \ + fi + +# +# Installation +# + +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ + +BINDISTRIB_BIN = bin/deputy $(OBJDIR)/deputy.asm.exe $(OBJDIR)/deputy.byte.exe +BINDISTRIB_LIB = lib/Deputy.pm cil/bin/CilConfig.pm cil/lib/Cilly.pm \ + cil/lib/KeptFile.pm cil/lib/TempFile.pm cil/lib/OutputFile.pm \ + $(OBJDIR)/deputy_libc.o +BINDISTRIB_INCLUDE = include/libc_patch.i +BINDISTRIB_INCLUDE_DEPUTY = include/deputy/annots.h include/deputy/checks.h + +BINDISTRIB_ALL = $(BINDISTRIB_BIN) $(BINDISTRIB_LIB) \ + $(BINDISTRIB_INCLUDE) $(BINDISTRIB_INCLUDE_DEPUTY) + +prefix = @prefix@ +exec_prefix = @exec_prefix@ +libdir = @libdir@ +pkglibdir = $(libdir)/deputy + +install-base: $(BINDISTRIB_ALL) + $(INSTALL) -d $(DESTDIR)$(prefix)/bin + $(INSTALL) -d $(DESTDIR)$(pkglibdir) + $(INSTALL) -d $(DESTDIR)$(pkglibdir)/bin + $(INSTALL) -d $(DESTDIR)$(pkglibdir)/lib + $(INSTALL) -d $(DESTDIR)$(pkglibdir)/include/deputy + $(INSTALL_PROGRAM) $(BINDISTRIB_BIN) $(DESTDIR)$(pkglibdir)/bin + $(INSTALL_DATA) $(BINDISTRIB_LIB) $(DESTDIR)$(pkglibdir)/lib + $(INSTALL_DATA) $(BINDISTRIB_INCLUDE) $(DESTDIR)$(pkglibdir)/include + $(INSTALL_DATA) $(BINDISTRIB_INCLUDE_DEPUTY) \ + $(DESTDIR)$(pkglibdir)/include/deputy + ln -sf ../lib/deputy/bin/deputy $(DESTDIR)$(prefix)/bin/deputy + +# We handle the man page separately, since Debian has its own utility +# for installing man pages, whereas RPM wants us to do it. + +BINDISTRIB_MAN = doc/deputy.1.gz + +install-man: $(BINDISTRIB_MAN) + $(INSTALL) -d $(DESTDIR)$(prefix)/man/man1 + $(INSTALL_DATA) $(BINDISTRIB_MAN) $(DESTDIR)$(prefix)/man/man1 + +# And now for normal users who want everything installed... + +install: install-base install-man + +# +# Install the web interface +# + +installweb: all $(DEPUTY_HTML_DEST) +# Copy over the files needed for running Deputy + mkdir -p $(DEPUTY_HTML_DEST)/bin + cp bin/deputy $(DEPUTY_HTML_DEST)/bin + mkdir -p $(DEPUTY_HTML_DEST)/cil + mkdir -p $(DEPUTY_HTML_DEST)/cil/bin +# Now copy over CilConfig.pm but change the directory names + cat cil/bin/CilConfig.pm \ + | sed -e 's|@DEPUTYHOME@|$(DEPUTY_HTML_DEST)|g' \ + >$(DEPUTY_HTML_DEST)/cil/bin/CilConfig.pm + + mkdir -p $(DEPUTY_HTML_DEST)/obj/@ARCHOS@ + cp $(foreach f, deputy.asm.exe deputy_libc.o, \ + obj/@ARCHOS@/$(f)) \ + $(DEPUTY_HTML_DEST)/obj/@ARCHOS@ + + mkdir -p $(DEPUTY_HTML_DEST)/cil/lib + cp $(foreach f, Cilly.pm KeptFile.pm \ + TempFile.pm OutputFile.pm, \ + cil/lib/$(f)) \ + $(DEPUTY_HTML_DEST)/cil/lib + + mkdir -p $(DEPUTY_HTML_DEST)/lib + cp lib/Deputy.pm $(DEPUTY_HTML_DEST)/lib + + mkdir -p $(DEPUTY_HTML_DEST)/include + cp -r include $(DEPUTY_HTML_DEST) + + mkdir -p $(DEPUTY_HTML_DEST)/web/tmp + chmod a+wx $(DEPUTY_HTML_DEST)/web/tmp + cp $(foreach f, .htaccess web-driver.cgi index.html, \ + web/$(f)) \ + $(DEPUTY_HTML_DEST)/web + chmod a+x $(DEPUTY_HTML_DEST)/web/web-driver.cgi + + mkdir -p $(DEPUTY_HTML_DEST)/test/small + chmod a+w $(DEPUTY_HTML_DEST)/test/small + cp $(foreach f, array2.c, \ + test/small/$(f)) \ + $(DEPUTY_HTML_DEST)/test/small diff --git a/bin/.cvsignore b/bin/.cvsignore new file mode 100755 index 0000000..29da440 --- /dev/null +++ b/bin/.cvsignore @@ -0,0 +1,2 @@ +DeputyConfig.pm +patcher.bat diff --git a/bin/deputy b/bin/deputy new file mode 100755 index 0000000..a6598ea --- /dev/null +++ b/bin/deputy @@ -0,0 +1,60 @@ +#!/usr/bin/perl +# +# Copyright (c) 2006, +# George C. Necula +# Jeremy Condit +# Matt Harren +# 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 main driver for the Deputy system. +# + +use strict; + +use FindBin; +use lib "$FindBin::RealBin/../lib"; +use lib "$FindBin::RealBin/../cil/bin"; +use lib "$FindBin::RealBin/../cil/lib"; + +use CilConfig; +use Deputy; + +$::deputyhome = "$FindBin::RealBin/.."; + +# Now force the libc patch. +if (! grep { $_ eq "--linux" } @ARGV) { + push @ARGV, "--patch=$::deputyhome/include/libc_patch.i"; +} + +Deputy->new(@ARGV)->doit(); + +exit(0); diff --git a/cil/.cvsignore b/cil/.cvsignore new file mode 100644 index 0000000..28a8517 --- /dev/null +++ b/cil/.cvsignore @@ -0,0 +1,38 @@ +camlprim0.obj +*.a +*.o +*.obj +*.i +*.pdb +*.s +*.asm +*.out +allheaders +allcfiles +allmlfiles +.emacs.desktop +out +site-config.mk +__scalar2pointer.txt +*.log +tmp* +*.log.prev +make.out* +odoc +Makefile +Makefile.features +config.status +*.tar.gz +.ccuredrc +allsrcs +TEMP_cil-distrib +TEMP_ccured_distrib +.gdbinit +autom4te*.cache +config.h +cil.spec +cvss.txt +configure.lineno +confstat* +config.mk +TEMP_cil-bindistrib diff --git a/cil/Bootstrap b/cil/Bootstrap new file mode 100755 index 0000000..08bf15c --- /dev/null +++ b/cil/Bootstrap @@ -0,0 +1,3 @@ +#!/bin/sh -x + +autoconf 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..698cec0 --- /dev/null +++ b/cil/LICENSE @@ -0,0 +1,36 @@ +Copyright (c) 2001-2007, + George C. Necula + Scott McPeak + Wes Weimer + Ben Liblit + Matt Harren +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..f92ba0b --- /dev/null +++ b/cil/Makefile.in @@ -0,0 +1,663 @@ +# -*- 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 +include Makefile.features + + +# 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 aclocal.m4 + 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_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 longarray growArray\ + cabs cabshelper cabsvisit whitetrack cprint lexerhack machdep machdepenv 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 expcompare\ + cfg liveness reachingdefs deadcodeelim availexps \ + availexpslv predabst\ + 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 = perfcount +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 + +BEFOREDEPS += $(OBJDIR)/machdep.ml +BEFOREDEPS += $(OBJDIR)/cilversion.ml +BEFOREDEPS += $(OBJDIR)/feature_config.ml + + # Include now the common set of rules for OCAML +include ocamlutil/Makefile.ocaml + + + # Now the rule to make cilly + +cilly: $(OBJDIR)/cilly$(EXE) +$(OBJDIR)/cilly$(EXE) : $(CILLY_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(CILLY_CMODULES:%=$(OBJDIR)/%.$(CMC)) + @$(NARRATIVE) "Linking $(COMPILETOWHAT) $@ $(LINKMSG)" + $(AT)$(CAMLLINK) -verbose -o $@ \ + $(CILLY_LIBS:%=%.$(CMXA)) \ + $(CILLY_LIBS:%=-cclib -l%) \ + $^ + + +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-ml.c configure.in Makefile.in + rm -f $@ + mkdir -p $(OBJDIR) + echo "(* This module was generated automatically by code in Makefile and $($@ +# 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; (* gcc version string *)" >> $@ + 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_void: int; (* Size of \"void\" *)" >> $@ + echo " sizeof_fun: int; (* Size of function *)" >> $@ + echo " size_t: string; (* Type of \"sizeof(T)\" *)" >> $@ + echo " wchar_t: string; (* Type of \"wchar_t\" *)" >> $@ + 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 " alignof_aligned: int; (* Alignment of anything with the \"aligned\" attribute *)" >> $@ + 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 " __thread_is_keyword: bool; (* whether __thread is a keyword *)">>$@ + echo " __builtin_va_list: bool; (* whether __builtin_va_list is builtin (gccism) *)">>$@ + echo "}" >> $@ + if gcc -D_GNUCC $< -o $(OBJDIR)/machdep-ml.exe ;then \ + echo "machdep-ml.exe created succesfully." \ + ;else \ + rm -f $@; exit 1 \ + ;fi + echo "let gcc = {" >>$@ + $(OBJDIR)/machdep-ml.exe >>$@ + echo " underscore_name = @UNDERSCORE_NAME@ ;" >> $@ + echo " __builtin_va_list = @HAVE_BUILTIN_VA_LIST@ ;" >>$@ + echo " __thread_is_keyword = @THREAD_IS_KEYWORD@ ;" >>$@ + echo "}" >>$@ + if cl /D_MSVC $< /Fe$(OBJDIR)/machdep-ml.exe /Fo$(OBJDIR)/machdep-ml.obj ;then \ + echo "let hasMSVC = true" >>$@ \ + ;else \ + echo "let hasMSVC = false" >>$@ ;fi + echo "let msvc = {" >>$@ + $(OBJDIR)/machdep-ml.exe >>$@ + echo " underscore_name = true ;" >> $@ + echo " __builtin_va_list = @HAVE_BUILTIN_VA_LIST@ ;" >>$@ + echo " __thread_is_keyword = @THREAD_IS_KEYWORD@ ;" >>$@ + echo "}" >>$@ + echo "let theMachine : mach ref = ref gcc" >>$@ + + +# +# Create the version information module +.PHONY: cilversion +cilversion: $(OBJDIR)/cilversion.ml +$(OBJDIR)/cilversion.ml: src/cilversion.ml.in config.status + rm -f $@ + ./config.status --file=$@:$< + +# 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: 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_ZRAPP + echo " Zrapp.feature;" >> $@ +endif +# Now the extra features, with the first letter capitalized + echo -n " (* EXTRAFEATURES: *)" >> $@ + echo \ + $(foreach f,@EXTRAFEATURES@, \ + "\n "`echo $f | cut -c 1 | tr "[a-z]" "[A-Z]"``echo $f | cut -c 2-`".feature;") \ + | perl -pe 's/\\n/\n/g' >> $@ + echo "]" >>$@ + + + + + + +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 $@ $(CILLY_LIBS:%=%.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 + +ODOC_FILES = 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 + + +# Documentation generated by "ocamldoc" +odoc: $(OBJDIR)/pretty.cmi $(OBJDIR)/cil.cmi + -rm -rf doc/html/cil/api doc/html/cil/api-latex + -mkdir -p doc/html/cil/api + -mkdir -p 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) -hide Pervasives $(ODOC_FILES) + +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) -hide Pervasives $(ODOC_FILES) + + 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 + + +# You should usually run this twice to get all of the references linked +# correctly. +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 config.mk.in Makefile.gcc Makefile.msvc \ + configure configure.in install-sh config.guess config.sub \ + cil.spec cil.spec.in \ + _tags \ + aclocal.m4 \ + cil.itarget \ + cil.odocl \ + myocamlbuild.ml + +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-ml.c \ + ciloptions.ml ciloptions.mli libmaincil.ml \ + escape.ml escape.mli cillower.mli cillower.ml \ + _tags \ + cil.mllib \ + cilversion.ml.in + +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 \ + longarray.ml longarray.mli \ + growArray.ml growArray.mli \ + bitmap.ml bitmap.mli \ + perfcount.c.in Makefile.ocaml \ + _tags + + +DISTRIB_SRC_FRONTC = cabs.ml cabshelper.ml cprint.ml clexer.mli clexer.mll \ + cparser.mly whitetrack.mli whitetrack.ml 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 \ + deadcodeelim.ml availexps.ml \ + dataflow.ml dataflow.mli \ + dominators.ml dominators.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 \ + _tags \ + reachingdefs.ml \ + cfg.ml cfg.mli \ + liveness.ml \ + expcompare.ml \ + availexpslv.ml \ + predabst.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)/bin \ + $(TOP_DIR)/doc \ + $(TOP_DIR)/doc/api \ + $(TOP_DIR)/debian \ + $(TOP_DIR)/lib \ + $(TOP_DIR)/obj \ + $(TOP_DIR)/obj/.depend \ + $(TOP_DIR)/src \ + $(TOP_DIR)/src/frontc \ + $(TOP_DIR)/src/ext \ + $(TOP_DIR)/src/ext/pta \ + $(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 + cp debian/* $(TOP_DIR)/debian + +# Delete all Subversion metadata directories + find $(TEMP_DIR) -name .svn -print0 | xargs --null --no-run-if-empty rm -rf + +# 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 + + +# 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@ +datarootdir = @datarootdir@ +libdir = @libdir@ +pkglibdir = $(libdir)/cil +datadir = @datadir@ +pkgdatadir = $(datadir)/cil + +all_distrib := $(DISTRIB_OCAMLUTIL) $(DISTRIB_SRC) $(DISTRIB_SRC_FRONTC) $(DISTRIB_SRC_EXT) $(DISTRIB_SRC_EXT_PTA) +all_ml := $(filter %.ml, $(all_distrib)) +all_mli := $(filter %.mli, $(all_distrib)) +install_ml := $(filter $(OCAML_CIL_LIB_MODULES:=.ml), $(all_ml)) +install_cmx := $(install_ml:%.ml=$(OBJDIR)/%.cmx) +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_cmx) $(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/NOTES b/cil/NOTES new file mode 100644 index 0000000..6b9309b --- /dev/null +++ b/cil/NOTES @@ -0,0 +1,86 @@ + +TODO list + + +CIL +------ + +Front-end + - trigraph sequences (??:, ...) ISO 5.2.1.1 + - name spaces for struct/enum/union are the same ISO 6.2.3 + - check integer conversion ISO 6.3.1.1 + - character constants (type, value, escapes) ISO 6.4.4.4 + - string literals (value, escapes) ISO 6.4.5 + - punctuation tokens ISO 6.4.6 + - default argument promotions in function calls ISO 6.5.2.2 + - compound literals ISO 6.5.2.5. Missing fields initialized to 0!! + - check that long long is properly done in type specs ISO 6.7.2 + - Initialization ISO 6.7.8 + +- MSVC has a bug in the handling of shift operators: arithemtic conversions +are applies on both operands instead of just integral promotions. We duplicate +this bug in doBinOp in cabs2cil. + + - we should allow the user to specify a logging function that takes + printf()-style arguments (rather than hardcoding syslog/printk/printf). + + - the restrict attribute is dropped in cabs2cil + + - struct and union must share the name space + + - when merging we use too much memory. We should be droping the references to + the CABS files once we convert each one to CIL. + +CCURED +============== + + - if we use memcpy to copy some stuff from local variables to the heap we + might be moving stack pointers that way. The only way to prevent that is to + disallow storing stack pointers in local variables that are arrays or whose + address is taken. + + - in box.ml offsetOfFirstScalar looks only at the first field of a union. + + - in box.ml when we check tags we check all fields in a union. This is sound + but excessive. + +(2) Make a file with global declarations of common functions like strcpy(). + These declarations should include pointer annotations and should be + used instead of the ones that appear in the source. +?(9) Find some way to describe [recursive] types at runtime and use them as + tags. + + + - on MSVC we turn on 32-bit packing of stuff + + - Writing or reading unaligned pointers is not allowed. + + - Right now when we try to read a pointer and we don't find one in tags, we + overwrite the base part of the pointer to be read with 0. But this might + have undesired side-effects. + + - I wonder what do we do when casting between abstract types (struct foo * + where struct foo is not defined) + + - change CHECK_RETURNPTR and CHECK_STOREPTR so that the range checked + is 512K (instead of 1 meg) for Linux Kernel Drivers. + + - add a flag that effectively puts #pragma box(off) / #pragma box(on) + around all global initializers in a file. + + + - turning interface char* into ROSTRING is unsound. This is done even when + the item is subject to writes. + + - printf is not quite safe. If we do not manage to verify statically the + arguments we should be calling a wrapper. Do we do that? + + - in a SEQ pointer we must keep the end = null if the poiner is an integer. + Else there is trouble when we cast to FSEQ. Can we cast integers into FSEQ? + + + - sm: because wild area lengths have word-level granularity, we can't protect + the final 0 of a char array unless the alignment works out; solutions + include changing granularity to bytes (painful) or changing the array- + expander to ensure alignment (potentially wasteful of a few bytes here + and there) 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/_tags b/cil/_tags new file mode 100644 index 0000000..909e08c --- /dev/null +++ b/cil/_tags @@ -0,0 +1,3 @@ +# subdirectories containing source code +"ocamlutil": include +"src": include diff --git a/cil/aclocal.m4 b/cil/aclocal.m4 new file mode 100644 index 0000000..28fde84 --- /dev/null +++ b/cil/aclocal.m4 @@ -0,0 +1,69 @@ +dnl check whether integer types $1 and $2 are the same + +AC_DEFUN([__CIL_CHECK_INTEGER_TYPE_TYPE], [ + if test -z "$real_type"; then + AC_COMPILE_IFELSE(AC_LANG_SOURCE([ +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +$2 foo($2 x); +$1 foo($1 x) { return x; }]), + real_type='$2') + fi +]) + + +dnl check whether integer type $1 is the +dnl the signed or unsigned variant of $2 + +AC_DEFUN([__CIL_CHECK_INTEGER_TYPE_SIGNS], [ + __CIL_CHECK_INTEGER_TYPE_TYPE([$1], [$2]) + __CIL_CHECK_INTEGER_TYPE_TYPE([$1], [unsigned $2]) +]) + + +dnl set configuration macro $2 to a string representing +dnl the real integer type corresponding to typedef $1 + +AC_DEFUN([CIL_CHECK_INTEGER_TYPE], [ + AC_MSG_CHECKING([for real definition of $1]) + real_type='' + __CIL_CHECK_INTEGER_TYPE_SIGNS([$1], int) + __CIL_CHECK_INTEGER_TYPE_SIGNS([$1], long) + __CIL_CHECK_INTEGER_TYPE_SIGNS([$1], short) + __CIL_CHECK_INTEGER_TYPE_SIGNS([$1], char) + if test -z "$real_type"; then + AC_MSG_ERROR([cannot find definition of $1]) + fi + AC_DEFINE_UNQUOTED([$2], "[$real_type]") + AC_MSG_RESULT([$real_type]) +]) + + +# 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 + +# CIL_CONFIG_FILES(filename) +# do AC_CONFIG_FILES(filename, chmod a-w filename) +define([CIL_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([CIL_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 +}]) diff --git a/cil/bin/.cvsignore b/cil/bin/.cvsignore new file mode 100644 index 0000000..abf1dea --- /dev/null +++ b/cil/bin/.cvsignore @@ -0,0 +1,5 @@ +scaninfer.bat +ccured.bat +cilly.bat +patcher.bat +CilConfig.pm \ No newline at end of file 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/cabsxform b/cil/bin/cabsxform new file mode 100755 index 0000000..11bac73 --- /dev/null +++ b/cil/bin/cabsxform @@ -0,0 +1,16 @@ +#!/bin/sh +# apply my CABS transformer to a file + +if [ "$3" = "" ]; then + echo "usage: $0 [-debug] input.c patch.xform output.c" + exit 0 +fi + +args="" +if [ "$1" = "-debug" ]; then + args="--tr sm,patch,patchDebug,patchTime" + shift +fi + +exec `dirname $0`/../obj/x86_LINUX/cilly.byte.exe $args \ + --cabsonly "$3" --patchFile "$2" "$1" 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 +# Scott McPeak +# Wes Weimer +# 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 <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..5325ed1 --- /dev/null +++ b/cil/bin/patcher @@ -0,0 +1,630 @@ +#!/usr/bin/perl +# A Perl script that patches a bunch of files +# +# +# +# Copyright (c) 2001-2002, +# George C. Necula +# Scott McPeak +# Wes Weimer +# 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 <) + + --clean Remove all files in the destination directory + --skipmissing Skip patches for files whose original cannot be found + --stdoutpp For MSVC only, use the "preprocess to stdout" mode. This + is for some versions of MSVC that do not support + well the /P file + --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 + "--stdoutpp", # pp to stdout + "--skipmissing", + "--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() { + # 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() { + 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 "GNUCC" || $option{mode} eq "MSVC") { + return "#line $lineno \"$fileName\"\n"; + } + if($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") { + if($option{stdoutpp}) { + $preproccmd = "cl /nologo /E $ppargs >$preprocfile.i"; + } else { + $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() { + if($_ =~ m|^\#.+\"(.+$fname)\"|) { + $absname = $1; + last; + } + } + close(PPOUT); + unlink "$preprocfile.c"; + unlink "$preprocfile.i"; + + # Did we find the original file? + if($absname eq "") { + if($option{skipmissing}) { + # Skip this file, mkaing all relevant patches optional + print " Original header file not found; skipping...\n"; + foreach my $patch (@patches) { + my $infile = $patch->{FLAGS}->{file}; + if(defined $infile && $fname =~ m|$infile$|) { + $patch->{FLAGS}->{optional} = 1; + } + } + return; + } else { + die "Cannot find the absolute name of $fname1 in $preprocfile.i\n"; + } + } + + # 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 = ; + 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() { + $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 + $_ = ; + $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() { + $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() { + $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 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.itarget b/cil/cil.itarget new file mode 100644 index 0000000..3ccdede --- /dev/null +++ b/cil/cil.itarget @@ -0,0 +1,2 @@ +doc/cil.otarget +src/cil.otarget diff --git a/cil/cil.spec.in b/cil/cil.spec.in new file mode 100644 index 0000000..a3b97bb --- /dev/null +++ b/cil/cil.spec.in @@ -0,0 +1,90 @@ +Name: cil +Version: @CIL_VERSION@ +Release: 1 +License: BSD +URL: http://hal.cs.berkeley.edu/cil/ +Source0: %{name}-%{version}.tar.gz +BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-buildroot +BuildRequires: gcc +BuildRequires: hevea +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 +make cilversion machdep +make cillib NATIVECAML= +make cillib NATIVECAML=1 + +%install +rm -rf $RPM_BUILD_ROOT +make DESTDIR=%buildroot install + +%clean +rm -rf $RPM_BUILD_ROOT + + +%changelog +* Tue Aug 5 2003 Ben Liblit +- Initial build. diff --git a/cil/config.guess b/cil/config.guess new file mode 100755 index 0000000..4bf27fc --- /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 . +# Please send patches to . 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 ." + +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 /* 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 + + 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 + #include + + 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 + 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 + #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' /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 + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # 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 < +# include +#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 + 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 +# 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 < 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..9a2fe39 --- /dev/null +++ b/cil/config.h.in @@ -0,0 +1,27 @@ +#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 + +#undef TYPE_SIZE_T + +#undef TYPE_WCHAR_T diff --git a/cil/config.mk.in b/cil/config.mk.in new file mode 100644 index 0000000..879885e --- /dev/null +++ b/cil/config.mk.in @@ -0,0 +1,6 @@ +# A bunch of variables -*- Mode: makefile -*- +export ARCHOS=@ARCHOS@ +export HAS_MSVC=@HAS_MSVC@ +export CILHOME=@CILHOME@ +export DEFAULT_COMPILER=@DEFAULT_COMPILER@ +export @DEFAULT_COMPILER@=1 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 . 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 ." + +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..f6e6b21 --- /dev/null +++ b/cil/configure @@ -0,0 +1,7005 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.61. +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006 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 more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# 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 + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +as_nl=' +' +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +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 +IFS=$as_save_IFS + + ;; +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_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +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) >/dev/null 2>&1 && $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; 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'` + +# CDPATH. +$as_unset CDPATH + + +if test "x$CONFIG_SHELL" = x; then + if (eval ":") 2>/dev/null; then + as_have_required=yes +else + as_have_required=no +fi + + if test $as_have_required = yes && (eval ": +(as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=\$LINENO + as_lineno_2=\$LINENO + test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && + test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } +") 2> /dev/null; then + : +else + as_candidate_shells= + 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=. + case $as_dir in + /*) + for as_base in sh bash ksh sh5; do + as_candidate_shells="$as_candidate_shells $as_dir/$as_base" + done;; + esac +done +IFS=$as_save_IFS + + + for as_shell in $as_candidate_shells $SHELL; do + # Try only shells that exist, to save several forks. + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { ("$as_shell") 2> /dev/null <<\_ASEOF +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +_ASEOF +}; then + CONFIG_SHELL=$as_shell + as_have_required=yes + if { "$as_shell" 2> /dev/null <<\_ASEOF +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +(as_func_return () { + (exit $1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = "$1" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test $exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } + +_ASEOF +}; then + break +fi + +fi + + done + + if test "x$CONFIG_SHELL" != x; then + for as_var in BASH_ENV ENV + do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var + done + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} +fi + + + if test $as_have_required = no; then + echo This script requires a shell more modern than all the + echo shells that I found on your system. Please install a + echo modern shell, or manually run the script under such a + echo shell if you do have one. + { (exit 1); exit 1; } +fi + + +fi + +fi + + + +(eval "as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0") || { + echo No shell found that supports shell functions. + echo Please tell autoconf@gnu.org about your system, + echo including any error possibly output before this + echo message +} + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # 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 after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, 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 + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\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 sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir +fi +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' +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$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# 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'" + + + +exec 7<&0 &1 + +# 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` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# 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 +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='SHELL +PATH_SEPARATOR +PACKAGE_NAME +PACKAGE_TARNAME +PACKAGE_VERSION +PACKAGE_STRING +PACKAGE_BUGREPORT +exec_prefix +prefix +program_transform_name +bindir +sbindir +libexecdir +datarootdir +datadir +sysconfdir +sharedstatedir +localstatedir +includedir +oldincludedir +docdir +infodir +htmldir +dvidir +pdfdir +psdir +libdir +localedir +mandir +DEFS +ECHO_C +ECHO_N +ECHO_T +LIBS +build_alias +host_alias +target_alias +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 +GREP +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='' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# 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. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +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 + + case $ac_option in + *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -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) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$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 ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -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'` + 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 ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$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 ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + 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 ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$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'` + 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; }; } + 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 directory names. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; } +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 + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + { echo "$as_me: error: Working directory cannot be determined" >&2 + { (exit 1); exit 1; }; } +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + { echo "$as_me: error: pwd does not report name of working directory" >&2 + { (exit 1); exit 1; }; } + + +# 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 the parent directory. + ac_confdir=`$as_dirname -- "$0" || +$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 + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 + { (exit 1); exit 1; }; } + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# 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 \`..'] + +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] + --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] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_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-zrapp enable the zrapp pretty-printer + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + 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 +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested 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 + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +configure +generated by GNU Autoconf 2.61 + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006 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 +fi +cat >config.log <<_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.61. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +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` +/usr/bin/hostinfo = `(/usr/bin/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 +IFS=$as_save_IFS + +} >&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_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_arg'" + ;; + 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: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +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, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 +echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + *) $as_unset $ac_var ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------------- ## +## File substitutions. ## +## ------------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r 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 -f -r conftest* 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 -n "$CONFIG_SITE"; then + set x "$CONFIG_SITE" +elif test "x$prefix" != xNONE; then + set x "$prefix/share/config.site" "$prefix/etc/config.site" +else + set x "$ac_default_prefix/share/config.site" \ + "$ac_default_prefix/etc/config.site" +fi +shift +for ac_site_file +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 $ac_precious_vars; 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=6 +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&5 +echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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.exe + 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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.exe +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&5 +echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +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` +{ (ac_try="$ac_compiler --version >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compiler --version >&5") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -v >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compiler -v >&5") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -V >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compiler -V >&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[^ ]*//'` +# +# List of possible output files, starting from the most likely. +# The algorithm is not robust to junk in `.', hence go to wildcards (a.*) +# only as a last resort. b.out is created by i960 compilers. +ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' +# +# The IRIX 6 linker writes into existing files which may not be +# executable, retaining their permissions. Remove them first so a +# subsequent execution test works. +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { (ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi + +{ echo "$as_me:$LINENO: result: $ac_file" >&5 +echo "${ECHO_T}$ac_file" >&6; } +if test -z "$ac_file"; then + 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 + +# Check that 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' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 that 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 { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 | *.map | *.inf | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; + *) 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 +{ 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 + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + CFLAGS="" + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +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 ISO C89" >&5 +echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } +if test "${ac_cv_prog_cc_c89+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_prog_cc_c89=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 +#include +#include +#include +/* 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 -std 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 -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 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 +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_c89=$ac_arg +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { echo "$as_me:$LINENO: result: none needed" >&5 +echo "${ECHO_T}none needed" >&6; } ;; + xno) + { echo "$as_me:$LINENO: result: unsupported" >&5 +echo "${ECHO_T}unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; +esac + + +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 + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# 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 { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + + +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. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + 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. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + { { echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5 +echo "$as_me: error: cannot run $SHELL $ac_aux_dir/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_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + { { 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=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5 +echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_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; } +case $ac_cv_build in +*-*-*) ;; +*) { { echo "$as_me:$LINENO: error: invalid value of canonical build" >&5 +echo "$as_me: error: invalid value of canonical build" >&2;} + { (exit 1); exit 1; }; };; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ 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 + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5 +echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;} + { (exit 1); exit 1; }; } +fi + +fi +{ echo "$as_me:$LINENO: result: $ac_cv_host" >&5 +echo "${ECHO_T}$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) { { echo "$as_me:$LINENO: error: invalid value of canonical host" >&5 +echo "$as_me: error: invalid value of canonical host" >&2;} + { (exit 1); exit 1; }; };; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +{ 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 + if test "x$target_alias" = x; then + ac_cv_target=$ac_cv_host +else + ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` || + { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&5 +echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&2;} + { (exit 1); exit 1; }; } +fi + +fi +{ echo "$as_me:$LINENO: result: $ac_cv_target" >&5 +echo "${ECHO_T}$ac_cv_target" >&6; } +case $ac_cv_target in +*-*-*) ;; +*) { { echo "$as_me:$LINENO: error: invalid value of canonical target" >&5 +echo "$as_me: error: invalid value of canonical target" >&2;} + { (exit 1); exit 1; }; };; +esac +target=$ac_cv_target +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_target +shift +target_cpu=$1 +target_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +target_os=$* +IFS=$ac_save_IFS +case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac + + +# 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=10 +{ 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() { + if($_ =~ m|sub file_name_is_absolute|) { + print OUT $_; + print OUT scalar(); + print OUT <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 +# +# At runtime, we'll try to get the cycle speed from /proc/cpuinfo +# or FreeBSD sysctl. This means binaries can be moved to different computers. +# CYCLES_PER_USEC is only a backup in case these aren't available. +# (See the subversion history for the old code that read /proc/cpuinfo here.) +{ 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 test "$CYCLES_PER_USEC" != "0" ;then + 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 to if __STDC__ is defined, since + # 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 +#else +# include +#endif + Syntax error +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.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 nonexistent 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 +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.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 to if __STDC__ is defined, since + # 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 +#else +# include +#endif + Syntax error +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.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 nonexistent 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 +_ACEOF +if { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.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 grep that handles long lines and -e" >&5 +echo $ECHO_N "checking for grep that handles long lines and -e... $ECHO_C" >&6; } +if test "${ac_cv_path_GREP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + # Extract the first word of "grep ggrep" to use in msg output +if test -z "$GREP"; then +set dummy grep ggrep; ac_prog_name=$2 +if test "${ac_cv_path_GREP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_path_GREP_found=false +# Loop through the user's path and test for each of PROGNAME-LIST +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue + # Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + ac_count=`expr $ac_count + 1` + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + + $ac_path_GREP_found && break 3 + done +done + +done +IFS=$as_save_IFS + + +fi + +GREP="$ac_cv_path_GREP" +if test -z "$GREP"; then + { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 +echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} + { (exit 1); exit 1; }; } +fi + +else + ac_cv_path_GREP=$GREP +fi + + +fi +{ echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5 +echo "${ECHO_T}$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ echo "$as_me:$LINENO: checking for egrep" >&5 +echo $ECHO_N "checking for egrep... $ECHO_C" >&6; } +if test "${ac_cv_path_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_path_EGREP="$GREP -E" + else + # Extract the first word of "egrep" to use in msg output +if test -z "$EGREP"; then +set dummy egrep; ac_prog_name=$2 +if test "${ac_cv_path_EGREP+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_path_EGREP_found=false +# Loop through the user's path and test for each of PROGNAME-LIST +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue + # Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + echo $ECHO_N "0123456789$ECHO_C" >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + ac_count=`expr $ac_count + 1` + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + + $ac_path_EGREP_found && break 3 + done +done + +done +IFS=$as_save_IFS + + +fi + +EGREP="$ac_cv_path_EGREP" +if test -z "$EGREP"; then + { { echo "$as_me:$LINENO: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5 +echo "$as_me: error: no acceptable $ac_prog_name could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;} + { (exit 1); exit 1; }; } +fi + +else + ac_cv_path_EGREP=$EGREP +fi + + + fi +fi +{ echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5 +echo "${ECHO_T}$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_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 +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 + +_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 + +_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 +#include +#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)) + return 2; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 core.conftest.* 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 { as_var=$as_ac_Header; eval "test \"\${$as_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. */ +$ac_includes_default + +#include <$ac_header> +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +ac_res=`eval echo '${'$as_ac_Header'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&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 +typedef __builtin_va_list ac__type_new_; +int +main () +{ +if ((ac__type_new_ *) 0) + return 0; +if (sizeof (ac__type_new_)) + return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; then + UNDERSCORE_NAME=true +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + UNDERSCORE_NAME=false +fi + +rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + 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 +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 + +_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 + +_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 +#include +#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)) + return 2; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 core.conftest.* 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 { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + { echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +ac_res=`eval echo '${'$as_ac_Header'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 { (ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.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;} + + ;; +esac +{ echo "$as_me:$LINENO: checking for $ac_header" >&5 +echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6; } +if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + eval "$as_ac_Header=\$ac_header_preproc" +fi +ac_res=`eval echo '${'$as_ac_Header'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&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 cs; + /* SunOS 4.1.1 cc rejects this. */ + char const *const *pcpcc; + char **ppc; + /* 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"; + pcpcc = &g + (g ? g-g : 0); + /* HPUX 7.0 cc rejects these. */ + ++pcpcc; + ppc = (char**) pcpcc; + pcpcc = (char const *const *) ppc; + { /* SCO 3.2v4 cc rejects this. */ + char *t; + char const *s = 0 ? (char *) 0 : (char const *) 0; + + *t++ = 0; + if (s) return 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; + if (!foo) return 0; + } + return !cs[0] && !zero.x; +#endif + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_c_inline=$ac_kw +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$ac_cv_c_inline" != no && break +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 +#include +#include + +int +main () +{ +if ((struct tm *) 0) +return 0; + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 = '\100', c1 = '\200', c2 = '\201'; + if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0) + return 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) + return 1; + } + return 0; + } + + ; + return 0; +} +_ACEOF +rm -f conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && { ac_try='./conftest$ac_exeext' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 core.conftest.* 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 "* ) ;; + *) 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 { as_var=$as_ac_var; eval "test \"\${$as_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 declares $ac_func. + For example, HP-UX 11i 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 to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $ac_func + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +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 +#endif + +int +main () +{ +return $ac_func (); + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && + $as_test_x conftest$ac_exeext; 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 core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \ + conftest$ac_exeext conftest.$ac_ext +fi +ac_res=`eval echo '${'$as_ac_var'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&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 + + +# Find out the true definitions of some integer types + + { echo "$as_me:$LINENO: checking for real definition of size_t" >&5 +echo $ECHO_N "checking for real definition of size_t... $ECHO_C" >&6; } + real_type='' + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +int foo(int x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='int' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned int foo(unsigned int x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned int' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +long foo(long x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='long' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned long foo(unsigned long x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned long' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +short foo(short x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='short' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned short foo(unsigned short x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned short' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +char foo(char x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='char' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned char foo(unsigned char x); +size_t foo(size_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned char' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + { { echo "$as_me:$LINENO: error: cannot find definition of size_t" >&5 +echo "$as_me: error: cannot find definition of size_t" >&2;} + { (exit 1); exit 1; }; } + fi + cat >>confdefs.h <<_ACEOF +#define TYPE_SIZE_T "$real_type" +_ACEOF + + { echo "$as_me:$LINENO: result: $real_type" >&5 +echo "${ECHO_T}$real_type" >&6; } + + + { echo "$as_me:$LINENO: checking for real definition of wchar_t" >&5 +echo $ECHO_N "checking for real definition of wchar_t... $ECHO_C" >&6; } + real_type='' + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +int foo(int x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='int' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned int foo(unsigned int x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned int' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +long foo(long x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='long' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned long foo(unsigned long x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned long' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +short foo(short x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='short' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned short foo(unsigned short x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned short' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +char foo(char x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='char' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ + +#include +#include +/* We define a prototype with one type and the function with + another type. This will result in compilation error + unless the types are really identical. */ +unsigned char foo(unsigned char x); +wchar_t foo(wchar_t x) { return x; } +_ACEOF +rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + real_type='unsigned char' +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + + + if test -z "$real_type"; then + { { echo "$as_me:$LINENO: error: cannot find definition of wchar_t" >&5 +echo "$as_me: error: cannot find definition of wchar_t" >&2;} + { (exit 1); exit 1; }; } + fi + cat >>confdefs.h <<_ACEOF +#define TYPE_WCHAR_T "$real_type" +_ACEOF + + { echo "$as_me:$LINENO: result: $real_type" >&5 +echo "${ECHO_T}$real_type" >&6; } + + + +# ----------- platform-specific code ------------- +# $target is typically processor-vendor-os +case "$target" in + + *86*linux*) + { echo "$as_me:$LINENO: result: configuring for linux/x86" >&5 +echo "${ECHO_T}configuring for linux/x86" >&6; } + + ARCHOS=x86_LINUX + ;; + + *86*openbsd*) + { echo "$as_me:$LINENO: result: configuring for OpenBSD/x86" >&5 +echo "${ECHO_T}configuring for OpenBSD/x86" >&6; } + + ARCHOS=x86_OPENBSD + ;; + + *i386*freebsd*|*amd64*freebsd*) + + if test x"${ARCH}" = x""; then + ARCH=`uname -p` + fi + + { echo "$as_me:$LINENO: result: configuring for freebsd/${ARCH}" >&5 +echo "${ECHO_T}configuring for freebsd/${ARCH}" >&6; } + + ARCHOS=${ARCH}_FREEBSD + ;; + + + # Mac OS X + *86*darwin*) + { echo "$as_me:$LINENO: result: configuring for darwin/x86" >&5 +echo "${ECHO_T}configuring for darwin/x86" >&6; } + + ARCHOS=x86_DARWIN + ;; + + *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"` + # Try to use the Unix paths even on cygwin. The newest versions of make + # do not like colons in file names + CILHOME=`cygpath -u "$CILHOME"` + 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 amd64: FreeBSD + 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 amd64: FreeBSD + 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 { as_var=$as_ac_File; eval "test \"\${$as_var+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 +ac_res=`eval echo '${'$as_ac_File'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&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; } + + + +# +# CIL features +# +# + +# Set the defaults + + +# Give a space-separated list of features with the defaults +features="blockinggraph=no zrapp=no" + + +# Check whether --with-blockinggraph was given. +if test "${with_blockinggraph+set}" = set; then + withval=$with_blockinggraph; +fi + + +# Check whether --with-zrapp was given. +if test "${with_zrapp+set}" = set; then + withval=$with_zrapp; +fi + + +# Now add any features specified in the command-line + +features="$features $EXTRAFEATURES" + +rm -f Makefile.features +echo "# -*- Mode: makefile -*-">Makefile.features +echo "# This file was generated automatically by ./configure.in">>Makefile.features +echo "# We will not need this once configure supports multiline variables">>Makefile.features + +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" + f_up=`echo $f | tr a-z A-Z` + echo "export USE_$f_up=yes">>Makefile.features + fi +done +echo "TYPE_SIZE_T=\"$TYPE_SIZE_T\"" >>Makefile.features +echo "TYPE_WCHAR_T=\"$TYPE_WCHAR_T\"" >>Makefile.features +chmod -w Makefile.features + + +# ----------------- 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 .in to generate ; + +{ + 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, we kill variables containing newlines. +# 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. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 +echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + *) $as_unset $ac_var ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}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 "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + 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 "$as_me:$LINENO: updating cache $cache_file" >&5 +echo "$as_me: updating cache $cache_file" >&6;} + cat confcache >$cache_file + else + { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 +echo "$as_me: not updating unwritable cache $cache_file" >&6;} + 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}' + +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_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`echo "$ac_i" | sed "$ac_script"` + # 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 more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# 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 + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +as_nl=' +' +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +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 +IFS=$as_save_IFS + + ;; +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_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +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) >/dev/null 2>&1 && $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; 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'` + +# CDPATH. +$as_unset CDPATH + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # 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 after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, 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 + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\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 sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir +fi +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' +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$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# 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'" + + +exec 6>&1 + +# Save the log message, to keep $[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by $as_me, which was +generated by GNU Autoconf 2.61. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" + +_ACEOF + +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 and configuration settings, 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 ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.61, + with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2006 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +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 + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + echo "$ac_cs_version"; exit ;; + --debug | --debu | --deb | --de | --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;; + --he | --h) + # Conflict between --help and --header + { 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 ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { 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" + ac_need_defaults=false ;; + + 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 CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + CONFIG_SHELL=$SHELL + export CONFIG_SHELL + exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; + "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" ;; + + *) { { 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 against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= + trap 'exit_status=$? + { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$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 "./confXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +# +# Set up the sed scripts for 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 + +_ACEOF + + + +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + cat >conf$$subs.sed <<_ACEOF +SHELL!$SHELL$ac_delim +PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim +PACKAGE_NAME!$PACKAGE_NAME$ac_delim +PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim +PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim +PACKAGE_STRING!$PACKAGE_STRING$ac_delim +PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim +exec_prefix!$exec_prefix$ac_delim +prefix!$prefix$ac_delim +program_transform_name!$program_transform_name$ac_delim +bindir!$bindir$ac_delim +sbindir!$sbindir$ac_delim +libexecdir!$libexecdir$ac_delim +datarootdir!$datarootdir$ac_delim +datadir!$datadir$ac_delim +sysconfdir!$sysconfdir$ac_delim +sharedstatedir!$sharedstatedir$ac_delim +localstatedir!$localstatedir$ac_delim +includedir!$includedir$ac_delim +oldincludedir!$oldincludedir$ac_delim +docdir!$docdir$ac_delim +infodir!$infodir$ac_delim +htmldir!$htmldir$ac_delim +dvidir!$dvidir$ac_delim +pdfdir!$pdfdir$ac_delim +psdir!$psdir$ac_delim +libdir!$libdir$ac_delim +localedir!$localedir$ac_delim +mandir!$mandir$ac_delim +DEFS!$DEFS$ac_delim +ECHO_C!$ECHO_C$ac_delim +ECHO_N!$ECHO_N$ac_delim +ECHO_T!$ECHO_T$ac_delim +LIBS!$LIBS$ac_delim +build_alias!$build_alias$ac_delim +host_alias!$host_alias$ac_delim +target_alias!$target_alias$ac_delim +CC!$CC$ac_delim +CFLAGS!$CFLAGS$ac_delim +LDFLAGS!$LDFLAGS$ac_delim +CPPFLAGS!$CPPFLAGS$ac_delim +ac_ct_CC!$ac_ct_CC$ac_delim +EXEEXT!$EXEEXT$ac_delim +OBJEXT!$OBJEXT$ac_delim +INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim +INSTALL_SCRIPT!$INSTALL_SCRIPT$ac_delim +INSTALL_DATA!$INSTALL_DATA$ac_delim +build!$build$ac_delim +build_cpu!$build_cpu$ac_delim +build_vendor!$build_vendor$ac_delim +build_os!$build_os$ac_delim +host!$host$ac_delim +host_cpu!$host_cpu$ac_delim +host_vendor!$host_vendor$ac_delim +host_os!$host_os$ac_delim +target!$target$ac_delim +target_cpu!$target_cpu$ac_delim +target_vendor!$target_vendor$ac_delim +target_os!$target_os$ac_delim +CPP!$CPP$ac_delim +GREP!$GREP$ac_delim +EGREP!$EGREP$ac_delim +LIBOBJS!$LIBOBJS$ac_delim +ARCHOS!$ARCHOS$ac_delim +CILHOME!$CILHOME$ac_delim +HAS_MSVC!$HAS_MSVC$ac_delim +DEFAULT_COMPILER!$DEFAULT_COMPILER$ac_delim +DEFAULT_CIL_MODE!$DEFAULT_CIL_MODE$ac_delim +CIL_VERSION_MAJOR!$CIL_VERSION_MAJOR$ac_delim +CIL_VERSION_MINOR!$CIL_VERSION_MINOR$ac_delim +CIL_VERSION_REV!$CIL_VERSION_REV$ac_delim +CIL_VERSION!$CIL_VERSION$ac_delim +CYCLES_PER_USEC!$CYCLES_PER_USEC$ac_delim +HAS_PERFCOUNT!$HAS_PERFCOUNT$ac_delim +HAVE_BUILTIN_VA_LIST!$HAVE_BUILTIN_VA_LIST$ac_delim +THREAD_IS_KEYWORD!$THREAD_IS_KEYWORD$ac_delim +UNDERSCORE_NAME!$UNDERSCORE_NAME$ac_delim +EXTRAFEATURES!$EXTRAFEATURES$ac_delim +EXTRASRCDIRS!$EXTRASRCDIRS$ac_delim +LTLIBOBJS!$LTLIBOBJS$ac_delim +_ACEOF + + if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 80; then + break + elif $ac_last_try; then + { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` +if test -n "$ac_eof"; then + ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` + ac_eof=`expr $ac_eof + 1` +fi + +cat >>$CONFIG_STATUS <<_ACEOF +cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end +_ACEOF +sed ' +s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g +s/^/s,@/; s/!/@,|#_!!_#|/ +:n +t n +s/'"$ac_delim"'$/,g/; t +s/$/\\/; p +N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n +' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF +:end +s/|#_!!_#|//g +CEOF$ac_eof +_ACEOF + + +# 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 + +cat >>$CONFIG_STATUS <<\_ACEOF +fi # test -n "$CONFIG_FILES" + + +for ac_tag in :F $CONFIG_FILES :H $CONFIG_HEADERS +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 +echo "$as_me: error: Invalid tag $ac_tag." >&2;} + { (exit 1); exit 1; }; };; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 +echo "$as_me: error: cannot find input file: $ac_f" >&2;} + { (exit 1); exit 1; }; };; + esac + ac_file_inputs="$ac_file_inputs $ac_f" + done + + # 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. */ + configure_input="Generated from "`IFS=: + echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + fi + + case $ac_tag in + *:-:* | *:-) cat >"$tmp/stdin";; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$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'` + { as_dir="$ac_dir" + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$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'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 +echo "$as_me: error: cannot create directory $as_dir" >&2;} + { (exit 1); exit 1; }; }; } + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= + +case `sed -n '/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p +' $ac_file_inputs` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +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&@top_builddir@&$ac_top_builddir_sub&;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&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +$ac_datarootdir_hack +" $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&5 +echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&2;} + + rm -f "$tmp/stdin" + case $ac_file in + -) cat "$tmp/out"; rm -f "$tmp/out";; + *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; + esac + ;; + :H) + # + # CONFIG_HEADER + # +_ACEOF + +# Transform confdefs.h into a sed script `conftest.defines', that +# substitutes the proper values into config.h.in to produce config.h. +rm -f conftest.defines conftest.tail +# First, append a space to every undef/define line, to ease matching. +echo 's/$/ /' >conftest.defines +# Then, protect against being on the right side of a sed subst, or in +# an unquoted here document, in config.status. If some macros were +# called several times there might be several #defines for the same +# symbol, which is useless. But do not sort them, since the last +# AC_DEFINE must be honored. +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +# These sed commands are passed to sed as "A NAME B PARAMS C VALUE D", where +# NAME is the cpp macro being defined, VALUE is the value it is being given. +# PARAMS is the parameter list in the macro definition--in most cases, it's +# just an empty string. +ac_dA='s,^\\([ #]*\\)[^ ]*\\([ ]*' +ac_dB='\\)[ (].*,\\1define\\2' +ac_dC=' ' +ac_dD=' ,' + +uniq confdefs.h | + sed -n ' + t rset + :rset + s/^[ ]*#[ ]*define[ ][ ]*// + t ok + d + :ok + s/[\\&,]/\\&/g + s/^\('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/ '"$ac_dA"'\1'"$ac_dB"'\2'"${ac_dC}"'\3'"$ac_dD"'/p + s/^\('"$ac_word_re"'\)[ ]*\(.*\)/'"$ac_dA"'\1'"$ac_dB$ac_dC"'\2'"$ac_dD"'/p + ' >>conftest.defines + +# Remove the space that was appended to ease matching. +# Then replace #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. +# (The regexp can be short, since the line contains either #define or #undef.) +echo 's/ $// +s,^[ #]*u.*,/* & */,' >>conftest.defines + +# Break up conftest.defines: +ac_max_sed_lines=50 + +# First sed command is: sed -f defines.sed $ac_file_inputs >"$tmp/out1" +# Second one is: sed -f defines.sed "$tmp/out1" >"$tmp/out2" +# Third one will be: sed -f defines.sed "$tmp/out2" >"$tmp/out1" +# et cetera. +ac_in='$ac_file_inputs' +ac_out='"$tmp/out1"' +ac_nxt='"$tmp/out2"' + +while : +do + # Write a here document: + cat >>$CONFIG_STATUS <<_ACEOF + # First, check the format of the line: + cat >"\$tmp/defines.sed" <<\\CEOF +/^[ ]*#[ ]*undef[ ][ ]*$ac_word_re[ ]*\$/b def +/^[ ]*#[ ]*define[ ][ ]*$ac_word_re[( ]/b def +b +:def +_ACEOF + sed ${ac_max_sed_lines}q conftest.defines >>$CONFIG_STATUS + echo 'CEOF + sed -f "$tmp/defines.sed"' "$ac_in >$ac_out" >>$CONFIG_STATUS + ac_in=$ac_out; ac_out=$ac_nxt; ac_nxt=$ac_in + sed 1,${ac_max_sed_lines}d conftest.defines >conftest.tail + grep . conftest.tail >/dev/null || break + rm -f conftest.defines + mv conftest.tail conftest.defines +done +rm -f conftest.defines conftest.tail + +echo "ac_result=$ac_in" >>$CONFIG_STATUS +cat >>$CONFIG_STATUS <<\_ACEOF + if test x"$ac_file" != x-; then + echo "/* $configure_input */" >"$tmp/config.h" + cat "$ac_result" >>"$tmp/config.h" + 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 + rm -f $ac_file + mv "$tmp/config.h" $ac_file + fi + else + echo "/* $configure_input */" + cat "$ac_result" + fi + rm -f "$tmp/out12" + ;; + + + esac + + + case $ac_file$ac_mode in + "Makefile":F) chmod a-w Makefile ;; + "cil.spec":F) chmod a-w cil.spec ;; + "config.mk":F) chmod a-w config.mk ;; + "test/Makefile":F) chmod a-w test/Makefile ;; + "bin/cilly.bat":F) chmod a-w,a+x bin/cilly.bat ;; + "bin/patcher.bat":F) chmod a-w,a+x bin/patcher.bat ;; + "bin/CilConfig.pm":F) chmod a-w bin/CilConfig.pm ;; + "doc/index.html":F) chmod a-w doc/index.html ;; + "doc/header.html":F) chmod a-w doc/header.html ;; + "ocamlutil/perfcount.c":F) chmod a-w ocamlutil/perfcount.c ;; + + esac +done # for ac_tag + + +{ (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 </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=10 +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() { + if($_ =~ m|sub file_name_is_absolute|) { + print OUT $_; + print OUT scalar(); + print OUT <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 +# +# At runtime, we'll try to get the cycle speed from /proc/cpuinfo +# or FreeBSD sysctl. This means binaries can be moved to different computers. +# CYCLES_PER_USEC is only a backup in case these aren't available. +# (See the subversion history for the old code that read /proc/cpuinfo here.) +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 test "$CYCLES_PER_USEC" != "0" ;then + 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) + +# Find out the true definitions of some integer types +CIL_CHECK_INTEGER_TYPE(size_t, TYPE_SIZE_T) +CIL_CHECK_INTEGER_TYPE(wchar_t, TYPE_WCHAR_T) + + +# ----------- platform-specific code ------------- +# $target is typically processor-vendor-os +case "$target" in + + *86*linux*) + AC_MSG_RESULT(configuring for linux/x86) + + ARCHOS=x86_LINUX + ;; + + *86*openbsd*) + AC_MSG_RESULT(configuring for OpenBSD/x86) + + ARCHOS=x86_OPENBSD + ;; + + *i386*freebsd*|*amd64*freebsd*) + + if test x"${ARCH}" = x""; then + ARCH=`uname -p` + fi + + AC_MSG_RESULT(configuring for freebsd/${ARCH}) + + ARCHOS=${ARCH}_FREEBSD + ;; + + + # Mac OS X + *86*darwin*) + AC_MSG_RESULT(configuring for darwin/x86) + + ARCHOS=x86_DARWIN + ;; + + *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"` + # Try to use the Unix paths even on cygwin. The newest versions of make + # do not like colons in file names + CILHOME=`cygpath -u "$CILHOME"` + 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 amd64: FreeBSD + 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]) + + + +# +# CIL features +# +# + +# Set the defaults + + +# Give a space-separated list of features with the defaults +features="blockinggraph=no zrapp=no" + +AC_ARG_WITH(blockinggraph, + AC_HELP_STRING([--with-blockinggraph], + [enable the blocking graph feature])) +AC_ARG_WITH(zrapp, + AC_HELP_STRING([--with-zrapp], + [enable the zrapp pretty-printer])) + +# Now add any features specified in the command-line + +features="$features $EXTRAFEATURES" + +rm -f Makefile.features +echo "# -*- Mode: makefile -*-">Makefile.features +echo "# This file was generated automatically by ./configure.in">>Makefile.features +echo "# We will not need this once configure supports multiline variables">>Makefile.features + +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" + f_up=`echo $f | tr a-z A-Z` + echo "export USE_$f_up=yes">>Makefile.features + fi +done +echo "TYPE_SIZE_T=\"$TYPE_SIZE_T\"" >>Makefile.features +echo "TYPE_WCHAR_T=\"$TYPE_WCHAR_T\"" >>Makefile.features +chmod -w Makefile.features + + +# ----------------- 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 .in to generate ; + +CIL_CONFIG_FILES(Makefile) +CIL_CONFIG_FILES(cil.spec) +CIL_CONFIG_FILES(config.mk) +CIL_CONFIG_FILES(test/Makefile) +CIL_CONFIG_EXE_FILES(bin/cilly.bat) +CIL_CONFIG_EXE_FILES(bin/patcher.bat) +CIL_CONFIG_FILES(bin/CilConfig.pm) +CIL_CONFIG_FILES(doc/index.html) +CIL_CONFIG_FILES(doc/header.html) +CIL_CONFIG_FILES(ocamlutil/perfcount.c) + +AC_OUTPUT() + +# show the user what the variables have been set to +cat < Fri, 15 Jan 2008 14:00:52 +0200 + +cil (1.3.5-1) unstable; urgency=low + + * New upstream release + + -- Luis Cañas Díaz Tue, 17 Apr 2007 18:30:53 +0200 + +cil (1.3.2-1) unstable; urgency=low + + * New upstream release + + -- Ben Liblit Sat, 5 Mar 2005 22:08:14 -0600 + +cinterlang (1.3.1-1) unstable; urgency=low + + * New upstream release + + -- Jesus M. Gonzalez-Barahona Thu, 19 Aug 2004 15:46:39 +0000 + +cinterlang (1.2.5-1) unstable; urgency=low + + * Initial Release. + + -- Jesus M. Gonzalez-Barahona Wed, 18 Aug 2004 00:40:43 +0200 diff --git a/cil/debian/cil-dev.install b/cil/debian/cil-dev.install new file mode 100644 index 0000000..d7ff26f --- /dev/null +++ b/cil/debian/cil-dev.install @@ -0,0 +1,2 @@ +usr/lib +usr/share/doc/cil-dev diff --git a/cil/debian/cil.install b/cil/debian/cil.install new file mode 100644 index 0000000..7102075 --- /dev/null +++ b/cil/debian/cil.install @@ -0,0 +1,2 @@ +usr/share/cil +usr/share/doc/cil diff --git a/cil/debian/compat b/cil/debian/compat new file mode 100644 index 0000000..b8626c4 --- /dev/null +++ b/cil/debian/compat @@ -0,0 +1 @@ +4 diff --git a/cil/debian/control b/cil/debian/control new file mode 100644 index 0000000..cd7b7c2 --- /dev/null +++ b/cil/debian/control @@ -0,0 +1,29 @@ +Source: cil +Section: devel +Priority: optional +Maintainer: Ben Liblit +Build-Depends: autotools-dev, debhelper (>= 4.0.0), fakeroot, hevea, libc6-i686, libncurses5-dev, locales, ocaml-base-nox (>= 3.08), ocaml-interp (>= 3.08), ocaml-nox (>= 3.08), perl-base (>= 5.6.1) +Standards-Version: 3.6.1 + +Package: cil +Architecture: any +Depends: perl (>= 5.6.1) +Description: OCaml library for C program analysis and transformation + 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. + +Package: cil-dev +Architecture: any +Depends: ocaml (>= 3.08) +Description: OCaml library for C program analysis and transformation + 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. diff --git a/cil/debian/copyright b/cil/debian/copyright new file mode 100644 index 0000000..d92d6d7 --- /dev/null +++ b/cil/debian/copyright @@ -0,0 +1,46 @@ +This package is maintained by Ben Liblit based on +initial debianizing by Jesus M. Gonzalez-Barahona . + +It was downloaded from http://manju.cs.berkeley.edu/cil/distrib + +Upstream Authors: George C. Necula , + Scott McPeak , + Wes Weimer , + Ben Liblit + +Copyright: + +Copyright (c) 2001-2005, + George C. Necula + Scott McPeak + Wes Weimer + Ben Liblit +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/debian/rules b/cil/debian/rules new file mode 100755 index 0000000..b88b429 --- /dev/null +++ b/cil/debian/rules @@ -0,0 +1,90 @@ +#!/usr/bin/make -f + +# These are used for cross-compiling and for saving the configure script +# from having to guess our platform (since we know it already) +DEB_HOST_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE) +DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) + +CFLAGS = -Wall -g + +ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) + CFLAGS += -O0 +else + CFLAGS += -O2 +endif +ifeq (,$(findstring nostrip,$(DEB_BUILD_OPTIONS))) + INSTALL_PROGRAM += -s +endif + +config.status: configure + dh_testdir + # Add here commands to configure the package. + CFLAGS="$(CFLAGS)" ./configure --host=$(DEB_HOST_GNU_TYPE) --build=$(DEB_BUILD_GNU_TYPE) --prefix=/usr --mandir=\$${prefix}/share/man --infodir=\$${prefix}/share/info + +build: debian/build-stamp + +debian/build-stamp: config.status + dh_testdir + # Add here commands to compile the package. + $(MAKE) setup #doc + touch $@ + +check: build + $(MAKE) check + + +clean: config.status + dh_testdir + dh_testroot + rm -f debian/build-stamp + # Add here commands to clean up after the build process. + -$(MAKE) distclean + rm -f config.status +ifneq "$(wildcard /usr/share/misc/config.sub)" "" + cp -f /usr/share/misc/config.sub config.sub +endif +ifneq "$(wildcard /usr/share/misc/config.guess)" "" + cp -f /usr/share/misc/config.guess config.guess +endif + dh_clean + +install: build + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + $(MAKE) install DESTDIR=$(CURDIR)/debian/tmp + mkdir -p $(CURDIR)/debian/tmp/usr/share/doc/cil/html + mkdir -p $(CURDIR)/debian/tmp/usr/share/doc/cil-dev + cp LICENSE $(CURDIR)/debian/tmp/usr/share/doc/cil/ + cp LICENSE $(CURDIR)/debian/tmp/usr/share/doc/cil-dev/ + #cp -f doc/*.html $(CURDIR)/debian/tmp/usr/share/doc/cil/html + #cp -f doc/*.gif $(CURDIR)/debian/tmp/usr/share/doc/cil/html + #cp -a doc/api $(CURDIR)/debian/tmp/usr/share/doc/cil/html + #cp -a doc/*.pdf $(CURDIR)/debian/tmp/usr/share/doc/cil + #cp -a doc/examples $(CURDIR)/debian/tmp/usr/share/doc/cil + +# Build architecture-independent files here. +binary-indep: build install +# We have nothing to do by default. + +# Build architecture-dependent files here. +binary-arch: build install + dh_testdir + dh_testroot + dh_installchangelogs + dh_installdocs + dh_installexamples + dh_install --list-missing --sourcedir=$(CURDIR)/debian/tmp + dh_installman + dh_link + dh_strip + dh_compress + dh_fixperms + dh_installdeb + dh_gencontrol + dh_md5sums + dh_builddeb + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install diff --git a/cil/debian/watch b/cil/debian/watch new file mode 100644 index 0000000..83b9d32 --- /dev/null +++ b/cil/debian/watch @@ -0,0 +1,6 @@ +# Example watch control file for uscan +# Rename this file to "watch" and then you can run the "uscan" command +# to check for upstream updates and more. +# Site Directory Pattern Version Script +version=2 +http://manju.cs.berkeley.edu/cil/distrib/cil-(.*)\.tar\.gz diff --git a/cil/doc/.cvsignore b/cil/doc/.cvsignore new file mode 100644 index 0000000..4726247 --- /dev/null +++ b/cil/doc/.cvsignore @@ -0,0 +1,24 @@ +*.mfj +*.dvi +*.aux +*.ps +*.log +*.blg +*.bbl +*.lof +*.lot +*.toc +*.pdf +*.png +*.out +*.xyc +*.xyd +auto +cil-api.tex +cil.version.tex +cilpp.tex +cilcode.tmp +cil.version +header.html +index.html +ocamldoc.sty diff --git a/cil/doc/cil.itarget b/cil/doc/cil.itarget new file mode 100644 index 0000000..871e1cf --- /dev/null +++ b/cil/doc/cil.itarget @@ -0,0 +1 @@ +cil.docdir/index.html diff --git a/cil/doc/cil.odocl b/cil/doc/cil.odocl new file mode 100644 index 0000000..97972da --- /dev/null +++ b/cil/doc/cil.odocl @@ -0,0 +1,11 @@ +Alpha +Cfg +Cil +Cillower +Clist +Dataflow +Dominators +Errormsg +Formatcil +Pretty +Stats diff --git a/cil/doc/cil.tex b/cil/doc/cil.tex new file mode 100644 index 0000000..f50c1ea --- /dev/null +++ b/cil/doc/cil.tex @@ -0,0 +1,3834 @@ +\documentclass{article} + +\usepackage{hevea} + +% ww: this gibberish is ignored by hevea but makes the PDF look better +\begin{latexonly} +\oddsidemargin 4.5pc +\evensidemargin 4.5pc +\advance\oddsidemargin by -1.2in +\advance\evensidemargin by -1.2in +\marginparwidth 0pt +\marginparsep 11pt +\topmargin 4.5pc +\advance\topmargin by -1in +\headheight 0pt +\headsep 0pt +\advance\topmargin by -37pt +\headheight 12pt +\headsep 25pt +\textheight 666pt +\textwidth 44pc +\end{latexonly} + +% cilversion.tex is generated automatically to define \cilversion +\include{cil.version} + +\def\secref#1{Section~\ref{sec-#1}} +\def\chref#1{Chapter~\ref{ch-#1}} + +\def\apiref#1#2#3{\ahref{api/#1.html\##2#3}{#1.#3}} +\def\moduleref#1{\ahref{api/#1.html}{#1}} + +% Use this to refer to a Cil type/val +\def\ciltyperef#1{\apiref{Cil}{TYPE}{#1}} +\def\cilvalref#1{\apiref{Cil}{VAL}{#1}} +\def\cilvisit#1{\apiref{Cil.cilVisitor}{#1}} +\def\cilprinter#1{\apiref{Cil.cilPrinter}{#1}} + +% Use this to refer to a type/val in the Pretty module +\def\ptyperef#1{\apiref{Pretty}{TYPE}{#1}} +\def\pvalref#1{\apiref{Pretty}{VAL}{#1}} + +% Use this to refer to a type/val in the Errormsg module +\def\etyperef#1{\apiref{Errormsg}{TYPE}{#1}} +\def\evalref#1{\apiref{Errormsg}{VAL}{#1}} + +\def\formatcilvalref#1{\apiref{Formatcil}{VAL}{#1}} +\def\cfgref#1{\apiref{Cfg}{VAL}{#1}} + + +%---------------------------------------------------------------------- +% MACROS + +\newcommand{\hsp}{\hspace{0.5in}} +\def\t#1{{\tt #1}} +\newcommand\codecolor{\ifhevea\blue\else\fi} +\renewcommand\c[1]{{\codecolor #1}} % Use for code fragments + +%%% Define an environment for code +%% Unfortunately since hevea is not quite TeX you have to use this as follows +%\begin{code} +% ... +%\end{verbatim}\end{code} +\def\code{\begingroup\codecolor\begin{verbatim}} +\def\endcode{\endgroup} + +%use this for links to external pages. It will open pages in the +%top frame. +\newcommand\ahreftop[2]{{\ahref{javascript:loadTop('#1')}{#2}}} + +%---------------------------------------------------------------------- + +% Make sure that most documents show up in the main frame, +% and define javascript:loadTop for those links that should fill the window. +\makeatletter +\let\oldmeta=\@meta +\def\@meta{% +\oldmeta +\begin{rawhtml} + + +\end{rawhtml}} +\makeatother + +\begin{document} +\begin{latexonly} +\title{CIL: Infrastructure for C Program Analysis and Transformation} +\end{latexonly} +\maketitle + + +\section{Introduction} + + New: CIL now has a Source Forge page: + \ahreftop{http://sourceforge.net/projects/cil} + {http://sourceforge.net/projects/cil}. + + CIL ({\bf C} {\bf I}ntermediate {\bf L}anguage) is a high-level representation +along with a set of tools that permit easy analysis and source-to-source +transformation of C programs. + + 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 \secref{simplec} for some +examples of such extreme programs that CIL simplifies for you. + + In essence, CIL is a highly-structured, ``clean'' 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} statements, syntactic sugar like {\tt "->"} is +eliminated and function arguments with array types become pointers. (For an +extensive list of how CIL simplifies C programs, see \secref{cabs2cil}.) +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 \secref{Extension}. + + CIL comes accompanied by a number of Perl scripts that perform generally +useful operations on code: +\begin{itemize} +\item A \ahrefloc{sec-driver}{driver} which behaves as either the \t{gcc} 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. +\item A \ahrefloc {sec-merger}{whole-program merger} 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. +\item A \ahrefloc{sec-patcher}{patcher} 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. +\end{itemize} + + 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 \t{gcc} and +they still run! We consider the compilation of Linux a major feat especially +since Linux contains many of the ugly GCC extensions (see \secref{ugly-gcc}). +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. + + 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.) + + The largest application we have used CIL for is +\ahreftop{../ccured/index.html}{CCured}, 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. + + You can also use CIL to ``compile'' code that uses GCC extensions (e.g. the +Linux kernel) into standard C code. + + CIL also comes accompanies by a growing library of extensions (see +\secref{Extension}). You can use these for your projects or as examples of +using CIL. + +\t{PDF} versions of \ahref{CIL.pdf}{this manual} and the +\ahref{CIL-API.pdf}{CIL API} are available. However, we recommend the +\t{HTML} versions because the postprocessed code examples are easier to +view. + + 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 ``CIL: +Intermediate Language and Tools for Analysis and Transformation of C +Programs'' by George C. Necula, Scott McPeak, S.P. Rahul and Westley Weimer, +in ``Proceedings of Conference on Compilier Construction'', 2002. + +\section{Installation} + + You need the following tools to build CIL: +\begin{itemize} +\item A Unix-like shell environment (with bash, perl, make, mv, cp, + etc.). On Windows, you will need cygwin with those packages. +\item An ocaml compiler. 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 as +either Microsoft Visual C or gcc). On Windows, you can build CIL both with the +cygwin version of ocaml (preferred) and with the Win32 version of ocaml. +\item An underlying C compiler, which can be either gcc or Microsoft Visual C. +\end{itemize} + +\begin{enumerate} +\item Get the source code. +\begin{itemize} +\item {\em Official distribution} (Recommended): +\begin{enumerate} +\item Download the CIL \ahref{distrib}{distribution} (latest version is +\ahrefurl{distrib/cil-\cilversion.tar.gz}). See the \secref{changes} for recent changes to the CIL distribution. +\item Unzip and untar the source distribution. This will create a directory + called \t{cil} whose structure is explained below. \\ + \t{~~~~tar xvfz cil-\cilversion.tar.gz} +\end{enumerate} +\item {\em Subversion Repository}: \\ + Alternately, you can download an up to the minute version of CIL + from our Subversion repository at: +\begin{verbatim} + svn co svn://hal.cs.berkeley.edu/home/svn/projects/trunk/cil +\end{verbatim} +However, the Subversion version may be less stable than the released +version. See the Changes section of doc/cil.tex to see what's +changed since the last release. There may be changes that aren't yet +documented in the .tex file or this website. + +For those who were using the CVS server before we switched to +Subversion, revision 8603 in Subversion corresponds to the last CVS +version. + +\end{itemize} +\item Enter the \t{cil} directory and run the \t{configure} script and then + GNU make to build the distribution. If you are on Windows, at least the + \t{configure} step must be run from within \t{bash}. \\ + \hsp\verb!cd cil!\\ + \hsp\verb!./configure!\\ + \hsp\verb!make!\\ + \hsp\verb!make quicktest!\\ + +\item You should now find \t{cilly.asm.exe} in a subdirectory of \t{obj}. The +name of the subdirectory is either \t{x86\_WIN32} if you are using \t{cygwin} +on Windows or \t{x86\_LINUX} if you are using Linux (although you should be +using instead the Perl wrapper \t{bin/cilly}). Note that we do not have an +\t{install} make target and you should use Cil from the development directory. +\item If you decide to use CIL, {\bf please} +\ahref{mailto:necula@cs.berkeley.edu}{send us a note}. This will help recharge +our batteries after a few years of development. And of course, do send us +your bug reports as well. +\end{enumerate} + + The \t{configure} script tries to find appropriate defaults for your system. +You can control its actions by passing the following arguments: +\begin{itemize} +\item \t{CC=foo} Specifies the path for the \t{gcc} executable. By default +whichever version is in the PATH is used. If \t{CC} specifies the Microsoft +\t{cl} compiler, then that compiler will be set as the default one. Otherwise, +the \t{gcc} compiler will be the default. +\end{itemize} + + 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 \t{./configure} when you move CIL to +another machine.) + +We have tested CIL on the following compilers: + +\begin{itemize} +\item On Windows, \t{cl} compiler version 12.00.8168 (MSVC 6), + 13.00.9466 (MSVC .Net), and 13.10.3077 (MSVC .Net 2003). Run \t{cl} + with no arguments to get the compiler version. +\item On Windows, using \t{cygwin} and \t{gcc} version 2.95.3, 3.0, + 3.2, 3.3, and 3.4. +\item On Linux, using \t{gcc} version 2.95.3, 3.0, 3.2, 3.3, 4.0, and 4.1. +\end{itemize} + +Others have successfully used CIL on x86 processors with Mac OS X, +FreeBSD and OpenBSD; on amd64 processors with FreeBSD; on SPARC +processors with Solaris; and on PowerPC processors with Mac OS X. If +you make any changes to the build system in order to run CIL on your +platform, please send us a patch. + + \subsection{Building CIL on Windows with Microsoft Visual C} + + Some users might want to build a standalone CIL executable on Windows (an +executable that does not require cygwin.dll to run). You will need cygwin for +the build process only. Here is how we do it + +\begin{enumerate} +\item Start with a clean CIL directory +\item Start a command-line window setup with the environment variables for + Microsoft Visual Studio. You can do this by choosing Programs/Microsoft + Visual Studio/Tools/Command Prompt. Check that you can run \t{cl}. +\item Ensure that \t{ocamlc} refers to a Win32 version of ocaml. Run \t{ocamlc + -v} and look at the path to the standard library. If you have several + versions of ocaml, you must set the following variables: + \begin{verbatim} + set OCAMLWIN=C:/Programs/ocaml-win + + set OCAMLLIB=%OCAMLWIN%/lib + set PATH=%OCAMLWIN%/bin;%PATH% + set INCLUDE=%INCLUDE%;%OCAMLWIN%/inc + set LIB=%LIB%;%OCAMLWIN%/lib;obj/x86_WIN32 + \end{verbatim} + +\item Run \t{bash -c "./configure CC=cl"}. +\item Run \t{bash -c "make WIN32=1 quickbuild"} +\item Run \t{bash -c "make WIN32=1 NATIVECAML=1 cilly} +\item Run \t{bash -c "make WIN32=1 bindistrib-nocheck} +\end{enumerate} + + The above steps do not build the CIL library, but just the executable. The +last step will create a subdirectory \t{TEMP\_cil-bindistrib} that contains +everything that you need to run CIL on another machine. You will have to edit +manually some of the files in the \t{bin} directory to replace \t{CILHOME}. +The resulting CIL can be run with ActiveState Perl also. + + + \section{Distribution Contents} + +The file \ahrefurl{distrib/cil-\cilversion.tar.gz} +contains the complete source CIL distribution, +consisting of the following files: + +\begin{tabular}{ll} +Filename & Description \\ +\t{Makefile.in} & \t{configure} source for the + Makefile that builds CIL \\ +\t{configure} & The configure script \\ +\t{configure.in} & The \t{autoconf} source for \t{configure} \\ +\t{config.guess}, \t{config.sub}, \t{install-sh} & stuff required by + \t{configure} \\ +\\ +\t{doc/} & HTML documentation of the CIL API \\ +\t{obj/} & Directory that will contain the compiled + CIL modules and executables\\ +\t{bin/cilly.in} & The \t{configure} source for a Perl script + that can be invoked with the + same arguments as either \t{gcc} or + Microsoft Visual C and will convert the + program to CIL, perform some simple + transformations, emit it and compile it as + usual. \\ +\t{lib/CompilerStub.pm} & A Perl class that can be used to write code + that impersonates a compiler. \t{cilly} + uses it. \\ +\t{lib/Merger.pm} & A subclass of \t{CompilerStub.pm} that can + be used to merge source files into a single + source file.\t{cilly} + uses it. \\ +\t{bin/patcher.in} & A Perl script that applies specified patches + to standard include files.\\ +\\ +\t{src/check.ml,mli} & Checks the well-formedness of a CIL file \\ +\t{src/cil.ml,mli} & Definition of CIL abstract syntax and + utilities for manipulating it\\ +\t{src/clist.ml,mli} & Utilities for efficiently managing lists + that need to be concatenated often\\ +\t{src/errormsg.ml,mli} & Utilities for error reporting \\ +\t{src/ext/heapify.ml} & A CIL transformation that moves array local + variables from the stack to the heap \\ +\t{src/ext/logcalls.ml,mli} & A CIL transformation that logs every + function call \\ +\t{src/ext/sfi.ml} & A CIL transformation that can log every + memory read and write \\ +\t{src/frontc/clexer.mll} & The lexer \\ +\t{src/frontc/cparser.mly} & The parser \\ +\t{src/frontc/cabs.ml} & The abstract syntax \\ +\t{src/frontc/cprint.ml} & The pretty printer for CABS \\ +\t{src/frontc/cabs2cil.ml} & The elaborator to CIL \\ +\t{src/main.ml} & The \t{cilly} application \\ +\t{src/pretty.ml,mli} & Utilities for pretty printing \\ +\t{src/rmtmps.ml,mli} & A CIL tranformation that removes unused + types, variables and inlined functions \\ +\t{src/stats.ml,mli} & Utilities for maintaining timing statistics +\\ +\t{src/testcil.ml} & A random test of CIL (against the resident + C compiler)\\ +\t{src/trace.ml,mli} & Utilities useful for printing debugging + information\\ +\\ +\t{ocamlutil/} & Miscellaneous libraries that are not + specific to CIL. \\ +\t{ocamlutil/Makefile.ocaml} & A file that is included by \t{Makefile} \\ +\t{ocamlutil/perfcount.c} & C code that links with src/stats.ml + and reads Intel performance + counters. \\ +\\ +\t{obj/@ARCHOS@/feature\_config.ml} & File generated by the Makefile + describing which extra ``features'' + to compile. See \secref{cil} \\ +\t{obj/@ARCHOS@/machdep.ml} & File generated by the Makefile containing + information about your architecture, + such as the size of a pointer \\ +\t{src/machdep.c} & C program that generates + \t{machdep.ml} files \\ +\end{tabular} + + +\section{Compiling C to CIL}\label{sec-cabs2cil} + + 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. + + In no particular order these are a few of the most significant ways in which +C programs are compiled into CIL: +\begin{enumerate} +\item CIL will eliminate all declarations for unused entities. This means that +just because your hello world program includes \t{stdio.h} it does not mean +that your analysis has to handle all the ugly stuff from \t{stdio.h}. + +\item Type specifiers are interpreted and normalized: +\begin{cilcode}[global] +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; } +\end{cilcode} + +\item Anonymous structure and union declarations are given a name. +\begin{cilcode}[global] + struct { int x; } s; +\end{cilcode} + +\item Nested structure tag definitions are pulled apart. This means that all +structure tag definitions can be found by a simple scan of the globals. + +\begin{cilcode}[global] +struct foo { + struct bar { + union baz { + int x1; + double x2; + } u1; + int y; + } s1; + int z; +} f; +\end{cilcode} + +\item 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. + +\begin{cilcode}[global] +int main() { + struct foo { + int x; } foo; + { + struct foo { + double d; + }; + return foo.x; + } +} +\end{cilcode} + +\item 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!). +\begin{cilcode}[global] + int f(); // Prototype without arguments + int f(double x) { + return g(x); + } + int g(double x) { + return x; + } +\end{cilcode} + +\item Array lengths are computed based on the initializers or by constant +folding. +\begin{cilcode}[global] + int a1[] = {1,2,3}; + int a2[sizeof(int) >= 4 ? 8 : 16]; +\end{cilcode} + +\item Enumeration tags are computed using constant folding: +\begin{cilcode}[global] +int main() { + enum { + FIVE = 5, + SIX, SEVEN, + FOUR = FIVE - 1, + EIGHT = sizeof(double) + } x = FIVE; + return x; +} + +\end{cilcode} + +\item Initializers are normalized to include specific initialization for the +missing elements: +\begin{cilcode}[global] + int a1[5] = {1,2,3}; + struct foo { int x, y; } s1 = { 4 }; +\end{cilcode} + +\item 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. +\begin{cilcode}[global] + 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 }; +\end{cilcode} + +\item String initializers for arrays of characters are processed + +\begin{cilcode}[global] +char foo[] = "foo plus bar"; +\end{cilcode} + +\item String constants are concatenated + +\begin{cilcode}[global] +char *foo = "foo " " plus " " bar "; +\end{cilcode} + +\item 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 \t{const} +qualifier from local variables ! + +\begin{cilcode}[local] + int x = 5; + struct foo { int f1, f2; } a [] = {1, 2, 3, 4, 5 }; +\end{cilcode} + +\item 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. + +\begin{cilcode}[global] + int x = 5; + int main() { + int x = 6; + { + int x = 7; + return x; + } + return x; + } +\end{cilcode} + +\item Global declarations in local scopes are moved to global scope: +\begin{cilcode}[global] + int x = 5; + int main() { + int x = 6; + { + static int x = 7; + return x; + } + return x; + } +\end{cilcode} + +\item Return statements are added for functions that are missing them. If the +return type is not a base type then a \t{return} 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. +\begin{cilcode}[global] + int foo() { + int x = 5; + } +\end{cilcode} + +\item One of the most significant transformations is that expressions that +contain side-effects are separated into statements. + +\begin{cilcode}[local] + int x, f(int); + return (x ++ + f(x)); +\end{cilcode} + + Internally, the \t{x ++} 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. + +\item Shortcut evaluation of boolean expressions and the \t{?:} operator are +compiled into explicit conditionals: +\begin{cilcode}[local] + int x; + int y = x ? 2 : 4; + int z = x || y; + // Here we duplicate the return statement + if(x && y) { return 0; } else { return 1; } + // To avoid excessive duplication, CIL uses goto's for + // statement that have more than 5 instructions + if(x && y || z) { x ++; y ++; z ++; x ++; y ++; return z; } +\end{cilcode} + +\item GCC's conditional expression with missing operands are also compiled +into conditionals: +\begin{cilcode}[local] + int f();; + return f() ? : 4; +\end{cilcode} + +\item All forms of loops (\t{while}, \t{for} and \t{do}) are compiled +internally as a single \t{while(1)} looping construct with explicit \t{break} +statement for termination. For simple \t{while} loops the pretty printer is +able to print back the original: +\begin{cilcode}[local] + int x, y; + for(int i = 0; i<5; i++) { + if(i == 5) continue; + if(i == 4) break; + i += 2; + } + while(x < 5) { + if(x == 3) continue; + x ++; + } +\end{cilcode} + +\item GCC's block expressions are compiled away. (That's right there is an +infinite loop in this code.) + +\begin{cilcode}[local] + int x = 5, y = x; + int z = ({ x++; L: y -= x; y;}); + return ({ goto L; 0; }); +\end{cilcode} + +\item CIL contains support for both MSVC and GCC inline assembly (both in one +internal construct) + +\item CIL compiles away the GCC extension that allows many kinds of constructs +to be used as lvalues: + +\begin{cilcode}[local] + int x, y, z; + return &(x ? y : z) - & (x ++, x); +\end{cilcode} + +\item All types are computed and explicit casts are inserted for all +promotions and conversions that a compiler must insert: + +\item 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. + +\item Since CIL sees the source after preprocessing the code after CIL does +not contain the comments and the preprocessing directives. + +\item 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: +\begin{cilcode}[global] +#include + +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 +} +\end{cilcode} + +\end{enumerate} + +\section{How to Use CIL}\label{sec-cil}\cutname{cilly.html} + +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 \t{cilly}, our driver. + +\subsection{Using \t{cilly}, the CIL driver} + +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 \t{cilly}. \t{cilly} is a Perl script that +processes and mimics \t{GCC} and \t{MSVC} command-line arguments and then +calls \t{cilly.byte.exe} or \t{cilly.asm.exe} (CIL's Ocaml executable). + +An example of such module is \t{logwrites.ml}, 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 \secref{Extension} for a survey of other example +modules. + +Assuming that you have written \t{/home/necula/logwrites.ml}, +here is how you use it: + + \begin{enumerate} + + \item Modify \t{logwrites.ml} so that it includes a CIL ``feature + descriptor'' like this: +\begin{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) -> + let lwVisitor = new logWriteVisitor in + visitCilFileSameGlobals lwVisitor f) + } +\end{verbatim} + The \t{fd\_name} field names the feature and its associated + command-line arguments. The \t{fd\_enabled} field is a \t{bool ref}. + ``\t{fd\_doit}'' will be invoked if \t{!fd\_enabled} is true after + argument parsing, so initialize the ref cell to true if you want + this feature to be enabled by default. + + When the user passes the \t{-{}-{}dologwrites} + command-line option to \t{cilly}, the variable associated with the + \t{fd\_enabled} flag is set and the \t{fd\_doit} function is called + on the \t{Cil.file} that represents the merger (see \secref{merger}) of + all C files listed as arguments. + + \item Invoke \t{configure} with the arguments +\begin{verbatim} +./configure EXTRASRCDIRS=/home/necula EXTRAFEATURES=logwrites +\end{verbatim} + + This step works if each feature is packaged into its own ML file, and the +name of the entry point in the file is \t{feature}. + + 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. + +\begin{enumerate} + \item Put \t{logwrites.ml} in the \t{src} or \t{src/ext} directory. This + will make sure that \t{make} can find it. If you want to put it in some + other directory, modify \t{Makefile.in} and add to \t{SOURCEDIRS} your + directory. Alternately, you can create a symlink from \t{src} or + \t{src/ext} to your file. + + \item Modify the \t{Makefile.in} and add your module to the + \t{CILLY\_MODULES} or + \t{CILLY\_LIBRARY\_MODULES} variables. The order of the modules matters. Add + your modules somewhere after \t{cil} and before \t{main}. + + \item If you have any helper files for your module, add those to + the makefile in the same way. e.g.: + +\begin{verbatim} +CILLY_MODULES = $(CILLY_LIBRARY_MODULES) \ + myutilities1 myutilities2 logwrites \ + main +\end{verbatim} + % $ <- emacs hack + + Again, order is important: \t{myutilities2.ml} will be able to refer + to Myutilities1 but not Logwrites. If you have any ocamllex or ocamlyacc + files, add them to both \t{CILLY\_MODULES} and either \t{MLLS} or + \t{MLYS}. + + \item Modify \t{main.ml} so that your new feature descriptor appears in + the global list of CIL features. +\begin{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 +\end{verbatim} + + 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. + +\end{enumerate} + + Standard code in \t{cilly} 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. + + \item Now you can invoke the \t{cilly} application on a preprocessed file, or + instead use the \t{cilly} driver which provides a convenient compiler-like + interface to \t{cilly}. See \secref{driver} for details using \t{cilly}. + Remember to enable your analysis by passing the right argument (e.g., + \t{-{}-{}dologwrites}). + +\end{enumerate} + +\subsection{Using CIL as a library} + +CIL can also be built as a library that is called from your stand-alone +application. Add \t{cil/src}, \t{cil/src/frontc}, \t{cil/obj/x86\_LINUX} +(or \t{cil/obj/x86\_WIN32}) to your Ocaml project \t{-I} include paths. +Building CIL will also build the library \t{cil/obj/*/cil.cma} (or +\t{cil/obj/*/cil.cmxa}). You can then link your application against that +library. + +You can call the \t{Frontc.parse: string -> unit -> Cil.file} function with +the name of a file containing the output of the C preprocessor. +The \t{Mergecil.merge: Cil.file list -> string -> Cil.file} function merges +multiple files. You can then invoke your analysis function on the resulting +\t{Cil.file} data structure. You might want to call +\t{Rmtmps.removeUnusedTemps} first to clean up the prototypes and variables +that are not used. Then you can call the function \t{Cil.dumpFile: +cilPrinter -> out\_channel -> Cil.file -> unit} to print the file to a +given output channel. A good \t{cilPrinter} to use is +\t{defaultCilPrinter}. + +Check out \t{src/main.ml} and \t{bin/cilly} for other good ideas +about high-level file processing. Again, we highly recommend that you just +our \t{cilly} driver so that you can avoid spending time re-inventing the +wheel to provide drop-in support for standard \t{makefile}s. + +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 \t{main.ml}. + +\begin{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 +\end{verbatim} % $ + +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 \ahreftop{http://caml.inria.fr/ocaml/}{http://caml.inria.fr/ocaml/}. + +In the next section we give an overview of the API that you can use +to write your analysis and transformation. + +\section{CIL API Documentation}\label{sec-api} + + The CIL API is documented in the file \t{src/cil.mli}. We also have an +\ahref{api/index.html}{online documentation} extracted from +\t{cil.mli} and other useful modules. We +index below the main types that are used to represent C programs in CIL: + +\begin{itemize} +\item \ahref{api/index\_types.html}{An index of all types} +\item \ahref{api/index\_values.html}{An index of all values} +\item \ciltyperef{file} is the representation of a file. +\item \ciltyperef{global} is the representation of a global declaration or +definitions. Values for \ahref{api/Cil.html\#VALemptyFunction}{operating on globals}. +\item \ciltyperef{typ} is the representation of a type. +Values for \ahref{api/Cil.html\#VALvoidType}{operating on types}. +\item \ciltyperef{compinfo} is the representation of a structure or a union +type +\item \ciltyperef{fieldinfo} is the representation of a field in a structure +or a union +\item \ciltyperef{enuminfo} is the representation of an enumeration type. +\item \ciltyperef{varinfo} is the representation of a variable +\item \ciltyperef{fundec} is the representation of a function +\item \ciltyperef{lval} is the representation of an lvalue. +Values for \ahref{api/Cil.html\#VALmakeVarInfo}{operating on lvalues}. +\item \ciltyperef{exp} is the representation of an expression without +side-effects. +Values for \ahref{api/Cil.html\#VALzero}{operating on expressions}. +\item \ciltyperef{instr} is the representation of an instruction (with +side-effects but without control-flow) +\item \ciltyperef{stmt} is the representation of a control-flow statements. +Values for \ahref{api/Cil.html\#VALmkStmt}{operating on statements}. +\item \ciltyperef{attribute} is the representation of attributes. +Values for \ahref{api/Cil.html\#TYPEattributeClass}{operating on attributes}. +\end{itemize} + + + \subsection{Using the visitor}\label{sec-visitor} + + 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: +\begin{itemize} +\item Ignore this node and all its descendants +\item Descend into all of the children and when done rebuild the node if any +of the children have changed. +\item Replace the subtree rooted at the node with another tree. +\item Replace the subtree with another tree, then descend into the children +and rebuild the node if necessary and then invoke a user-specified function. +\item 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. +\end{itemize} + + 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. + + Each visitor is an object that is an instance of a class of type \cilvisit{}. +The most convenient way to obtain such classes is to specialize the +\apiref{Cil.nopCilVisitor}{} class (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 +\t{logwrites.ml}. Another, more elaborate example of a visitor is the +[copyFunctionVisitor] defined in \t{cil.ml}. + + Once you have defined a visitor you can invoke it with one of the functions: +\begin{itemize} +\item \cilvalref{visitCilFile} or \cilvalref{visitCilFileSameGlobals} - visit a file +\item \cilvalref{visitCilGlobal} - visit a global +\item \cilvalref{visitCilFunction} - visit a function definition +\item \cilvalref{visitCilExp} - visit an expression +\item \cilvalref{visitCilLval} - visit an lvalue +\item \cilvalref{visitCilInstr} - visit an instruction +\item \cilvalref{visitCilStmt} - visit a statement +\item \cilvalref{visitCilType} - 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. +\end{itemize} + +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 \cilvalref{queueInstr} method of the specialized +object. The instructions will automatically be inserted before that +instruction in the transformed code. The \cilvalref{unqueueInstr} method +should not normally be called by the user. + + \subsection{Interpreted Constructors and Deconstructors} + + 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: +\begin{code} +Formatcil.cType "void * const (*)(int x)" +\end{verbatim}\end{code} + + 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: +\begin{code} +TPtr(TFun(TVoid [Attr("const", [])], + [ ("x", TInt(IInt, []), []) ], false, []), []) +\end{verbatim}\end{code} + + The advantage of the interpreted constructors is that you can use familiar C +syntax to construct CIL abstract-syntax trees. + + 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 \t{\%e:id} placeholder means +that the argument labeled ``id'' (expected to be of form \t{Fe exp}) will +supply the expression to replace the placeholder. For example, the following +code constructs an increment instruction at location \t{loc}: +\begin{code} +Formatcil.cInstr "%v:x = %v:x + %e:something" + loc + [ ("something", Fe some_exp); + ("x", Fv some_varinfo) ] +\end{verbatim}\end{code} + + An alternative way to construct the same CIL instruction is: +\begin{code} +Set((Var some_varinfo, NoOffset), + BinOp(PlusA, Lval (Var some_varinfo, NoOffset), + some_exp, intType), + loc) +\end{verbatim}\end{code} + + See \ciltyperef{formatArg} for a definition of the placeholders that are +understood. + + A dual feature is the interpreted deconstructors. This can be used to test +whether a CIL construct has a certain form: +\begin{code} +Formatcil.dType "void * const (*)(int x)" t +\end{verbatim}\end{code} + + will test whether the actual argument \t{t} is indeed a function pointer of +the required type. If it is then the result is \t{Some []} otherwise it is +\t{None}. Furthermore, for the purpose of the interpreted deconstructors +placeholders in patterns match anything of the right type. For example, +\begin{code} +Formatcil.dType "void * (*)(%F:t)" t +\end{verbatim}\end{code} + + will match any function pointer type, independent of the type and number of +the formals. If the match succeeds the result is \t{Some [ FF forms ]} where +\t{forms} 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. + + 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: +\begin{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 ) + | & L | ( T ) E + +Unary operators: + Unop ::= + | - | ~ | %u:ID + +Binary operators: + Binop ::= + | - | * | / | << | >> | & | ``|'' | ^ + | == | != | < | > | <= | >= | %b:ID + +Lvalues: + L ::= %l:ID | %v:ID Offset | * E | (* E) Offset | E -> 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 +\end{verbatim} + +Notes regarding the syntax: +\begin{itemize} +\item In the grammar description above non-terminals are written with +uppercase initial + +\item All of the patterns consist of the \t{\%} character followed by one or +two letters, followed by ``:'' and an indentifier. For each such +pattern there is a corresponding constructor of the \ciltyperef{formatArg} +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 +\ciltyperef{formatArg} actual argument to the interpreted constructor and by +the interpreted deconstructor to return what was matched for a pattern. + +\item 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). + +\item The two-letter patterns whose second letter is ``o'' designate an +optional element. E.g. \%eo designates an optional expression (as in the +length of an array). + +\item Unlike in calls to \t{printf}, the pattern \%g is used for strings. + +\item The usual precedence and associativity rules as in C apply + +\item The pattern string can contain newlines and comments, using both the +\t{/* ... */} style as well as the \t{//} one. + +\item When matching a ``cast'' pattern of the form \t{( T ) E}, 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 \t{"(int)\%e"} will match any expression of type \t{int} whether it +has an explicit cast or not. + +\item The \%k pattern is used to construct and deconstruct an integer type of +any kind. + +\item 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. + +\item In lists of formal parameters and lists of attributes, an empty list in +the pattern matches any formal parameters or attributes. + +\item When matching types, uses of named types are unrolled to expose a real +type before matching. + +\item The order of the attributes is ignored during matching. The the pattern +for a list of attributes contains \%A then the resulting \t{formatArg} will be +bound to {\bf all} attributes in the list. For example, the pattern \t{"const +\%A"} matches any list of attributes that contains \t{const} and binds the +corresponding placeholder to the entire list of attributes, including +\t{const}. + +\item All instruction-patterns must be terminated by semicolon + +\item The autoincrement and autodecrement instructions are not supported. Also +not supported are complex expressions, the \t{\&\&} and \t{||} 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. + +\item 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. + +\item 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. + +\item The \t{\%v:} pattern specifier is optional. +\end{itemize} + + The following function are defined in the \t{Formatcil} module for +constructing and deconstructing: +\begin{itemize} +\item \formatcilvalref{cExp} constructs \ciltyperef{exp}. +\item \formatcilvalref{cType} constructs \ciltyperef{typ}. +\item \formatcilvalref{cLval} constructs \ciltyperef{lval}. +\item \formatcilvalref{cInstr} constructs \ciltyperef{instr}. +\item \formatcilvalref{cStmt} and \formatcilvalref{cStmts} construct \ciltyperef{stmt}. +\item \formatcilvalref{dExp} deconstructs \ciltyperef{exp}. +\item \formatcilvalref{dType} deconstructs \ciltyperef{typ}. +\item \formatcilvalref{dLval} deconstructs \ciltyperef{lval}. +\item \formatcilvalref{dInstr} deconstructs \ciltyperef{lval}. +\end{itemize} + + 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: +\begin{code} +Formatcil.cStmts + loc + "int idx = sizeof(array) / sizeof(array[0]) - 1; + while(idx >= 0) { + // Some statements to be run for all the elements of the array + %S:init + if(! (idx & 1)) + array[idx] = %e:init_even; + /* Do not forget to decrement the index variable */ + idx = idx - 1; + }" + (fun n t -> makeTempVar myfunc ~name:n t) + [ ("array", Fv myarray); + ("init", FS [stmt1; stmt2; stmt3]); + ("init_even", Fe init_expr_for_even_elements) ] +\end{verbatim}\end{code} + + 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. + + \subsubsection{Performance considerations for interpreted constructors} + + 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). + + + \subsection{Printing and Debugging support} + +The Modules \moduleref{Pretty} and \moduleref{Errormsg} contain respectively +utilities for pretty printing and reporting errors and provide a convenient +\t{printf}-like interface. + + Additionally, CIL defines for each major type a pretty-printing function that +you can use in conjunction with the \moduleref{Pretty} interface. The +following are some of the pretty-printing functions: +\begin{itemize} +\item \cilvalref{d\_exp} - print an expression +\item \cilvalref{d\_type} - print a type +\item \cilvalref{d\_lval} - print an lvalue +\item \cilvalref{d\_global} - print a global +\item \cilvalref{d\_stmt} - print a statment +\item \cilvalref{d\_instr} - print an instruction +\item \cilvalref{d\_init} - print an initializer +\item \cilvalref{d\_attr} - print an attribute +\item \cilvalref{d\_attrlist} - print a set of attributes +\item \cilvalref{d\_loc} - print a location +\item \cilvalref{d\_ikind} - print an integer kind +\item \cilvalref{d\_fkind} - print a floating point kind +\item \cilvalref{d\_const} - print a constant +\item \cilvalref{d\_storage} - print a storage specifier +\end{itemize} + + You can even customize the pretty-printer by creating instances of +\cilprinter{}. Typically such an instance extends +\cilvalref{defaultCilPrinter}. Once you have a customized pretty-printer you +can use the following printing functions: +\begin{itemize} +\item \cilvalref{printExp} - print an expression +\item \cilvalref{printType} - print a type +\item \cilvalref{printLval} - print an lvalue +\item \cilvalref{printGlobal} - print a global +\item \cilvalref{printStmt} - print a statment +\item \cilvalref{printInstr} - print an instruction +\item \cilvalref{printInit} - print an initializer +\item \cilvalref{printAttr} - print an attribute +\item \cilvalref{printAttrs} - print a set of attributes +\end{itemize} + + + CIL has certain internal consistency invariants. For example, all references +to a global variable must point to the same \t{varinfo} structure. This +ensures that one can rename the variable by changing the name in the +\t{varinfo}. These constraints are mentioned in the API documentation. There +is also a consistency checker in file \t{src/check.ml}. If you suspect that +your transformation is breaking these constraints then you can pass the +\t{-{}-check} option to cilly and this will ensure that the consistency checker +is run after each transformation. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 +\subsection{Attributes}\label{sec-attrib}\cutname{attributes.html} + + In CIL you can attach attributes to types and to names (variables, functions +and fields). Attributes are represented using the type \ciltyperef{attribute}. +An attribute consists of a name and a number of arguments (represented using +the type \ciltyperef{attrparam}). 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 +\cilvalref{typeAttrs} to retrieve the attributes of a type and the functions +\cilvalref{addAttribute} and \cilvalref{addAttributes} to add attributes. +Alternatively you can use \cilvalref{typeAddAttributes} to add an attribute to +a type (and return the new type). + + GCC already has extensive support for attributes, and CIL extends this +support to user-defined attributes. A GCC attribute has the syntax: + +\begin{verbatim} + gccattribute ::= __attribute__((attribute)) (Note the double parentheses) +\end{verbatim} + + 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 +\ciltyperef{attrparam}). When we print attributes, for GCC we add two leading +and two trailing \_; for MSVC we add just two leading \_. + + There is support in CIL so that you can control the printing of attributes +(see \cilvalref{setCustomPrintAttribute} and +\cilvalref{setCustomPrintAttributeScope}). This custom-printing support is now +used to print the "const" qualifier as "\t{const}" and not as +"\t{\_\_attribute\_\_((const))}". + + + 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. + + Name attributes must be specified at the very end of the declaration, just +before the \t{=} for the initializer or before the \t{,} the separates a +declaration in a group of declarations or just before the \t{;} that +terminates the declaration. A name attribute for a function being defined can +be specified just before the brace that starts the function body. + + For example (in the following examples \t{A1},...,\t{An} are type attributes +and \t{N} is a name attribute (each of these uses the \t{\_\_attribute\_\_} syntax): + +\begin{code} + int x N; + int x N, * y N = 0, z[] N; + extern void exit() N; + int fact(int x) N { ... } +\end{verbatim}\end{code} + + + Type attributes can be specified along with the type using the following + rules: +\begin{enumerate} + \item 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). + + For example: +\begin{code} + 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 +\end{verbatim}\end{code} + + \item The type attributes for a pointer type must be specified immediately + after the * symbol. +\begin{code} + /* 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; +\end{verbatim}\end{code} + + + 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. + + \item The attributes for a function type or for an array type can be + specified using parenthesized declarators. + + For example: +\begin{code} + /* 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 & x2; + } +\end{verbatim}\end{code} + +\end{enumerate} + + 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. + + 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: + +\begin{code} + int A2 (A1 )[] +\end{verbatim}\end{code} + + 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: + +\begin{code} + int A2 /*(A1 )*/[] +\end{verbatim}\end{code} + + \paragraph{Handling of predefined GCC attributes} + + 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. + + 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: + +\begin{itemize} + \item GCC name attributes: + + section, constructor, destructor, unused, weak, no\_instrument\_function, + noreturn, alias, no\_check\_memory\_usage, dllinport, dllexport, exception, + model + + 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. + + \item GCC function type attributes: + + fconst (printed as "const"), format, regparm, stdcall, + cdecl, longcall + + 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: + \begin{itemize} + \item 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. + + \item All of the name attributes that appear at the end of a declarator are + associated with the particular name being declared. + + \item 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. + \end{itemize} +\end{itemize} + +\paragraph{Handling of predefined MSVC attributes} + + MSVC has two kinds of attributes, declaration modifiers to be printed before + the storage specifier using the notation "\t{\_\_declspec(...)}" and a few + function type attributes, printed almost as our CIL function type + attributes. + + The following are the name attributes that are printed using + \t{\_\_declspec} right before the storage designator of the declaration: + thread, naked, dllimport, dllexport, noreturn + + + The following are the function type attributes supported by MSVC: + fastcall, cdecl, stdcall + + 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 ! + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{The CIL Driver}\label{sec-driver} + + We have packaged CIL as an application \t{cilly} that contains certain +example modules, such as \t{logwrites.ml} (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 \t{src/main.ml}. Once you compile +CIL you will obtain the file \t{obj/cilly.asm.exe}. + + 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 \t{bin/cilly} and is quite powerful. Note that the \t{cilly} script +is configured during installation with the path where CIL resides. This means +that you can move it to any place you want. + + A simple use of the driver is: +\begin{verbatim} +bin/cilly --save-temps -D HAPPY_MOOD -I myincludes hello.c -o hello +\end{verbatim} + +\c{-{}-save-temps} tells CIL to save the resulting output files in the +current directory. Otherwise, they'll be put in \t{/tmp} and deleted +automatically. Not that this is the only CIL-specific flag in the +list -- the other flags use \t{gcc}'s syntax. + +This performs the following actions: +\begin{itemize} +\item preprocessing using the -D and -I arguments with the resulting + file left in \t{hello.i}, +\item the invocation of the \t{cilly.asm} application which parses \t{hello.i} + converts it to CIL and the pretty-prints it to \t{hello.cil.c} +\item another round of preprocessing with the result placed in \t{hello.cil.i} +\item the true compilation with the result in \t{hello.cil.o} +\item a linking phase with the result in \t{hello} +\end{itemize} + + Note that \t{cilly} behaves like the \t{gcc} compiler. This makes it +easy to use it with existing \t{Makefiles}: +\begin{verbatim} +make CC="bin/cilly" LD="bin/cilly" +\end{verbatim} + + \t{cilly} can also behave as the Microsoft Visual C compiler, if the first + argument is \t{-{}-mode=MSVC}: +\begin{verbatim} +bin/cilly --mode=MSVC /D HAPPY_MOOD /I myincludes hello.c /Fe hello.exe +\end{verbatim} + + (This in turn will pass a \t{-{}-MSVC} flag to the underlying \t{cilly.asm} + process which will make it understand the Microsoft Visual C extensions) + + \t{cilly} can also behave as the archiver \t{ar}, if it is passed an +argument \t{-{}-mode=AR}. Note that only the \t{cr} mode is supported (create a +new archive and replace all files in there). Therefore the previous version of +the archive is lost. + + Furthermore, \t{cilly} allows you to pass some arguments on to the +underlying \t{cilly.asm} process. As a general rule all arguments that start +with \t{-{}-} and that \t{cilly} itself does not process, are passed on. For +example, +\begin{verbatim} +bin/cilly --dologwrites -D HAPPY_MOOD -I myincludes hello.c -o hello.exe +\end{verbatim} + + will produce a file \t{hello.cil.c} that prints all the memory addresses +written by the application. + + The most powerful feature of \t{cilly} 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 \t{-{}-merge} flag to \t{cilly}: +\begin{verbatim} +make CC="bin/cilly --save-temps --dologwrites --merge" +\end{verbatim} + + You can even leave some files untouched: +\begin{verbatim} +make CC="bin/cilly --save-temps --dologwrites --merge --leavealone=foo --leavealone=bar" +\end{verbatim} + + This will merge all the files except those with the basename \t{foo} and +\t{bar}. Those files will be compiled as usual and then linked in at the very +end. + + The sequence of actions performed by \t{cilly} depends on whether merging +is turned on or not: +\begin{itemize} +\item If merging is off + \begin{enumerate} + \item For every file \t{file.c} to compile + \begin{enumerate} + \item Preprocess the file with the given arguments to + produce \t{file.i} + \item Invoke \t{cilly.asm} to produce a \t{file.cil.c} + \item Preprocess to \t{file.cil.i} + \item Invoke the underlying compiler to produce \t{file.cil.o} + \end{enumerate} + \item Link the resulting objects + \end{enumerate} +\item If merging is on + \begin{enumerate} + \item For every file \t{file.c} to compile + \begin{enumerate} + \item Preprocess the file with the given arguments to + produce \t{file.i} + \item Save the preprocessed source as \t{file.o} + \end{enumerate} + \item When linking executable \t{hello.exe}, 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 + \secref{merger}) to produce \t{hello.exe\_comb.c} + \item Invoke \t{cilly.asm} to produce a \t{hello.exe\_comb.cil.c} + \item Preprocess to \t{hello.exe\_comb.cil.i} + \item Invoke the underlying compiler to produce \t{hello.exe\_comb.cil.o} + \item Invoke the actual linker to produce \t{hello.exe} + \end{enumerate} +\end{itemize} + + Note that files that you specify with \t{-{}-leavealone} are not merged and +never presented to CIL. They are compiled as usual and then are linked in at +the end. + + And a final feature of \t{cilly} is that it can substitute copies of the +system's include files: + +\begin{verbatim} +make CC="bin/cilly --includedir=myinclude" +\end{verbatim} + + This will force the preprocessor to use the file \t{myinclude/xxx/stdio.h} +(if it exists) whenever it encounters \t{\#include }. The \t{xxx} is +a string that identifies the compiler version you are using. This modified +include files should be produced with the patcher script (see +\secref{patcher}). + + \subsection{\t{cilly} Options} + + Among the options for the \t{cilly} you can put anything that can normally +go in the command line of the compiler that \t{cilly} is impersonating. +\t{cilly} 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 \t{cilly -{}-help}): + +\begin{itemize} +\item \t{-{}-mode=mode} This must be the first argument if present. It makes +\t{cilly} behave as a given compiled. The following modes are recognized: + \begin{itemize} + \item GNUCC - the GNU C Compiler. This is the default. + \item MSVC - the Microsoft Visual C compiler. Of course, you should + pass only MSVC valid options in this case. + \item AR - the archiver \t{ar}. Only the mode \t{cr} is supported and + the original version of the archive is lost. + \end{itemize} +\item \t{-{}-help} Prints a list of the options supported. +\item \t{-{}-verbose} Prints lots of messages about what is going on. +\item \t{-{}-stages} Less than \t{-{}-verbose} but lets you see what \t{cilly} + is doing. +\item \t{-{}-merge} This tells \t{cilly} to first attempt to collect into one +source file all of the sources that make your application, and then to apply +\t{cilly.asm} on the resulting source. The sequence of actions in this case is +described above and the merger itself is described in \secref{merger}. + +\item \t{-{}-leavealone=xxx}. 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. +\item \t{-{}-includedir=xxx}. 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 \secref{patcher}). In particular this means that +that directory contains subdirectories named based on the current compiler +version. The patcher creates those directories. +\item \t{-{}-usecabs}. 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. +\item \t{-{}-save-temps=xxx}. Temporary files are preserved in the xxx + directory. For example, the output of CIL will be put in a file + named \t{*.cil.c}. +\item \t{-{}-save-temps}. Temporay files are preserved in the current directory. +\end{itemize} + + + \subsection{\t{cilly.asm} Options} + \label{sec-cilly-asm-options} + + All of the options that start with \t{-{}-} and are not understood by +\t{cilly} are passed on to \t{cilly.asm}. \t{cilly} also passes along to +\t{cilly.asm} flags such as \t{-{}-MSVC} that both need to know +about. The following options are supported. Many of these flags also +have corresponding ``\t{-{}-no}*'' versions if you need to go back to +the default, as in ``\t{-{}-nowarnall}''. + +\hspace*{2cm} {\bf General Options:} +\begin{itemize} + \item \t{-{}-version} output version information and exit + \item \t{-{}-verbose} Print lots of random stuff. This is passed on from cilly + \item \t{-{}-warnall} Show all warnings. + \item \t{-{}-debug=xxx} turns on debugging flag xxx + \item \t{-{}-nodebug=xxx} turns off debugging flag xxx + \item \t{-{}-flush} Flush the output streams often (aids debugging). + \item \t{-{}-check} Run a consistency check over the CIL after every operation. + \item \t{-{}-strictcheck} Same as \t{-{}-check}, but it treats + consistency problems as errors instead of warnings. + \item \t{-{}-nocheck} turns off consistency checking of CIL. + \item \t{-{}-noPrintLn} Don't output \#line directives in the output. + \item \t{-{}-commPrintLn} Print \#line directives in the output, but + put them in comments. + \item \t{-{}-commPrintLnSparse} Like \t{-{}-commPrintLn} but print only new + line numbers. + \item \t{-{}-log=xxx} Set the name of the log file. By default stderr is used + \item \t{-{}-MSVC} Enable MSVC compatibility. Default is GNU. + %\item \t{-{}-testcil} test CIL using the given compiler + \item \t{-{}-ignore-merge-conflicts} ignore merging conflicts. + %\item \t{-{}-sliceGlobal} output is the slice of #pragma cilnoremove(sym) symbols + %\item \t{-{}-tr }: subsystem to show debug printfs for + %\item \t{-{}-pdepth=n}: set max print depth (default: 5) + \item \t{-{}-extrafiles=filename}: the name of a file that contains + a list of additional files to process, separated by whitespace. + \item \t{-{}-stats} 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 + (\t{Stats.time ``label'' func arg}) will evaluate \t{(func arg)} + and remember how long this takes. If you call \t{Stats.time} + repeatedly with the same label, CIL will report the aggregate + time. + + If available, CIL uses the x86 performance counters for these + stats. This is very precise, but results in ``wall-clock time.'' + To report only user-mode time, find the call to \t{Stats.reset} in + \t{main.ml}, and change it to \t{Stats.reset Stats.SoftwareTimer}. + + {\bf Lowering Options} + \item \t{-{}-noLowerConstants} do not lower constant expressions. + \item \t{-{}-noInsertImplicitCasts} do not insert implicit casts. + \item \t{-{}-forceRLArgEval} Forces right to left evaluation of function arguments. + %\item \t{-{}-nocil=n} Do not compile to CIL the global with the given index. + \item \t{-{}-disallowDuplication} Prevent small chunks of code from being duplicated. + \item \t{-{}-keepunused} Do not remove the unused variables and types. + \item \t{-{}-rmUnusedInlines} Delete any unused inline functions. This is the default in MSVC mode. + + {\bf Output Options:} + \item \t{-{}-printCilAsIs} Do not try to simplify the CIL when + printing. Without this flag, CIL will attempt to produce prettier + output by e.g. changing \t{while(1)} into more meaningful loops. + \item \t{-{}-noWrap} do not wrap long lines when printing + \item \t{-{}-out=xxx} the name of the output CIL file. \t{cilly} + sets this for you. + \item \t{-{}-mergedout=xxx} specify the name of the merged file + \item \t{-{}-cabsonly=xxx} CABS output file name +%% \item \t{-{}-printComments : print cabs tree structure in comments in cabs output +%% \item \t{-{}-patchFile : name the file containing patching transformations +%% \item \t{-{}-printPatched : print patched CABS files after patching, to *.patched +%% \item \t{-{}-printProtos : print prototypes to safec.proto.h after parsing + + {\bf Selected features.} See \secref{Extension} for more information. +\item \t{-{}-dologcalls}. Insert code in the processed source to print the name of +functions as are called. Implemented in \t{src/ext/logcalls.ml}. +\item \t{-{}-dologwrites}. Insert code in the processed source to print the +address of all memory writes. Implemented in \t{src/ext/logwrites.ml}. +\item \t{-{}-dooneRet}. Make each function have at most one 'return'. +Implemented in \t{src/ext/oneret.ml}. +\item \t{-{}-dostackGuard}. Instrument function calls and returns to +maintain a separate stack for return addresses. Implemeted in +\t{src/ext/heapify.ml}. +\item \t{-{}-domakeCFG}. Make the program look more like a CFG. Implemented +in \t{src/cil.ml}. +\item \t{-{}-dopartial}. Do interprocedural partial evaluation and +constant folding. Implemented in \t{src/ext/partial.ml}. +\item \t{-{}-dosimpleMem}. Simplify all memory expressions. Implemented in +\t{src/ext/simplemem.ml}. + +For an up-to-date list of available options, run \t{cilly.asm -{}-help}. + +\end{itemize} + +\subsection{Internal Options} +\label{sec-cilly-internal-options} + +All of the \t{cilly.asm} options described above can be set +programmatically -- see \t{src/ciloptions.ml} or the individual +extensions to see how. Some options should be set before parsing to +be effective. + +Additionally, a few CIL options have no command-line flag and can only +be set programmatically. These options may be useful for certain +analyses: + +\begin{itemize} +\item \t{Cabs2cil.doCollapseCallCast}:This is false by default. Set +to true to replicate the behavior of CIL 1.3.5 and earlier. + +When false, all casts in the program are made explicit using the +\t{CastE} expression. Accordingly, the destination of a Call +instruction will always have the same type as the function's return +type. + +If true, the destination type of a Call may differ from the return type, so +there is an implicit cast. This is useful for analyses involving +\t{malloc}. Without this option, CIL converts ``\t{T* x = malloc(n);}'' +into ``\t{void* tmp = malloc(n); T* x = (T*)tmp;}''. If you don't +need all casts to be made explicit, you can set +\t{Cabs2cil.doCollapseCallCast} to true so that CIL won't insert a +temporary and you can more easily determine the allocation type from +calls to \t{malloc}. + + +\end{itemize} + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Library of CIL Modules} \label{sec-Extension}\cutname{ext.html} + + 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 +(\ahrefurl{../ccured/index.html}). + +\subsection{Control-Flow Graphs} \label{sec-cfg} + +The \ciltyperef{stmt} 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 using one of these two methods: + +\subsubsection{The CFG module (new in CIL 1.3.5)} + +The best way to compute the CFG is with the CFG module. Just invoke +\cfgref{computeFileCFG} on your file. The \moduleref{Cfg} 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 +\t{dot} form. + + +\subsubsection{Simplified control flow} + +CIL can reduce high-level C control-flow constructs like \t{switch} and +\t{continue} to lower-level \t{goto}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). + +You can invoke this transformation on the command line with +\t{-{}-domakeCFG} or programatically with \cilvalref{prepareCFG}. +After calling Cil.prepareCFG, you can use \cilvalref{computeCFGInfo} +to compute the CFG information and find the successor and predecessor +of each statement. + +For a concrete example, you can see how \t{cilly -{}-domakeCFG} +transforms the following code (note the fall-through in case 1): + +\begin{cilcode}[global] --domakeCFG + 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; + } +\end{cilcode} + +\subsection{Data flow analysis framework} + + The \moduleref{Dataflow} 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 (\secref{cfg}) +before invoking the Dataflow module. + + +\subsection{Inliner} + + The file ext/inliner.ml contains a function inliner. + +\subsection{Dominators} + + The module \moduleref{Dominators} contains the computation of immediate + dominators. It uses the \moduleref{Dataflow} module. + +\subsection{Points-to Analysis} + +The module \t{ptranal.ml} contains two interprocedural points-to +analyses for CIL: \t{Olf} and \t{Golf}. \t{Olf} is the default. +(Switching from \t{olf.ml} to \t{golf.ml} requires a change in +\t{Ptranal} and a recompiling \t{cilly}.) + +The analyses have the following characteristics: +\begin{itemize} +\item Not based on C types (inferred pointer relationships are sound + despite most kinds of C casts) +\item One level of subtyping +\item One level of context sensitivity (Golf only) +\item Monomorphic type structures +\item Field insensitive (fields of structs are conflated) +\item Demand-driven (points-to queries are solved on demand) +\item Handle function pointers +\end{itemize} + +The analysis itself is factored into two components: \t{Ptranal}, +which walks over the CIL file and generates constraints, and \t{Olf} +or \t{Golf}, which solve the constraints. The analysis is invoked +with the function \t{Ptranal.analyze\_file: Cil.file -> + unit}. 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 \t{Ptranal.analyze\_file} should only be called +once. + +%%% Interface for querying the points-to graph... +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?). + +%%% Main Interface +The main interface with the alias analysis is as follows: +\begin{itemize} +\item \t{Ptranal.may\_alias: Cil.exp -> Cil.exp -> bool}. If + \t{true}, the two expressions may have the same value. +\item \t{Ptranal.resolve\_lval: Cil.lval -> (Cil.varinfo + list)}. Returns the list of variables to which the given + left-hand value may point. +\item \t{Ptranal.resolve\_exp: Cil.exp -> (Cil.varinfo list)}. + Returns the list of variables to which the given expression may + point. +\item \t{Ptranal.resolve\_funptr: Cil.exp -> (Cil.fundec + list)}. Returns the list of functions to which the given + expression may point. +\end{itemize} + +%%% Controlling the analysis +The precision of the analysis can be customized by changing the values +of several flags: + +\begin{itemize} +\item \t{Ptranal.no\_sub: bool ref}. + If \t{true}, subtyping is disabled. Associated commandline option: + {\bf -{}-ptr\_unify}. +\item \t{Ptranal.analyze\_mono: bool ref}. + (Golf only) If \t{true}, context sensitivity is disabled and the + analysis is effectively monomorphic. Commandline option: + {\bf -{}-ptr\_mono}. +\item \t{Ptranal.smart\_aliases: bool ref}. + (Golf only) If \t{true}, ``smart'' disambiguation of aliases is + enabled. Otherwise, aliases are computed by intersecting points-to + sets. This is an experimental feature. +\item \t{Ptranal.model\_strings: bool ref}. + Make the alias analysis model string constants by treating them as + pointers to chars. Commandline option: {\bf -{}-ptr\_model\_strings} +\item \t{Ptranal.conservative\_undefineds: bool ref}. + Make the most pessimistic assumptions about globals if an undefined + function is present. Such a function can write to every global + variable. Commandline option: {\bf -{}-ptr\_conservative} +\end{itemize} + +In practice, the best precision/efficiency tradeoff is achieved by +setting \t{Ptranal.no\_sub} to \t{false}, \t{Ptranal.analyze\_mono} to +\t{true}, and \t{Ptranal.smart\_aliases} to \t{false}. These are the +default values of the flags. + +%%% Debug output +There are also a few flags that can be used to inspect or serialize +the results of the analysis. +\begin{itemize} +%%\item \t{Ptranal.ptrResults}. +%% Commandline option: {\bf -{}-ptr\_results}. A no-op! +%% +%%\item \t{Ptranal.ptrTypes}. +%% Commandline option: {\bf -{}-ptr\_types}. A no-op! +%% +\item \t{Ptranal.debug\_may\_aliases}. + Print the may-alias relationship of each pair of expressions in the + program. Commandline option: {\bf -{}-ptr\_may\_aliases}. +\item \t{Ptranal.print\_constraints: bool ref}. + If \t{true}, the analysis will print each constraint as it is + generated. +\item \t{Ptranal.print\_types: bool ref}. + If \t{true}, the analysis will print the inferred type of each + variable in the program. + + If \t{Ptranal.analyze\_mono} and \t{Ptranal.no\_sub} are both + \t{true}, 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. +\item \t{Ptranal.compute\_results: bool ref}. + If \t{true}, the analysis will print out the points-to set of each + variable in the program. This will essentially serialize the + points-to graph. +\end{itemize} + +\subsection{StackGuard} + +The module \t{heapify.ml} contains a transformation similar to the one +described in ``StackGuard: Automatic Adaptive Detection and Prevention of +Buffer-Overflow Attacks'', {\em Proceedings of the 7th USENIX Security +Conference}. 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. + +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. + +For a concrete example, you can see how \t{cilly -{}-dostackGuard} +transforms the following dangerous code: + +\begin{cilcode}[global] --dostackGuard + int dangerous() { + char array[10]; + scanf("%s",array); // possible buffer overrun! + } + + int main () { + return dangerous(); + } +\end{cilcode} + + +\subsection{Heapify} + +The module \t{heapify.ml} also contains a transformation that moves all +dangerous local arrays to the heap. This also prevents a number of buffer +overruns. + +For a concrete example, you can see how \t{cilly -{}-doheapify} +transforms the following dangerous code: + +\begin{cilcode}[global] --doheapify + int dangerous() { + char array[10]; + scanf("%s",array); // possible buffer overrun! + } + + int main () { + return dangerous(); + } +\end{cilcode} + +\subsection{One Return} + +The module \t{oneret.ml} 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. + +For a concrete example, you can see how \t{cilly -{}-dooneRet} +transforms the following code: + +\begin{cilcode}[global] --dooneRet + int foo (int predicate) { + if (predicate <= 0) { + return 1; + } else { + if (predicate > 5) + return 2; + return 3; + } + } +\end{cilcode} + +\subsection{Partial Evaluation and Constant Folding} + +The \t{partial.ml} module provides a simple interprocedural partial +evaluation and constant folding data-flow analysis and transformation. +This transformation always requires the \t{-{}-domakeCFG} option. It +performs: +\begin{itemize} +\item Constant folding even of compiler-dependent constants as, for + example \t{sizeof(T)}. +\item \t{if}-statement simplification for conditional expressions that + evaluate to a constant. The \t{if}-statement gets replaced with the + taken branch. +\item Call elimination for + \begin{enumerate} + \item\label{enum:partial-empty-proc} empty functions and + \item\label{enum:partial-const-func} functions that return a + constant. + \end{enumerate} + In case~\ref{enum:partial-empty-proc} the call disappears completely + and in case~\ref{enum:partial-const-func} it is replaced by the + constant the function returns. +\end{itemize} + +Several commandline options control the behavior of the feature. +\begin{itemize} +\item \t{-{}-partial\_no\_global\_const}: + Treat global constants as unknown values. This is the default. +\item \t{-{}-partial\_global\_const}: + Treat global constants as initialized. Let global constants + participate in the partial evaluation. +\item \t{-{}-partial\_root\_function} \i{function-name}: + Name of the function where the simplification starts. Default: + \t{main}. +\item \t{-{}-partial\_use\_easy\_alias} + Use Partial's built-in easy alias to analyze pointers. This is the + default. +\item \t{-{}-partial\_use\_ptranal\_alias} + Use feature Ptranal to analyze pointers. Setting this option + requires \t{-{}-doptranal}. +\end{itemize} + +For a concrete example, you can see how \t{cilly -{}-domakeCFG -{}-dopartial} +transforms the following code (note the eliminated \t{if}-branch and the +partial optimization of \t{foo}): + +\begin{cilcode}[global] --domakeCFG --dopartial + int foo(int x, int y) { + int unknown; + if (unknown) + return y + 2; + return x + 3; + } + + int bar(void) { + return -1; + } + + int main(void) { + int a, b, c; + a = foo(5, 7) + foo(6, 7) + bar(); + b = 4; + c = b * b; + if (b > c) + return b - c; + else + return b + c; + } +\end{cilcode} + +\subsection{Reaching Definitions} + +The \t{reachingdefs.ml} module uses the dataflow framework and CFG +information to calculate the definitions that reach each +statement. After computing the CFG (\secref{cfg}) and calling +\t{computeRDs} on a +function declaration, \t{ReachingDef.stmtStartData} 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 \t{Some(i)}, then the definition of that variable +with ID \t{i} reaches that statement. If the set contains \t{None}, +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. + +To summarize, reachingdefs.ml has the following interface: +\begin{itemize} +\item \t{computeRDs} -- Computes reaching definitions. Requires that +CFG information has already been computed for each statement. +\item \t{ReachingDef.stmtStartData} -- contains reaching +definition data after \t{computeRDs} is called. +\item \t{ReachingDef.defIdStmtHash} -- Contains a mapping +from definition IDs to the ID of the statement in which +the definition occurs. +\item \t{getRDs} -- Takes a statement ID and returns +reaching definition data for that statement. +\item \t{instrRDs} -- 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. +\item \t{rdVisitorClass} -- A subclass of nopCilVisitor that +can be extended such that the current reaching definition +data is available when expressions are visited through +the \t{get\_cur\_iosh} method of the class. +\end{itemize} + +\subsection{Available Expressions} + +The \t{availexps.ml} module uses the dataflow framework and CFG +information to calculate something similar to a traditional available +expressions analysis. After \t{computeAEs} is called following a CFG +calculation (\secref{cfg}), \t{AvailableExps.stmtStartData} 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. + +The interface is as follows: +\begin{itemize} +\item \t{computeAEs} -- Computes available expressions. Requires +that CFG information has already been comptued for each statement. +\item \t{AvailableExps.stmtStartData} -- Contains available +expressions data for each statement after \t{computeAEs} has been +called. +\item \t{getAEs} -- Takes a statement ID and returns +available expression data for that statement. +\item \t{instrAEs} -- 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. +\item \t{aeVisitorClass} -- A subclass of nopCilVisitor that +can be extended such that the current available expressions +data is available when expressions are visited through the +\t{get\_cur\_eh} method of the class. +\end{itemize} + +\subsection{Liveness Analysis} + +The \t{liveness.ml} module uses the dataflow framework and +CFG information to calculate which variables are live at +each program point. After \t{computeLiveness} is called +following a CFG calculation (\secref{cfg}), \t{LiveFlow.stmtStartData} will +contain a mapping for each statement ID to a set of \t{varinfo}s +for varialbes live at that program point. + +The interface is as follows: +\begin{itemize} +\item \t{computeLiveness} -- Computes live variables. Requires +that CFG information has already been computed for each statement. +\item \t{LiveFlow.stmtStartData} -- Contains live variable data +for each statement after \t{computeLiveness} has been called. +\end{itemize} + +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. + +\begin{itemize} +\item \t{-{}-doliveness} -- Instructs cilly to comptue liveness +information and to print on standard out the variables live +at the points specified by \t{-{}-live\_func} and \t{live\_label}. +If both are ommitted, then nothing is printed. +\item \t{-{}-live\_func} -- The name of the function whose +liveness data is of interest. If \t{-{}-live\_label} is ommitted, +then data for each statement is printed. +\item \t{-{}-live\_label} -- The name of the label at which +the liveness data will be printed. +\end{itemize} + +\subsection{Dead Code Elimination} + +The module \t{deadcodeelim.ml} uses the reaching definitions +analysis to eliminate assignment instructions whose results +are not used. The interface is as follows: + +\begin{itemize} +\item \t{elim\_dead\_code} -- Performs dead code elimination +on a function. Requires that CFG information has already +been computed (\secref{cfg}). +\item \t{dce} -- Performs dead code elimination on an +entire file. Requires that CFG information has already +been computed. +\end{itemize} + +\subsection{Simple Memory Operations} + +The \t{simplemem.ml} 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. + +For a concrete example, you can see how \t{cilly -{}-dosimpleMem} +transforms the following code: + +\begin{cilcode}[global] --dosimpleMem + int main () { + int ***three; + int **two; + ***three = **two; + } +\end{cilcode} + +\subsection{Simple Three-Address Code} + +The \t{simplify.ml} 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: +\begin{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" +\end{verbatim} +In addition, all \t{sizeof} and \t{alignof} 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. + +For a concrete example, you can see how \t{cilly -{}-dosimplify} +transforms the following code: + +\begin{cilcode}[global] --dosimplify + int main() { + struct mystruct { + int a; + int b; + } m; + int local; + int arr[3]; + int *ptr; + + ptr = &local; + m.a = local + sizeof(m) + arr[2]; + return m.a; + } +\end{cilcode} + +\subsection{Converting C to C++} + +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 --- certain fixes which are necessary +for some programs are not yet implemented. + +Using the \t{-{}-doCanonicalize} option with CIL will perform the +following changes to your program: + +\begin{enumerate} +\item Any variables that use C++ keywords as identifiers are renamed. +\item C allows global variables to have multiple declarations and + multiple (equivalent) definitions. This transformation removes + all but one declaration and all but one definition. +\item \t{\_\_inline} is \#defined to \t{inline}, and \t{\_\_restrict} + is \#defined to nothing. +\item 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. +\item Makes casts from int to enum types explicit. (CIL changes enum + constants to int constants, but doesn't use a cast.) +\end{enumerate} + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Controlling CIL} + + 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 \t{-{}-keepunused} argument +to the CIL application. + + Alternatively you can put the following pragma in the code (instructing CIL +to specifically keep the declarations and definitions of the function +\t{func1} and variable \t{var2}, the definition of type \t{foo} and of +structure \t{bar}): +\begin{code} +#pragma cilnoremove("func1", "var2", "type foo", "struct bar") +\end{verbatim}\end{code} + + + +\section{GCC Extensions} + + The CIL parser handles most of the \t{gcc} +\ahreftop{http://gcc.gnu.org/onlinedocs/gcc-3.0.2/gcc\_5.html#SEC67}{extensions} +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): + +\begin{enumerate} +\item Nested function definitions. +\item Constructing function calls. +\item Naming an expression's type. +\item Complex numbers +\item Hex floats +\item Subscripts on non-lvalue arrays. +\item Forward function parameter declarations +\end{enumerate} + + The following extensions are handled, typically by compiling them away: +\begin{enumerate} +\item Attributes for functions, variables and types. In fact, we have a clear +specification (see \secref{attrib}) of how attributes are interpreted. The +specification extends that of \t{gcc}. +\item Old-style function definitions and prototypes. These are translated to +new-style. +\item Locally-declared labels. As part of the translation to CIL, we generate +new labels as needed. +\item 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 \t{goto} in the body +of the function is replaced with a \t{switch} statement. If you want to invoke +the label from another function, you are on your own (the \t{gcc} +documentation says the same.) +\item Generalized lvalues. You can write code like \t{(a, b) += 5} and it gets +translated to CIL. +\item Conditionals with omitted operands. Things like \t{x ? : y} are +translated to CIL. +\item Double word integers. The type \t{long long} and the \t{LL} suffix on +constants is understood. This is currently interpreted as 64-bit integers. +\item Local arrays of variable length. These are converted to uses of +\t{alloca}, the array variable is replaced with a pointer to the allocated +array and the instances of \t{sizeof(a)} are adjusted to return the size of +the array and not the size of the pointer. +\item Non-constant local initializers. Like all local initializers these are +compiled into assignments. +\item Compound literals. These are also turned into assignments. +\item Designated initializers. The CIL parser actually supports the full ISO +syntax for initializers, which is more than both \t{gcc} and \t{MSVC}. 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. +\item Case ranges. These are compiled into separate cases. There is no code +duplication, just a larger number of \t{case} statements. +\item 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. + +\item Inline assembly-language. The full syntax is supported and it is carried +as such in CIL. + +\item Function names as strings. The identifiers \t{\_\_FUNCTION\_\_} and +\t{\_\_PRETTY\_FUNCTION\_\_} are replaced with string literals. + +\item Keywords \t{typeof}, \t{alignof}, \t{inline} are supported. +\end{enumerate} + +\section{CIL Limitations} + + There are several implementation details of CIL that might make it unusable + or less than ideal for certain tasks: + +\begin{itemize} +\item 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 +\t{\#define}s that we don't like into function calls. + +\item 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 \t{e1, e2++} +exactly as it appears in the code, then you should not use CIL. + +\item 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 \t{const} qualifier. + +\end{itemize} + +\section{Known Bugs and Limitations} + +\subsection{Code that CIL won't compile} +\begin{itemize} +\item We do not support tri-graph sequences (ISO 5.2.1.1). + +\item CIL cannot parse arbitrary \t{\#pragma} 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 \t{no\_parse\_pragma} in \t{src/frontc/clexer.mll} to indicate that + CIL should treat that pragma as a monolithic string rather than try + to parse its arguments. + + CIL cannot parse a line containing an empty \t{\#pragma}. + +\item CIL only parses \t{\#pragma} directives at the "top level", this is, + outside of any enum, structure, union, or function definitions. + + 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. + +\item CIL cannot parse the following code (fixing this problem would require + extensive hacking of the LALR grammar): +\begin{code} +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) +\end{verbatim}\end{code} + +\item CIL also cannot parse certain K\&R old-style prototypes with missing + return type: +\begin{code} +g(); // This cannot be parsed +int g(); // This is Ok +\end{verbatim}\end{code} + +\item CIL does not understand some obscure combinations of type + specifiers (``signed'' and ``unsigned'' applied to typedefs that + themselves contain a sign specification; you could argue that this + should not be allowed anyway): +\begin{code} +typedef signed char __s8; +__s8 unsigned uchartest; // This is unsigned char for gcc +\end{verbatim}\end{code} + +\item CIL does not support constant-folding of floating-point values, + because it is difficult to simulate the behavior of various + C floating-point implementations in Ocaml. Therefore, code such as + this will not compile: +\begin{code} +int globalArray[(1.0 < 2.0) ? 5 : 50] +\end{verbatim}\end{code} + +\item CIL uses Ocaml ints to represent the size of an object. + Therefore, it can't compute the size of any object that is larger + than $2^{30}$ bits (134 MB) on 32-bit computers, or $2^{62}$ bits on + 64-bit computers. + +\end{itemize} + +\subsection{Code that behaves differently under CIL} + +\begin{itemize} +\item GCC has a strange feature called ``extern inline''. Such a function can +be defined twice: first with the ``extern inline'' specifier and the second +time without it. If optimizations are turned off then the ``extern inline'' +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. + +CIL will assume optimizations are on, and rename your extern inline +function (and its uses) with the suffix +\t{\_\_extinline}. 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 ! + +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. + +\item The implementation of \t{bitsSizeOf} 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. + +\item \t{-malign-double} is ignored. + +\item The statement \t{x = 3 + x ++} will perform the increment of \t{x} + before the assignment, while \t{gcc} 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 \t{x = x ++;} then CIL will perform + the increment before the assignment, whereas GCC and MSVC will perform it + after the assignment. + +\item Because CIL uses 64-bit floating point numbers in its internal + representation of floating point numbers, \t{long double} constants + are parsed as if they were \t{double} constants. + +\end{itemize} + +\subsection{Effects of the CIL translation} +\begin{itemize} +\item CIL cleans up C code in various ways that may suppress compiler + warnings. For example, CIL will add casts where they are needed + while \t{gcc} might print a warning for the missing cast. It is + not a goal of CIL to emit such warnings --- we support several + versions of several different compilers, and mimicking the warnings + of each is simply not possible. If you want to see compiler + warnings, compile your program with your favorite compiler before + using CIL. + +\item When you use variable-length arrays, CIL turns them into calls + to \t{alloca}. This means that they are deallocated when the + function returns and not when the local scope ends. + + Variable-length arrays are not supported as fields of a struct or union. + +\item In the new versions of \t{glibc} there is a function + \t{\_\_builtin\_va\_arg} 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: +\begin{verbatim} + mytype x = __builtin_va_arg(marker, mytype) +\end{verbatim} + into +\begin{verbatim} + mytype x; + __builtin_va_arg(marker, sizeof(mytype), &x); +\end{verbatim} + + The latter form is used internally in CIL. However, the CIL pretty printer + will try to emit the original code. + + Similarly, \t{\_\_builtin\_types\_compatible\_p(t1, t2)}, which takes + types as arguments, is represented internally as + \t{\_\_builtin\_types\_compatible\_p(sizeof t1, sizeof t2)}, but the + sizeofs are removed when printing. + +\end{itemize} + + + + + + \section{Using the merger}\label{sec-merger}\cutname{merger.html} + + There are many program analyses that are more effective when +done on the whole program. + + 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: +\begin{enumerate} +\item Detect what are all the sources that make a project and with what +compiler arguments they are compiled. + +\item Merge all of the source files into a single file. +\end{enumerate} + + 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. + + 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. + + 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: + +\begin{itemize} +\item File-scope names (\t{static} globals, names of types defined with +\t{typedef}, 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 \t{\_\_\_n}, where \t{n} is a unique integer +identifier. Then the new names are applied to their occurrences in the file. + +\item 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 +\t{inline} functions, since these occasionally appear in include files. + +\item 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 {\bf +required} for the merged program to be legal. Such structure tags and +typenames are coalesced and given the same name. + +\item 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. + +\item 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. +\end{itemize} + + Here is an example of using the merger: + + The contents of \t{file1.c} is: +\begin{code} +struct foo; // Forward declaration +extern struct foo *global; +\end{verbatim}\end{code} + + The contents of \t{file2.c} is: + +\begin{code} +struct bar { + int x; + struct bar *next; +}; +extern struct bar *global; +struct foo { + int y; +}; +extern struct foo another; +void main() { +} +\end{verbatim}\end{code} + + There are several ways in which one might create an executable from these +files: +\begin{itemize} +\item +\begin{verbatim} +gcc file1.c file2.c -o a.out +\end{verbatim} + +\item +\begin{verbatim} +gcc -c file1.c -o file1.o +gcc -c file2.c -o file2.o +ld file1.o file2.o -o a.out +\end{verbatim} + +\item +\begin{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 +\end{verbatim} + +\item +\begin{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 +\end{verbatim} +\end{itemize} + + In each of the cases above you must replace all occurrences of \t{gcc} and +\t{ld} with \t{cilly -{}-merge}, and all occurrences of \t{ar} with \t{cilly +-{}-merge -{}-mode=AR}. It is very important that the \t{-{}-merge} flag be used +throughout the build process. If you want to see the merged source file you +must also pass the \t{-{}-keepmerged} flag to the linking phase. + + The result of merging file1.c and file2.c is: +\begin{code} +// 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; +\end{verbatim}\end{code} + + \section{Using the patcher}\label{sec-patcher}\cutname{patcher.html} + + 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. + + The patcher is invoked as follows: +\begin{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 ) + + --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. +\end{verbatim} + + Based on the given \t{mode} and the current version of the compiler (which +the patcher can print when given the \t{dumpversion} argument) the patcher +will create a subdirectory of the \t{dest} directory (say \t{/usr/home/necula/cil/include}), such as: +\begin{verbatim} +/usr/home/necula/cil/include/gcc_2.95.3-5 +\end{verbatim} + + In that file the patcher will copy the modified versions of the include files +specified with the \t{ufile} and \t{sfile} options. Each of these options can +be specified multiple times. + + The patch file (specified with the \t{patch} option) has a format inspired by +the Unix \t{patch} tool. The file has the following grammar: + +\begin{verbatim} +<<< flags +patterns +=== +replacement +>>> +\end{verbatim} + + The flags are a comma separated, case-sensitive, sequence of keywords or +keyword = value. The following flags are supported: +\begin{itemize} +\item \t{file=foo.h} - will only apply the patch on files whose name is + \t{foo.h}. +\item \t{optional} - this means that it is Ok if the current patch does not +match any of the processed files. +\item \t{group=foo} - 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. +\item \t{system=sysname} - will only consider this pattern on a given +operating system. The ``sysname'' is reported by the ``\$\^O'' variable in +Perl, except that Windows is always considered to have sysname +``cygwin.'' For Linux use ``linux'' (capitalization matters). +\item \t{ateof} - In this case the patterns are ignored and the replacement +text is placed at the end of the patched file. Use the \t{file} flag if you +want to restrict the files in which this replacement is performed. +\item \t{atsof} - The patterns are ignored and the replacement text is placed +at the start of the patched file. Uf the \t{file} flag to restrict the +application of this patch to a certain file. +\item \t{disabled} - Use this flag if you want to disable the pattern. +\end{itemize} + + + The patterns can consist of several groups of lines separated by the \t{|||} +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. + + The matching is space-insensitive. + + All of the markers \t{<<<}, \t{|||}, \t{===} and \t{>>>} must appear at the +beginning of a line but they can be followed by arbitrary text (which is +ignored). + + The replacement text can contain the special keyword \t{@\_\_pattern\_\_@}, +which is substituted with the pattern that matched. + + +\section{Debugging support}\label{sec-debugger} + + 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: +\begin{verbatim} +cilly -c hello.c +\end{verbatim} + + You must follow the installation \ahref{../ccured/setup.html}{instructions} +to install the Elist support files for ocaml and to extend your .emacs +appropriately. Then from within Emacs you do +\begin{verbatim} +ALT-X my-camldebug +\end{verbatim} + + This will ask you for the command to use for running the Ocaml debugger +(initially the default will be ``ocamldebug'' or the last command you +introduced). You use the following command: +\begin{verbatim} +cilly --ocamldebug -c hello.c +\end{verbatim} + + This will run \t{cilly} 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. + + +\section{Who Says C is Simple?}\label{sec-simplec} + + 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). + + 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?}. The second one was : {\em +What the hell does it mean?}. + + 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. + +% +% Note: the cilcode environment is bogus. You should preprocess this source +% with cilcode.pl !!! +% +% + \subsection{Standard C} + +\begin{enumerate} + +\item Why does the following code return 0 for most values of \t{x}? (This +should be easy.) + +\begin{cilcode}[local] + int x; + return x == (1 && x); +\end{cilcode} + +\item Why does the following code return 0 and not -1? (Answer: because +\t{sizeof} is unsigned, thus the result of the subtraction is unsigned, thus +the shift is logical.) + +\begin{cilcode}[local] + return ((1 - sizeof(int)) >> 32); +\end{cilcode} + +\item Scoping rules can be tricky. This function returns 5. + +\begin{cilcode}[global] +int x = 5; +int f() { + int x = 3; + { + extern int x; + return x; + } +} +\end{cilcode} + +\item Functions and function pointers are implicitly converted to each other. + +\begin{cilcode}[global] +int (*pf)(void); +int f(void) { + + pf = &f; // This looks ok + pf = ***f; // Dereference a function? + pf(); // Invoke a function pointer? + (****pf)(); // Looks strange but Ok + (***************f)(); // Also Ok +} +\end{cilcode} + +\item 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 \t{i.nested.y} and \t{i.nested.z}? (Answer: 2 and respectively +6). + +\begin{cilcode}[global] +struct { + int x; + struct { + int y, z; + } nested; +} i = { .nested.y = 5, 6, .x = 1, 2 }; +\end{cilcode} + +\item This is from c-torture. This function returns 1. + +\begin{cilcode}[global] +typedef struct +{ + char *key; + char *value; +} T1; + +typedef struct +{ + long type; + char *value; +} T3; + +T1 a[] = +{ + { + "", + ((char *)&((T3) {1, (char *) 1})) + } +}; +int main() { + T3 *pt3 = (T3*)a[0].value; + return pt3->value; +} +\end{cilcode} + +\item 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. + +\begin{cilcode}[local] + return ((int []){1,2,3,4})[1]; +\end{cilcode} + +\item In the example below there is one copy of ``bar'' and two copies of + ``pbar'' (static prototypes at block scope have file scope, while for all + other types they have block scope). + +\begin{cilcode}[global] + int foo() { + static bar(); + static (*pbar)() = bar; + + } + + static bar() { + return 1; + } + + static (*pbar)() = 0; +\end{cilcode} + + +\item 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: +\begin{cilcode}[global] + unsigned long foo() { + return (unsigned long) - 1 / 8; + } +\end{cilcode} + + The correct interpretation is \t{((unsigned long) - 1) / 8}, which is a + relatively large number, as opposed to \t{(unsigned long) (- 1 / 8)}, which + is 0. + +\end{enumerate} + + \subsection{GCC ugliness}\label{sec-ugly-gcc} + +\begin{enumerate} + +\item GCC has generalized lvalues. You can take the address of a lot of +strange things: + +\begin{cilcode}[local] + int x, y, z; + return &(x ? y : z) - & (x++, x); +\end{cilcode} + +\item GCC lets you omit the second component of a conditional expression. + +\begin{cilcode}[local] + extern int f(); + return f() ? : -1; // Returns the result of f unless it is 0 +\end{cilcode} + +\item 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. + +\begin{cilcode}[global] +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] = &&lbl1; + jtab[1] = &&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); +} +\end{cilcode} + + +\item A cute little example that we made up. What is the returned value? +(Answer: 1); +\begin{cilcode}[local] + return ({goto L; 0;}) && ({L: 5;}); +\end{cilcode} + +\item \t{extern inline} is a strange feature of GNU C. Can you guess what the +following code computes? + +\begin{cilcode}[global] +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(); +} +\end{cilcode} + + 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. + + CIL will misbehave on this example, if the optimizations are turned off (it + always returns 3). + +\item 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: +\begin{cilcode}[global] +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; +} +\end{cilcode} + +\item GCC allows you to use the \t{\_\_mode\_\_} attribute to specify the size +of the integer instead of the standard \t{char}, \t{short} and so on: +\begin{cilcode}[global] +int __attribute__ ((__mode__ ( __QI__ ))) i8; +int __attribute__ ((__mode__ ( __HI__ ))) i16; +int __attribute__ ((__mode__ ( __SI__ ))) i32; +int __attribute__ ((__mode__ ( __DI__ ))) i64; +\end{cilcode} + +\item The ``alias'' 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. +\begin{cilcode}[global] + 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"))); +\end{cilcode} + +\end{enumerate} + + \subsection{Microsoft VC ugliness} + + This compiler has few extensions, so there is not much to say here. + +\begin{enumerate} +\item 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.) + +\begin{code} + return -3 >> (8 * sizeof(int)); +\end{verbatim}\end{code} + +\item 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 \t{y} overlaps with +\t{x}!). + +\begin{cilcode}[local] +struct { + int x; + struct { + int y, z; + struct { + int u, v; + }; + }; +} a; +return a.x + a.y + a.z + a.u + a.v; +\end{cilcode} + + +\end{enumerate} + +\section{Authors} + + The CIL parser was developed starting from Hugues Casse's \t{frontc} +front-end for C although all the files from the \t{frontc} distribution have +been changed very extensively. The intermediate language and the elaboration +stage are all written from scratch. The main author is +\ahref{mailto:necula@cs.berkeley.edu}{George Necula}, with significant +contributions from \ahref{mailto:smcpeak@cs.berkeley.edu}{Scott McPeak}, +\ahref{mailto:weimer@cs.berkeley.edu}{Westley Weimer}, +\ahref{mailto:liblit@cs.wisc.edu}{Ben Liblit}, +\ahreftop{http://www.cs.berkeley.edu/\~{}matth/}{Matt Harren}, +Raymond To and Aman Bhargava. + + 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. + +\section{License} + +Copyright (c) 2001-2007, +\begin{itemize} +\item George C. Necula +\item Scott McPeak +\item Wes Weimer +\item Ben Liblit +\item Matt Harren +\end{itemize} +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. + +\section{Bug reports} + + 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 +\ahreftop{http://sourceforge.net/projects/cil} + {http://sourceforge.net/projects/cil}. + + 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. + +\section{Changes}\label{sec-changes}\cutname{changes.html} +\begin{itemize} +\item {\bf February 14, 2008}: Fixed a bug in temporary file +creation. Thanks to J. Aaron Pendergrass for the patch. +\item {\bf November 30, 2007}: Fixed a bbug in assignment to lvalues that + depend on themselves. +\item {\bf April 4, 2007}: Benjamin Monate fixed a bug in + \moduleref{Cfg} for empty loop bodies. +\item {\bf March 29, 2007}: Polyvios Pratikakis fixed a bug in + \t{src/ext/pta/uref.ml}. +\item {\bf March 15, 2007}: Added support for + \t{\_\_attribute\_\_((aligned))} and + \t{\_\_attribute\_\_((packed))}. +\item {\bf March 7, 2007}: \t{typeOf(StartOf \_)} now preserves the + attributes of the array. +\item {\bf February 22, 2007}: Added an inliner (ext/inliner.ml) +\item {\bf February 21, 2007}: We now constant-fold bitfield + expressions. Thanks to Virgile Prevosto for the patch. +\item {\bf February 13, 2007}: gcc preprocessor arguments passed + using \t{-Wp} are now used only during initial preproccessing, not + for the preprocessing after CIL. This fixes problems in the Linux + makefiles with dependency generation. +\item {\bf February 6, 2007}: Fixed \cilvalref{parseInt} for non-32 + bit architectures. +\item {\bf February 5, 2007}: {\bf Released version 1.3.6} (Subversion + revision 9211) +\item {\bf February 2, 2007}: Improved the way CIL gets configured for the + actual definitions of \t{size\_t} and \t{wchar\_t}. +\item {\bf February 1, 2007}: Fixed the parser to support the unused + attribute on labels. For now, we just drop this attribute since + Rmtmps will remove unused labels anyways. Thanks to Peter Hawkins + for the patch. +\item {\bf January 18, 2007}: Require the destination of a \t{Call} to + have the same type as the function's return type, even if it means + inserting a temporary. To get the old behavior, set + \t{Cabs2cil.doCollapseCallCast} to true as described in + \secref{cilly-internal-options}. +\item {\bf January 17, 2007}: Fix for \t{\_\_builtin\_offsetof} when + the field name is also a typedef name. +\item {\bf January 17, 2007}: Fixed \cilvalref{loadBinaryFile} + (Sourceforge bug \#1548894). + You should only use loadBinaryFile if no other code has been loaded + or generated in the current CIL process, since loadBinaryFile needs + to load some global state. +\item {\bf December 18, 2006}: The \t{-{}-stats} flag now gets the CPU + speed at runtime rather than configure-time, so binary executables + can be moved to different computers. +\item {\bf December 14, 2006}: Fixed various warnings and errors on + 64-bit architectures. +\item {\bf November 26, 2006}: Christoph Spiel added ``\t{-{}-no}'' + options to many of CIL's command-line flags. +\item {\bf November 21, 2006}: Merged \t{gccBuiltins} and + \t{msvcBuiltins} into a single table \cilvalref{builtinFunctions} + that is initialized by \cilvalref{initCIL}. +\item {\bf October 28, 2006}: Added the field \t{vdescr} to the + \ciltyperef{varinfo} struct to remember what value is stored in + certain CIL-introduced temporary variables. For example, if CIL + adds a temporary to store the result of \t{foo(a,b)}, then the + description will be ``foo(a,b)''. The new printer + \cilvalref{descriptiveCilPrinter} will substitute descriptions for + the names of temporaries. The result is not necessarily valid C, + but it may let you produce more helpful error messages in your + analysis tools: ``The value foo(a,b) may be tainted'' vs. ``The + value \_\_cil\_tmp29 may be tainted.'' +\item {\bf October 27, 2006}: Fixed a bug with duplicate entries in + the statement list of Switch nodes, and forbade duplicate + \t{default} cases. +%% October 26, 2006: Moved the CIL source repository from CVS +%% to Subversion. Subversion revision 8603 is the switchover point. +\item {\bf October 12, 2006}: Added a new function \cilvalref{expToAttrParam} +that attempts to convert an expression into a attribute parameter. +\item {\bf October 12, 2006}: Added an attribute with the length of the array, + when array types of formal arguments are converted to pointer types. +\item {\bf September 29, 2006}: Benjamin Monate fixed a bug in compound + local initializers that was causing duplicate code to be added. +\item {\bf August 9, 2006}: Changed the patcher to print ``\t{\#line + nnn}'' directives instead of ``\t{\# nnn}''. +\item {\bf August 6, 2006}: Joseph Koshy patched \t{./configure} for + FreeBSD on amd64. +\item {\bf July 27, 2006}: CIL files now include the prototypes of + builtin functions (such as \t{\_\_builtin\_va\_arg}). This + preserves the invariant that every function call has a corresponding + function or function prototype in the file. However, the prototypes + of builtins are not printed in the output files. +\item {\bf July 23, 2006}: Incorporated some fixes for the constant folding + for lvalues, and fixed grammatical errors. Thanks to Christian Stork. +\item {\bf July 23, 2006}: Changed the way ./configure works. We now generate + the file Makefile.features to record the configuration features. This is + because autoconf does not work properly with multiline substitutions. +\item {\bf July 21, 2006}: Cleaned up the printing of some Lvals. Things that + were printed as ``(*i)'' before are now printed simply as ``*i'' (no + parentheses). However, this means that when you use pLval to print lvalues + inside expressions, you must take care about parentheses yourself. Thanks to + Benjamin Monate for pointing this out. +\item {\bf July 21, 2006}: Added new hooks to the Usedef and + Dataflow.BackwardsTransfer APIs. Code that uses these will need to + be changed slightly. Also, updated the \moduleref{Cfg} code to + handle noreturn functions. +\item {\bf July 17, 2006}: Fix parsing of attributes on bitfields and + empty attribute lists. Thanks to Peter Hawkins. +\item {\bf July 10, 2006}: Fix Makefile problem for FreeBSD. Thanks + to Joseph Koshy for the patch. +\item {\bf June 25, 2006}: Extended the inline assembly to support named + arguments, as added in gcc 3.0. This changes the types of the input + and output lists from ``\t{(string * lval) list}'' to + ``\t{(string option * string * lval) list}''. Some existing code + will need to be modified accordingly. +\item {\bf June 11, 2006}: Removed the function \t{Cil.foldLeftCompoundAll}. +Use instead \cilvalref{foldLeftCompound} with \t{~implicit:true}. +\item {\bf June 9, 2006}: Extended the definition of the cilVisitor for +initializers to pass more information around. This might result in backward +incompatibilities with code that uses the visitor for initializers. +\item {\bf June 2, 2006}: Added \t{-{}-commPrintLnSparse} flag. +\item {\bf June 1, 2006}: Christian Stork provided some fixes for the handling + of variable argument functions. +\item {\bf June 1, 2006}: Added support for x86 performance counters + on 64-bit processors. Thanks to tbergen for the patch. +\item {\bf May 23, 2006}: Benjamin Monate fixed a lexer bug when a + preprocessed file is missing a final newline. +\item {\bf May 23, 2006}: Fix for \t{typeof($e$)} when $e$ has type + \t{void}. +\item {\bf May 20, 2006}: {\bf Released version 1.3.5} (Subversion + revision 8093) +\item {\bf May 19, 2006}: \t{Makefile.cil.in}/\t{Makefile.cil} have + been renamed \t{Makefile.in}/\t{Makefile}. And \t{maincil.ml} has + been renamed \t{main.ml}. +\item {\bf May 18, 2006}: Added a new module \moduleref{Cfg} to compute the + control-flow graph. Unlike the older \cilvalref{computeCFGInfo}, + the new version does not modify the code. +\item {\bf May 18, 2006}: Added several new analyses: reaching + definitions, available expressions, liveness analysis, and dead code + elimination. See \secref{Extension}. +\item {\bf May 2, 2006}: Added a flag \t{-{}-noInsertImplicitCasts}. + When this flag is used, CIL code will only include casts inserted by + the programmer. Implicit coercions are not changed to explicit casts. +\item {\bf April 16, 2006}: Minor improvements to the \t{-{}-stats} + flag (\secref{cilly-asm-options}). We now use Pentium performance + counters by default, if your processor supports them. +\item {\bf April 10, 2006}: Extended \t{machdep.c} 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. +\item {\bf April 6, 2006}: 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. +\item {\bf April 6, 2006}: Fix for bitfields in the SFI module. +\item {\bf April 6, 2006}: Various fixes for gcc attributes. + \t{packed}, \t{section}, and \t{always\_inline} attributes are now + parsed correctly. Also fixed printing of attributes on enum types. +\item {\bf March 30, 2006}: Fix for \t{rmtemps.ml}, which deletes + unused inline functions. When in \t{gcc} mode CIL now leaves all + inline functions in place, since \t{gcc} treats these as externally + visible. +\item {\bf March 3, 2006}: Assume inline assembly instructions can + fall through for the purposes of adding return statements. Thanks to + Nathan Cooprider for the patch. +\item {\bf February 27, 2006}: Fix for extern inline functions when + the output of CIL is fed back into CIL. +\item {\bf January 30, 2006}: Fix parsing of \t{switch} without braces. +\item {\bf January 30, 2006}: Allow `\$' to appear in identifiers. +\item {\bf January 13, 2006}: Added support for gcc's alias attribute + on functions. See \secref{ugly-gcc}, item 8. +\item {\bf December 9, 2005}: 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. +\item {\bf December 1, 2005}: Major rewrite of the ext/callgraph module. +\item {\bf December 1, 2005}: Preserve enumeration constants in CIL. Default +is the old behavior to replace them with integers. +\item {\bf November 30, 2005}: Added support for many GCC \t{\_\_builtin} + functions. +\item {\bf November 30, 2005}: Added the EXTRAFEATURES configure + option, making it easier to add Features to the build process. +\item {\bf November 23, 2005}: In MSVC mode do not remove any locals whose name + appears as a substring in an inline assembly. +\item {\bf November 23, 2005}: Do not add a return to functions that have the + noreturn attribute. +\item {\bf November 22, 2005}: {\bf Released version 1.3.4} +\item {\bf November 21, 2005}: Performance and correctness fixes for + the Points-to Analysis module. Thanks to Christoph Spiel for the + patches. +\item {\bf October 5, 2005}: CIL now builds on SPARC/Solaris. Thanks + to Nick Petroni and Remco van Engelen for the patches. +\item {\bf September 26, 2005}: CIL no longer uses the `\t{-I-}' flag + by default when preprocessing with gcc. +\item {\bf August 24, 2005}: Added a command-line option + ``-{}-forceRLArgEval'' 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. +\item {\bf August 9, 2005}: Fixed merging when there are more than 20 + input files. +\item {\bf August 3, 2005}: When merging, it is now an error to + declare the same global variable twice with different initializers. +\item {\bf July 27, 2005}: Fixed bug in transparent unions. +\item {\bf July 27, 2005}: Fixed bug in collectInitializer. Thanks to + Benjamin Monate for the patch. +\item {\bf July 26, 2005}: Better support for extended inline assembly + in gcc. +\item {\bf July 26, 2005}: 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, ``\t{\_\_builtin\_offsetof(t, field)}'' is + rewritten as ``\t{\&((t*)0)->field}'', the traditional way of calculating + an offset. +\item {\bf July 18, 2005}: Fixed bug in the constant folding of shifts + when the second argument was negative or too large. +\item {\bf July 18, 2005}: Fixed bug where casts were not always + inserted in function calls. +\item {\bf June 10, 2005}: Fixed bug in the code that makes implicit + returns explicit. We weren't handling switch blocks correctly. +\item {\bf June 1, 2005}: {\bf Released version 1.3.3} +\item {\bf May 31, 2005}: Fixed handling of noreturn attribute for function + pointers. +\item {\bf May 30, 2005}: Fixed bugs in the handling of constructors in gcc. +\item {\bf May 30, 2005}: Fixed bugs in the generation of global variable IDs. +\item {\bf May 27, 2005}: 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. +\item {\bf May 27, 2005}: Export the plainCilPrinter, for debugging. +\item {\bf May 27, 2005}: Fixed bug with printing of const attribute for + arrays. +\item {\bf May 27, 2005}: 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. +\item {\bf May 27, 2005}: Fixed bug in type comparisons using + TBuiltin\_va\_list. +\item {\bf May 27, 2005}: Improved the constant folding in array lengths and + case expressions. +\item {\bf May 27, 2005}: Added the \t{\_\_builtin\_frame\_address} to the set + of gcc builtins. +\item {\bf May 27, 2005}: Added the CIL project to SourceForge. +\item {\bf April 23, 2005}: The cattr field was not visited. +\item {\bf March 6, 2005}: Debian packaging support +\item {\bf February 16, 2005}: Merger fixes. +\item {\bf February 11, 2005}: Fixed a bug in \t{-{}-dopartial}. Thanks to +Nathan Cooprider for this fix. +\item {\bf January 31, 2005}: Make sure the input file is closed even if a + parsing error is encountered. +\item {\bf January 11, 2005}: {\bf Released version 1.3.2} +\item {\bf January 11, 2005}: Fixed printing of integer constants whose + integer kind is shorter than an int. +\item {\bf January 11, 2005}: Added checks for negative size arrays and arrays + too big. +\item {\bf January 10, 2005}: Added support for GCC attribute ``volatile'' for + tunctions (as a synonim for noreturn). +\item {\bf January 10, 2005}: Improved the comparison of array sizes when + comparing array types. +\item {\bf January 10, 2005}: Fixed handling of shell metacharacters in the + cilly command lione. +\item {\bf January 10, 2005}: Fixed dropping of cast in initialization of + local variable with the result of a function call. +\item {\bf January 10, 2005}: Fixed some structural comparisons that were + broken in the Ocaml 3.08. +\item {\bf January 10, 2005}: Fixed the \t{unrollType} function to not forget + attributes. +\item {\bf January 10, 2005}: Better keeping track of locations of function + prototypes and definitions. +\item {\bf January 10, 2005}: Fixed bug with the expansion of enumeration + constants in attributes. +\item {\bf October 18, 2004}: Fixed a bug in cabsvisit.ml. CIl would wrap a + BLOCK around a single atom unnecessarily. +\item {\bf August 7, 2004}: {\bf Released version 1.3.1} +\item {\bf August 4, 2004}: Fixed a bug in splitting of structs using + \t{-{}-dosimplify} +\item {\bf July 29, 2004}: 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. +\item {\bf July 28, 2004}: Ocaml version 3.08 is required. Numerous small + changes while porting to Ocaml 3.08. +\item {\bf July 7, 2004}: {\bf Released version 1.2.6} +\item {\bf July 2, 2004}: Character constants such as \t{'c'} should + have type \t{int}, not \t{char}. Added a utility function + \t{Cil.charConstToInt} that sign-extends chars greater than 128, if needed. +\item {\bf July 2, 2004}: 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 \t{int}. +\item {\bf June 13, 2004}: Added the field \t{sallstmts} to a function + description, to hold all statements in the function. +\item {\bf June 13, 2004}: Added new extensions for data flow analyses, and + for computing dominators. +\item {\bf June 10, 2004}: Force initialization of CIL at the start of +Cabs2cil. +\item {\bf June 9, 2004}: Added support for GCC \t{\_\_attribute\_used\_\_} +\item {\bf April 7, 2004}: {\bf Released version 1.2.5} +\item {\bf April 7, 2004}: 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. +\item {\bf April 7, 2004}: Fixed a bug in the driver. The temporary files are +deleted by the Perl script before the CL compiler gets to them? +\item {\bf April 7, 2004}: Added the - form of arguments to the MSVC driver. +\item {\bf April 7, 2004}: Added a few more GCC-specific string escapes, (, [, +\{, \%, E. +\item {\bf April 7, 2004}: Fixed bug with continuation lines in MSVC. +\item {\bf April 6, 2004}: Fixed embarassing bug in the parser: the precedence + of casts and unary operators was switched. +\item {\bf April 5, 2004}: 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. +\item {\bf April 5, 2004}: 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. +\item {\bf March 11, 2004} : Fixed a bug in the Cil.copyFunction function. The +new local variables were not getting fresh IDs. +\item {\bf March 5, 2004}: 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. +\item {\bf February 20, 2004}: {\bf Released version 1.2.4} +\item {\bf February 15, 2004}: Changed the parser to allow extra semicolons + after field declarations. +\item {\bf February 14, 2004}: Changed the Errormsg functions: error, unimp, +bug to not raise an exception. Instead they just set Errormsg.hadErrors. +\item {\bf February 13, 2004}: Change the parsing of attributes to recognize + enumeration constants. +\item {\bf February 10, 2004}: In some versions of \t{gcc} the identifier + {\_\{thread} is an identifier and in others it is a keyword. Added code + during configuration to detect which is the case. +\item {\bf January 7, 2004}: {\bf Released version 1.2.3} +\item {\bf January 7, 2004}: 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. +\item {\bf December 30, 2003} : Extended the \t{cilly} command to understand + better linker command options \t{-lfoo}. +\item {\bf December 5, 2003}: Added markup commands to the pretty-printer +module. Also, changed the ``@<'' left-flush command into ``@\^''. +\item {\bf December 4, 2003}: 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. +\item {\bf December 3, 2003}: Added support for structured exception handling + extensions for the Microsoft compilers. +\item {\bf December 1, 2003}: Fixed a Makefile bug in the generation of the +Cil library (e.g., \t{cil.cma}) that was causing it to be unusable. Thanks +to KEvin Millikin for pointing out this bug. +\item {\bf November 26, 2003}: Added support for linkage specifications + (extern ``C''). +\item {\bf November 26, 2003}: Added the ocamlutil directory to contain some +utilities shared with other projects. +\item {\bf November 25, 2003}: {\bf Released version 1.2.2} +\item {\bf November 24, 2003}: Fixed a bug that allowed a static local to + conflict with a global with the same name that is declared later in the + file. +\item {\bf November 24, 2003}: Removed the \t{-{}-keep} option of the \t{cilly} + driver and replaced it with \t{-{}-save-temps}. +\item {\bf November 24, 2003}: Added printing of what CIL features are being + run. +\item {\bf November 24, 2003}: Fixed a bug that resulted in attributes being + dropped for integer types. +\item {\bf November 11, 2003}: Fixed a bug in the visitor for enumeration + definitions. +\item {\bf October 24, 2003}: Fixed a problem in the configuration script. It + was not recognizing the Ocaml version number for beta versions. +\item {\bf October 15, 2003}: Fixed a problem in version 1.2.1 that was + preventing compilation on OCaml 3.04. +\item {\bf September 17, 2003: Released version 1.2.1.} +\item {\bf September 7, 2003}: Redesigned the interface for choosing + \texttt{\#line} directive printing styles. Cil.printLn and + Cil.printLnComment have been merged into Cil.lineDirectiveStyle. +\item {\bf August 8, 2003}: Do not silently pad out functions calls with +arguments to match the prototype. +\item {\bf August 1, 2003}: 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 + +\item {\bf July 14, 2003}: 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 + +\item {\bf July 8, 2003}: Fixed some of the \_\_alignof computations. Fixed + bug in the designated initializers for arrays (Array.get error). +\item {\bf July 8, 2003}: Fixed infinite loop bug (Stack Overflow) in the + visitor for \_\_alignof. +\item {\bf July 8, 2003}: 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. +\item {\bf July 7, 2003}: New Escape module provides utility functions + for escaping characters and strings in accordance with C lexical + rules. + +\item {\bf July 2, 2003}: 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. + + +\item {\bf June 28, 2003}: In the Formatparse module, Eric Haugh found and + fixed a bug in the handling of lvalues of the form ``lv->field.more''. + +\item {\bf June 28, 2003}: Extended the handling of gcc command lines +arguments in the Perl scripts. + +\item {\bf June 23, 2003}: 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 + ``\texttt{referenced}'' fields directly is no longer supported. + +\item {\bf June 17, 2003}: Reimplement internal utility routine + \t{Cil.escape\_char}. Faster and better. + +\item {\bf June 14, 2003}: Implemented support for \t{\_\_attribute\_\_s} +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 + +\item {\bf May 30, 2003}: Released the regression tests. +\item {\bf May 28, 2003}: {\bf Released version 1.1.2} +\item {\bf May 26, 2003}: Add the \t{simplify} module that compiles CIL +expressions into simpler expressions, similar to those that appear in a +3-address intermediate language. +\item {\bf May 26, 2003}: Various fixes and improvements to the pointer +analysis modules. +\item {\bf May 26, 2003}: Added optional consistency checking for +transformations. +\item {\bf May 25, 2003}: Added configuration support for big endian machines. +Now \cilvalref{little\_endian} can be used to test whether the machine is +little endian or not. +\item {\bf May 22, 2003}: Fixed a bug in the handling of inline functions. The +CIL merger used to turn these functions into ``static'', which is incorrect. +\item {\bf May 22, 2003}: Expanded the CIL consistency checker to verify +undesired sharing relationships between data structures. +\item {\bf May 22, 2003}: Fixed bug in the \t{oneret} CIL module: it was +mishandling certain labeled return statements. +\item {\bf May 5, 2003}: {\bf Released version 1.0.11} +\item {\bf May 5, 2003}: OS X (powerpc/darwin) support for CIL. Special +thanks to Jeff Foster, Andy Begel and Tim Leek. +\item {\bf April 30, 2003}: Better description of how to use CIL for your +analysis. +\item {\bf April 28, 2003}: Fixed a bug with \texttt{-{}-dooneRet} and +\texttt{-{}-doheapify}. Thanks, Manos Renieris. +\item {\bf April 16, 2003}: 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: + \begin{itemize} + \item \texttt{-{}-keepmerged} for the single-file merge of all sources + \item \texttt{-{}-keep=<\textit{dir}>} for various other CIL and + CCured output files + \item \texttt{-{}-save-temps} for various gcc intermediate files; MSVC + has no equivalent option + \end{itemize} + 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 + ``\texttt{foocured.c}'' now appears in ``\texttt{foo.cured.c}''. +\item {\bf April 7, 2003}: Changed the representation of the \cilvalref{GVar} +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 \cilvalref{visitCilFileSameGlobals} and the \cilvalref{GVar} +was the only global that could not be updated in place. +\item {\bf April 6, 2003}: Reimplemented parts of the cilly.pl script to make +it more robust in the presence of complex compiler arguments. +\item {\bf March 10, 2003}: {\bf Released version 1.0.9} +\item {\bf March 10, 2003}: 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. +\item {\bf February 18, 2003}: Fixed a bug in logwrites that was causing it +to produce invalid C code on writes to bitfields. Thanks, David Park. +\item {\bf February 15, 2003}: {\bf Released version 1.0.8} +\item {\bf February 15, 2003}: PDF versions of the manual and API are +available for those who would like to print them out. +\item {\bf February 14, 2003}: CIL now comes bundled with alias analyses. +\item {\bf February 11, 2003}: Added support for adding/removing options from + \t{./configure}. +\item {\bf February 3, 2003}: {\bf Released version 1.0.7} +\item {\bf February 1, 2003}: Some bug fixes in the handling of variable +argument functions in new versions of \t{gcc} And \t{glibc}. +\item {\bf January 29, 2003}: Added the logical AND and OR operators. +Exapanded the translation to CIL to handle more complicated initializers +(including those that contain logical operators). +\item {\bf January 28, 2003}: {\bf Released version 1.0.6} +\item {\bf January 28, 2003}: Added support for the new handling of +variable-argument functions in new versions of \t{glibc}. +\item {\bf January 19, 2003}: Added support for declarations in interpreted + constructors. Relaxed the semantics of the patterns for variables. +\item {\bf January 17, 2003}: Added built-in prototypes for the gcc built-in + functions. Changed the \t{pGlobal} method in the printers to print the + carriage return as well. +\item {\bf January 9, 2003}: 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. +\item {\bf January 9, 2003}: 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. +\item {\bf January 6, 2003}: {\bf Released version 1.0.5} +\item {\bf January 4, 2003}: 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. +\item {\bf January 3, 2003}: Extended the \t{rmtmps} module to also remove + unused labels that are generated in the conversion to CIL. This reduces the + number of warnings that you get from \t{cgcc} afterwards. +\item {\bf December 17, 2002}: 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 \t{sizeof("foo bar")} and \t{sizeof((char*)"foo bar")} + (the former is 8 and the latter is 4). + +\item {\bf December 8, 2002}: 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. +\item {\bf December 5, 2002}: Fixed visitor bugs that were causing + some attributes not to be visited and some queued instructions to be + dropped. +\item {\bf December 3, 2002}: Added a transformation to catch stack + overflows. Fixed the heapify transformation. +\item {\bf October 14, 2002}: CIL is now available under the BSD license +(see the License section or the file LICENSE). {\bf Released version 1.0.4} +\item {\bf October 9, 2002}: More FreeBSD configuration changes, support +for the GCC-ims {\tt \_\_signed} and {\tt \_\_volatile}. Thanks to Axel +Simon for pointing out these problems. {\bf Released version 1.0.3} +\item {\bf October 8, 2002}: FreeBSD configuration and porting fixes. +Thanks to Axel Simon for pointing out these problems. +\item {\bf September 10, 2002}: Fixed bug in conversion to CIL. Now we drop +all ``const'' qualifiers from the types of locals, even from the fields of +local structures or elements of arrays. +\item {\bf September 7, 2002}: Extended visitor interface to distinguish visitng + offsets inside lvalues from offsets inside initializer lists. +\item {\bf September 7, 2002}: {\bf Released version 1.0.1} +\item {\bf September 6, 2002}: Extended the patcher with the \t{ateof} flag. +\item {\bf September 4, 2002}: Fixed bug in the elaboration to CIL. In some +cases constant folding of \t{||} and \t{\&\&} was computed wrong. +\item {\bf September 3, 2002}: Fixed the merger documentation. +\item {\bf August 29, 2002}: {\bf Released version 1.0.0.} +\item {\bf August 29, 2002}: Started numbering versions with a major nubmer, +minor and revisions. Released version 1.0.0. +\item {\bf August 25, 2002}: Fixed the implementation of the unique +identifiers for global variables and composites. Now those identifiers are +globally unique. +\item {\bf August 24, 2002}: Added to the machine-dependent configuration the +\t{sizeof{void}}. It is 1 on gcc and 0 on MSVC. Extended the implementation of +\t{Cil.bitsSizeOf} to handle this (it was previously returning an error when +trying to compute the size of \t{void}). +\item {\bf August 24, 2002}: 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. +\item {\bf August 22, 2002}: Apply a patch from Richard H. Y. to support +FreeBSD installations. Thanks, Richard! +\item {\bf August 12, 2002}: 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. +\item {\bf May 25, 2002}: Added interpreted constructors and destructors. +\item {\bf May 17, 2002}: Changed the representation of functions to move the +``inline'' information to the varinfo. This way we can print the ``inline'' +even in declarations which is what gcc does. +\item {\bf May 15, 2002}: Changed the visitor for initializers to make two +tail-recursive passes (the second is a \t{List.rev} and only done if one of +the initializers change). This prevents \t{Stack\_Overflow} for large +initializers. Also improved the processing of initializers when converting to +CIL. +\item {\bf May 15, 2002}: Changed the front-end to allow the use of \t{MSVC} +mode even on machines that do not have MSVC. The machine-dependent parameters +for GCC will be used in that case. +\item {\bf May 11, 2002}: Changed the representation of formals in function +types. Now the function type is purely functional. +\item {\bf May 4, 2002}: Added the function +\cilvalref{visitCilFileSameGlobals} and changed \cilvalref{visitCilFile} to be +tail recursive. This prevents stack overflow on huge files. +\item {\bf February 28, 2002}: Changed the significance of the +\t{CompoundInit} in \ciltyperef{init} to allow for missing initializers at the +end of an array initializer. Added the API function +\cilvalref{foldLeftCompoundAll}. +\end{itemize} + +\end{document} + + + +% LocalWords: CIL intraprocedural datatype CIL's html Dataflow ocamldoc cilly +% LocalWords: Dominators tbergen bitfield diff --git a/cil/doc/cilcode.pl b/cil/doc/cilcode.pl new file mode 100644 index 0000000..51bec58 --- /dev/null +++ b/cil/doc/cilcode.pl @@ -0,0 +1,102 @@ +# +# Preprocesses a text and it changes +# \begin{cilcode} +# ... +# \end{cilcode} +# +# into the verbatim environment and add the option to see the CIL output for +# it. + +use strict; +use Data::Dumper; + +my $testnr = 1; +my $tmpdir = "cilcode.tmp"; +my $htmloutdir = "examples"; +my $outdir = "html/cil/$htmloutdir"; + +my $cilly = "perl ../bin/cilly --verbose"; + +my $doexamples = ! defined($ENV{'NO_EXAMPLES'}); + +my $preambleLocal = <) { + $lineno ++; + if(! $incode && $_ =~ m|^\\begin{cilcode}\[(.*)\](.*)$|) { + $opt = $1; + $cil_options = $2; + $incode = 1; + print STDERR "\n***Found CIL code at line $lineno\n"; + open(TSTSRC, ">$tmpdir/ex$testnr.c") + || die "Cannot create source $testnr"; + if($opt eq 'local') { + print TSTSRC $preambleLocal; + } else { + print TSTSRC $preambleGlobal; + } + print "\\begin{code}\n"; + next; + } + if($incode && $_ =~ m|^\\end{cilcode}$|) { + $incode = 0; + if($opt eq 'local') { + print TSTSRC $postambleLocal; + } else { + print TSTSRC $postambleGlobal; + } + close(TSTSRC); + print "\\end{verbatim}\\end{code}\n"; + if($doexamples) { + print "See the \\ahref{$htmloutdir/ex$testnr.txt}{CIL output} for this +code fragment\n"; + # Now run cilly + my $cmd = "$cilly $cil_options -c $tmpdir/ex$testnr.c -o $tmpdir/ex$testnr.o --save-temps=$tmpdir"; + # print "$cmd\n"; + if(system($cmd)) { + die "Error running CIL for $tmpdir/ex$testnr.c"; + } + # Now repackage the CIL file + my $cilfile = "$tmpdir/ex$testnr.cil.c"; + open(CIL, "<$cilfile") || die "Cannot find CIL file \"$cilfile\" for $testnr"; + my $exfile = "$outdir/ex$testnr.txt"; + open(OUT, ">$exfile") || die "Cannot write OUT file \"$exfile\" for $testnr"; + while() { + print OUT $_; + } + close(OUT); + close(CIL); + } else { + print "(Code generation was turned off for this document)"; + } + $testnr ++; + next; + } + if($incode) { + print TSTSRC $_; + } + print $_; +} + diff --git a/cil/doc/comment.sty b/cil/doc/comment.sty new file mode 100644 index 0000000..658686f --- /dev/null +++ b/cil/doc/comment.sty @@ -0,0 +1,278 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Comment.sty version 3.6, October 1999 +% +% Purpose: +% selectively in/exclude pieces of text: the user can define new +% comment versions, and each is controlled separately. +% Special comments can be defined where the user specifies the +% action that is to be taken with each comment line. +% +% Author +% Victor Eijkhout +% Department of Computer Science +% University of Tennessee +% 107 Ayres Hall +% Knoxville TN 37996 +% USA +% +% victor@eijkhout.net +% +% This program 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. +% +% For a copy of the GNU General Public License, write to the +% Free Software Foundation, Inc., +% 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, +% or find it on the net, for instance at +% http://www.gnu.org/copyleft/gpl.html +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% This style can be used with plain TeX or LaTeX, and probably +% most other packages too. +% +% Usage: all text included between +% \comment ... \endcomment +% or \begin{comment} ... \end{comment} +% is discarded. +% +% The opening and closing commands should appear on a line +% of their own. No starting spaces, nothing after it. +% This environment should work with arbitrary amounts +% of comment, and the comment can be arbitrary text. +% +% Other `comment' environments are defined by +% and are selected/deselected with +% \includecomment{versiona} +% \excludecoment{versionb} +% +% These environments are used as +% \versiona ... \endversiona +% or \begin{versiona} ... \end{versiona} +% with the opening and closing commands again on a line of +% their own. +% +% LaTeX users note: for an included comment, the +% \begin and \end lines act as if they don't exist. +% In particular, they don't imply grouping, so assignments +% &c are not local. +% +% Special comments are defined as +% \specialcomment{name}{before commands}{after commands} +% where the second and third arguments are executed before +% and after each comment block. You can use this for global +% formatting commands. +% To keep definitions &c local, you can include \begingroup +% in the `before commands' and \endgroup in the `after commands'. +% ex: +% \specialcomment{smalltt} +% {\begingroup\ttfamily\footnotesize}{\endgroup} +% You do *not* have to do an additional +% \includecomment{smalltt} +% To remove 'smalltt' blocks, give \excludecomment{smalltt} +% after the definition. +% +% Processing comments can apply processing to each line. +% \processcomment{name}{each-line commands}% +% {before commands}{after commands} +% By defining a control sequence +% \def\Thiscomment##1{...} in the before commands the user can +% specify what is to be done with each comment line. +% BUG this does not work quite yet BUG +% +% Trick for short in/exclude macros (such as \maybe{this snippet}): +%\includecomment{cond} +%\newcommand{\maybe}[1]{} +%\begin{cond} +%\renewcommand{\maybe}[1]{#1} +%\end{cond} +% +% Basic approach of the implementation: +% to comment something out, scoop up every line in verbatim mode +% as macro argument, then throw it away. +% For inclusions, in LaTeX the block is written out to +% a file \CommentCutFile (default "comment.cut"), which is +% then included. +% In plain TeX (and other formats) both the opening and +% closing comands are defined as noop. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Changes in version 3.1 +% - updated author's address +% - cleaned up some code +% - trailing contents on \begin{env} line is always discarded +% even if you've done \includecomment{env} +% - comments no longer define grouping!! you can even +% \includecomment{env} +% \begin{env} +% \begin{itemize} +% \end{env} +% Isn't that something ... +% - included comments are written to file and input again. +% Changes in 3.2 +% - \specialcomment brought up to date (thanks to Ivo Welch). +% Changes in 3.3 +% - updated author's address again +% - parametrised \CommentCutFile +% Changes in 3.4 +% - added GNU public license +% - added \processcomment, because Ivo's fix (above) brought an +% inconsistency to light. +% Changes in 3.5 +% - corrected typo in header. +% - changed author email +% - corrected \specialcomment yet again. +% - fixed excludecomment of an earlier defined environment. +% Changes in 3.6 +% - The 'cut' file is now written more verbatim, using \meaning; +% some people reported having trouble with ISO latin 1, or umlaute.sty. +% - removed some \newif statements. +% Has this suddenly become \outer again? +% +% Known bugs: +% - excludecomment leads to one superfluous space +% - processcomment leads to a superfluous line break +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\def\makeinnocent#1{\catcode`#1=12 } +\def\csarg#1#2{\expandafter#1\csname#2\endcsname} +\def\latexname{lplain}\def\latexename{LaTeX2e} +\newwrite\CommentStream +\def\CommentCutFile{comment.cut} + +\def\ProcessComment#1% start it all of + {\begingroup + \def\CurrentComment{#1}% + \let\do\makeinnocent \dospecials + \makeinnocent\^^L% and whatever other special cases + \endlinechar`\^^M \catcode`\^^M=12 \xComment} +%\def\ProcessCommentWithArg#1#2% to be used in \leveledcomment +% {\begingroup +% \def\CurrentComment{#1}% +% \let\do\makeinnocent \dospecials +% \makeinnocent\^^L% and whatever other special cases +% \endlinechar`\^^M \catcode`\^^M=12 \xComment} +{\catcode`\^^M=12 \endlinechar=-1 % + \gdef\xComment#1^^M{% + \expandafter\ProcessCommentLine} + \gdef\ProcessCommentLine#1^^M{\def\test{#1} + \csarg\ifx{End\CurrentComment Test}\test + \edef\next{\noexpand\EndOfComment{\CurrentComment}}% + \else \ThisComment{#1}\let\next\ProcessCommentLine + \fi \next} +} + +\def\CSstringmeaning#1{\expandafter\CSgobblearrow\meaning#1} +\def\CSstringcsnoescape#1{\expandafter\CSgobbleescape\string#1} +{\escapechar-1 +\expandafter\expandafter\expandafter\gdef + \expandafter\expandafter\expandafter\CSgobblearrow + \expandafter\string\csname macro:->\endcsname{} +} +\def\CSgobbleescape#1{\ifnum`\\=`#1 \else #1\fi} +\def\WriteCommentLine#1{\def\CStmp{#1}% + \immediate\write\CommentStream{\CSstringmeaning\CStmp}} + +% 3.1 change: in LaTeX and LaTeX2e prevent grouping +\if 0% +\ifx\fmtname\latexename + 0% +\else \ifx\fmtname\latexname + 0% + \else + 1% +\fi \fi +%%%% +%%%% definitions for LaTeX +%%%% +\def\AfterIncludedComment + {\immediate\closeout\CommentStream + \input{\CommentCutFile}\relax + }% +\def\TossComment{\immediate\closeout\CommentStream} +\def\BeforeIncludedComment + {\immediate\openout\CommentStream=\CommentCutFile + \let\ThisComment\WriteCommentLine} +\def\includecomment + #1{\message{Include comment '#1'}% + \csarg\let{After#1Comment}\AfterIncludedComment + \csarg\def{#1}{\BeforeIncludedComment + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\long\def\specialcomment + #1#2#3{\message{Special comment '#1'}% + % note: \AfterIncludedComment does \input, so #2 goes here! + \csarg\def{After#1Comment}{#2\AfterIncludedComment#3}% + \csarg\def{#1}{\BeforeIncludedComment\relax + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\long\def\processcomment + #1#2#3#4{\message{Lines-Processing comment '#1'}% + \csarg\def{After#1Comment}{#3\AfterIncludedComment#4}% + \csarg\def{#1}{\BeforeIncludedComment#2\relax + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\def\leveledcomment + #1#2{\message{Include comment '#1' up to level '#2'}% + %\csname #1IsLeveledCommenttrue\endcsname + \csarg\let{After#1Comment}\AfterIncludedComment + \csarg\def{#1}{\BeforeIncludedComment + \ProcessCommentWithArg{#1}}% + \CommentEndDef{#1}} +\else +%%%% +%%%%plain TeX and other formats +%%%% +\def\includecomment + #1{\message{Including comment '#1'}% + \csarg\def{#1}{}% + \csarg\def{end#1}{}} +\long\def\specialcomment + #1#2#3{\message{Special comment '#1'}% + \csarg\def{#1}{\def\ThisComment{}\def\AfterComment{#3}#2% + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\fi + +%%%% +%%%% general definition of skipped comment +%%%% +\def\excludecomment + #1{\message{Excluding comment '#1'}% + \csarg\def{#1}{\let\AfterComment\relax + \def\ThisComment####1{}\ProcessComment{#1}}% + \csarg\let{After#1Comment}\TossComment + \CommentEndDef{#1}} + +\if 0% +\ifx\fmtname\latexename + 0% +\else \ifx\fmtname\latexname + 0% + \else + 1% +\fi \fi +% latex & latex2e: +\def\EndOfComment#1{\endgroup\end{#1}% + \csname After#1Comment\endcsname} +\def\CommentEndDef#1{{\escapechar=-1\relax + \csarg\xdef{End#1Test}{\string\\end\string\{#1\string\}}% + }} +\else +% plain & other +\def\EndOfComment#1{\endgroup\AfterComment} +\def\CommentEndDef#1{{\escapechar=-1\relax + \csarg\xdef{End#1Test}{\string\\end#1}% + }} +\fi + +\excludecomment{comment} + +\endinput diff --git a/cil/doc/cvssetup.tex b/cil/doc/cvssetup.tex new file mode 100644 index 0000000..b758eb0 --- /dev/null +++ b/cil/doc/cvssetup.tex @@ -0,0 +1,216 @@ +\documentclass{article} +\usepackage{hevea} + +\def\t#1{{\tt #1}} +\def\DYNAMIC{\t{DYNAMIC}} +\title{Setting Up CVS and SSH} +\author{Scott McPeak \and George Necula} + +\def\cvshost{manju} + +\begin{document} +\maketitle + + This document is intended to get you started with the tools that are +necessary for checking out stuff out of the \cvshost{} CVS repository. These +instructions work on Linux and Windows (NT4.0, 2000, XP and also less reliably +on 95/98/Me). + +\section{If you want to use Windows} + + \subsection{Get \t{cygwin}} + + You must have a bunch of Unix tools installed on your machine. (In the future +we might be able to avoid these but for now you are better off with them.). +Here is what I (George) do to install Cygwin. You need a good network +connection for this. +\begin{itemize} +\item Create a directory \t{C:\backslash Download\backslash cygwin} +\item Go to \ahrefurl{http://sources.redhat.com/cygwin} and click \t{Install +cygwin} icon. Download \t{setup.exe} to the directory you just created. +\item Run \t{setup.exe} and select ``Download to local directory''. Select all +the packages. It is especially important to select all packages under +``Devel'' category. If you want to use OCaml for other projects as well, I +also suggest that you select the XFree86-bin, XFree86-lib and XFree86-prog as +well. This will take a while (~ 30 minutes) +\item Run \t{setup.exe} again and now select to ``Install from local +directory''. It is best to {\bf deselect} the \t{tetex} package since I found +it to interfere with other installations of Latex. +\item I choose \t{C:\backslash Programs\backslash cygwin} +as the home for \t{cygwin}, I use \t{DOS} as the default text file and I +choose ``Install for All''. +\item Add \t{C:\backslash Programs\backslash cygwin\backslash bin} to your +PATH. You must put it in the ``System Variables'' PATH (In Control Panel/System/Advanced/Environment +Variables'' and {\bf put it first} so that it comes before the default +c:/WinNT/system32. You can verify that you got it right if you get +\t{/usr/bin/find} when you run \t{which find}. +\end{itemize} + + + If you get a compilation error in file ``cltkImg.c'' while you compile Ocaml +v 3.06, then you should patch the Ocaml sources as explained at +\ahrefurl{http://groups.google.com/groups?selm=fa.i2v96ov.1p7cmbc\%40ifi.uio.no} +(It is easy). + + \subsection{Customize \t{ssh}}\label{sec-win-ssh} + + Set the environment variable \t{HOME} to point to your home directory. I use + \t{C:\backslash Necula}. + + For some strange reason \t{ssh} does not see this \t{HOME} variable and +insists on looking at \t{/home/necula} instead. So I create a link as follows: +\begin{verbatim} +bash +cd / +mkdir home +ln -s /cygdrive/c/Necula /home/necula +\end{verbatim} + +\section{Configure CVS} + + \subsection{\t{.cvsrc}} + + Create a \home{/.cvsrc} file with two lines in it: +\begin{verbatim} +cvs -q +update -d +\end{verbatim} + + \subsection{\t{.ssh/config}} + + Create a \home{/.ssh/config} file with this line in it: +\begin{verbatim} +ForwardX11 yes +\end{verbatim} + + If the \t{DISPLAY} environment variable is set when you invoke \t{ssh} (e.g. +to \t{localhost:0.0} then \t{ssh} will do automatic X11 forwarding for you. +This is not useful for the use of \t{ssh} with \t{cvs} but when you want to do +remote login. + + \subsection{Using CVS with \t{ssh}} + + Note: these instructions appear to work even on Windows with the \t{ssh} and +\t{cvs} that ships with \t{cygwin} (provided that you have installed +\t{cygwin} and \t{ssh} as discussed in Section~\ref{sec-win-ssh}). + + Set the environment variable \t{CVS\_RSH} to \t{ssh}. + + Now you can use cvs with ssh but you will have to type the remote password + everytime you run cvs. + + If you want to be able to use \t{ssh} without typing a password everytime +here is what you can do. These instructions are for the case when you use one +of the newer versions of SSH that support the protocol 2. + +\begin{enumerate} + \item If you have a DSA private key that is already authorized on + the server, copy it to \t{\home{}/.ssh/id\_dsa} and you + should be done. + \item Otherwise + \begin{enumerate} + \item Run \t{ssh-keygen -t dsa} to create a private key. + Choose a passphrase and remember it. + If you do not have a passphrase then anybody who gets + access to your machine will also be able to log in to the server. This + step should create the files \t{id\_dsa.pub} and \t{id\_dsa} in your + \t{\home{}/.ssh} directory. + \item Copy the public key to the server (say \cvshost.cs.berkeley.edu). + Make sure you append the key to {\bf authorized\_keys2}, not to {\bf + authorized\_keys}. + \begin{verbatim} + cd ~ + scp .ssh/id_dsa.pub manju:~/.ssh/newpublicid + ssh manju + cd .ssh + cat newpublicid >> authorized_keys2 + rm newpublicid + \end{verbatim} + \end{enumerate} +\end{enumerate} + + + If you want you can even start an agent to do the authentication for +you. The steps are different for Linux or Windows: + \begin{itemize} + \item On Linux or on Windows if you work from within \t{bash} you can run + \begin{verbatim} + eval `ssh-agent` + ssh-add + \end{verbatim} + + The first step starts the agent and the second on loads your identity + in the agent. In this latter step you will be asked to enter your + passphrase. + \item At the Windows command prompt (\t{cmd.exe}) you cannot just run + those commands. Instead you have to download + \ahref{http://raw.cs.berkeley.edu/winssh-agent.cmd}{this batch file + ({\bf do not execute it})}, + put it somewhere in your path and then run it instead of the above + sequence of commands. + \end{itemize} + +\section{Using CVS} + + You should read the rest only if you have not used CVS before. + + CVS is used to synchronize changes to the project across multiple +developers. See the CVS website for detailed information + + \ahrefurl{http://www.cvshome.org/} + +There are a few common commands you'll need. Each of these is to be run +in the base 'cil' directory (the one with 'regrtest'): + +\begin{itemize} +\item \t{cvs [-n] update -d [filename]} + + This retrieves any changes recently committed by others. This is + usually necessary before you can commit your own changes. It is a + good idea to run the fast regression test ('regrtest') before and + after doing "cvs update" so you can know whether it was you or the + update which broke something. + + The optional -n flag tells CVS to not actually change any of your + files. This is useful for querying the status of the repository. + + The -d argument tells cvs to create on your machine any new directories + that somebody might have checked in. By default cvs does not create new + directories. This flag is so useful that many people find it useful to + create a \home{/.cvsrc} file with one line containing "update -d" in it. + This way you don't have to specify the flag all the time. + + If you specify a filename (after cd'ing to the directory containing it), + only that file will be updated, otherwise everything in the current + directory and below is updated. Run this in the top-level project + directory to update the entire project. A useful idiom for undoing all of + your changes is "cd dir; rm file; cvs update file". + + +\item \t{cvs commit [filename]} + + This pushes your changes into the repository, so that the next time + someone does "cvs update" they will get your changes. Please try to + only commit when the regression test script passes. + + If you specify a filename, only that file will be committed, otherwise + everything in the current directory and below is checked in. Run this in + the top-level project directory to check all of your changes in. + +\item \t{cvs add filename} + + This adds a new file to the repository. It isn't visible in the + repository until you do a commit. +\end{itemize} + + +\section{Useful Links} +\begin{itemize} + \item Tutorial on ML: + \item Documentation and sources for CVS: + \ahrefurl{http://www.cvshome.org/} + + \end{itemize} + +\end{document} + diff --git a/cil/doc/fullpage.sty b/cil/doc/fullpage.sty new file mode 100644 index 0000000..67824e3 --- /dev/null +++ b/cil/doc/fullpage.sty @@ -0,0 +1,29 @@ +% This is FULLPAGE.STY by H.Partl, Version 2 as of 15 Dec 1988. +% Document Style Option to fill the paper just like Plain TeX. + +\typeout{Style Option FULLPAGE Version 2 as of 15 Dec 1988} + +\topmargin 0pt +\advance \topmargin by -\headheight +\advance \topmargin by -\headsep + +\textheight 8.9in + +\oddsidemargin 0pt +\evensidemargin \oddsidemargin +\marginparwidth 0.5in + +\textwidth 6.5in + + +% For users of A4 paper: The above values are suited for american 8.5x11in +% paper. If your output driver performs a conversion for A4 paper, keep +% those values. If your output driver conforms to the TeX standard (1in/1in), +% then you should add the following commands to center the text on A4 paper: + +% \advance\hoffset by -3mm % A4 is narrower. +% \advance\voffset by 8mm % A4 is taller. + +\endinput + + diff --git a/cil/doc/header.html.in b/cil/doc/header.html.in new file mode 100644 index 0000000..ff7c753 --- /dev/null +++ b/cil/doc/header.html.in @@ -0,0 +1,18 @@ + + + + + + + +CIL Documentation (v. @CIL_VERSION@) + + + + + +

CIL - Infrastructure for C Program Analysis and Transformation (v. @CIL_VERSION@)

+ + + + diff --git a/cil/doc/hevea.sty b/cil/doc/hevea.sty new file mode 100644 index 0000000..bd80200 --- /dev/null +++ b/cil/doc/hevea.sty @@ -0,0 +1,66 @@ +% hevea : hevea.sty +% This is a very basic style file for latex document to be processed +% with hevea. It contains definitions of LaTeX environment which are +% processed in a special way by the translator. +% Mostly : +% - latexonly, not processed by hevea, processed by latex. +% - htmlonly , the reverse. +% - rawhtml, to include raw HTML in hevea output. +% - toimage, to send text to the image file. +% The package also provides hevea logos, html related commands (ahref +% etc.), void cutting and image commands. +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{hevea}[1999/08/11] +\RequirePackage{comment} +\newif\ifhevea\heveafalse +\makeatletter% +\newcommand{\heveasmup}[2]{% +\raise #1\hbox{$\m@th$% + \csname S@\f@size\endcsname + \fontsize\sf@size 0% + \math@fontsfalse\selectfont +#2% +}}% +\DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}% +\DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}% +\DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}} +%%%%%%%%% Hyperlinks hevea style +\newcommand{\ahref}[2]{{#2}} +\newcommand{\ahrefloc}[2]{{#2}} +\newcommand{\aname}[2]{{#2}} +\newcommand{\ahrefurl}[1]{\texttt{#1}} +\newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}} +\newcommand{\mailto}[1]{\texttt{#1}} +\newcommand{\imgsrc}[2][]{} +\newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1} +\AtBeginDocument +{\@ifundefined{url} +{%url package is not loaded +\let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref} +{}} +%% Void cutting instructions +\newcounter{cuttingdepth} +\newcommand{\cuttingunit}{} +\newcommand{\cutdef}[2][]{} +\newcommand{\cuthere}[2]{} +\newcommand{\cutend}{} +\newcommand{\htmlhead}[1]{} +\newcommand{\htmlfoot}[1]{} +\newenvironment{cutflow}[1]{}{} +\newcommand{\cutname}[1]{} +%% TeX \let and \def inside HeVeA +\let\texlet\let +\let\texdef\def +%%%% Html only +\excludecomment{rawhtml} +\excludecomment{htmlonly} +%%%% Latex only +\newenvironment{latexonly}{}{} +\newenvironment{verblatex}{}{} +%%%% Image file stuff +\def\toimage{\endgroup} +\def\endtoimage{\begingroup\def\@currenvir{toimage}} +\def\verbimage{\endgroup} +\def\endverbimage{\begingroup\def\@currenvir{verbimage}} +\newcommand{\imageflush}[1][]{} +\makeatother diff --git a/cil/doc/html/.cvsignore b/cil/doc/html/.cvsignore new file mode 100644 index 0000000..72e8ffc --- /dev/null +++ b/cil/doc/html/.cvsignore @@ -0,0 +1 @@ +* diff --git a/cil/doc/index.html.in b/cil/doc/index.html.in new file mode 100644 index 0000000..31f4653 --- /dev/null +++ b/cil/doc/index.html.in @@ -0,0 +1,26 @@ + + + + + + +CIL Documentation (v. @CIL_VERSION@) + + + + + + + + + + <body> + + <p>This page uses frames, but your browser doesn't support them.</p> + + </body> + + + + \ No newline at end of file diff --git a/cil/doc/main.html b/cil/doc/main.html new file mode 100644 index 0000000..e738e30 --- /dev/null +++ b/cil/doc/main.html @@ -0,0 +1,42 @@ + + + + + + + + +

CIL (C Intermediate Language) +

+

CIL is a front-end for the C programming language that + facilitates program analysis and transformation. CIL will parse and typecheck a + program, and compile it into a simplified subset of C. For example, in CIL all + looping constructs are given a single form and expressions have no + side-effects. This reduces the number of cases that must be considered when + manipulating a C program. CIL has been used for a variety of projects, + including CCured, a tool that makes C programs memory safe.

+

CIL supports ANSI C as well as most of the extensions of the GNU + C and Microsoft C compilers. A Perl script acts as a drop in replacement for + either gcc or Microsoft's cl, and allows merging of the source files in your + project. Other features include support for control-flow and points-to + analyses.  More information can be found + here.

+

 

+

About CIL:

+ +

 

+ + diff --git a/cil/doc/makefiles.txt b/cil/doc/makefiles.txt new file mode 100644 index 0000000..61dc232 --- /dev/null +++ b/cil/doc/makefiles.txt @@ -0,0 +1,138 @@ +Cil Makefile Structure +---------------------- + +(Originally written by Scott, updated 11/19/01.) + +The build rules are spread out among several Makefiles: + + Makefile - toplevel driver Makefile, interprets a variety + of command-line arguments (e.g. INFERBOX=infer), + and has rules for all the tests/benchmarks + + Makefile.gcc - definitions of make variables that specify the syntax + of invoking gcc; for example, it has "INC := -I", + meaning -I is the option to name include directories + + Makefile.msvc - similar to above, but for MS's "cl.exe" command-line + compiler (e.g. "INC := /I") + + Makefile.ccured - rules for building the 'ccured' program and runtime + library + + Makefile.ocaml - generic Makefile for OCaml projects; includes targets + to compile and link ML sources into bytecode or + native code + + Makefile.combiner - rules for making the 'combiner' program + + Makefile.cil - rules for making the 'cilly' program + + +------------- Makefile ----------- +Typical usage is to run only the toplevel Makefile, but specify options +on the command line saying what to do. For example: + + make - build the bytecode 'ccured' and debug library + +Some of the more important command-line options: + + NATIVECAML=1 - build native code 'ccured' + RELEASELIB=1 - build non-debug library + OPTIM=1 - enable ccured's built-in optimizer module + RELEASE=1 - native code, non-debug, optimizer enabled, etc. + NOGC=1 - disable the garbage collector (use malloc/free) + NOLINES=1 - disable #line directives in output + COMMLINES=1 - print #line, but only as comments + TRACE=flag1,.. - enable various debug output flags + LOGCALLS=1 - transform code to print at every function entry + LOGSTYLE=n - style for LOGCALLS; see Makefile for n's meaning + INFERBOX=infer - turn on full ccured transformation; without this, + it just transforms to Cil and outputs uninstrumented + +so for example "make RELEASE=1" will build release versions of things. +Some other targets of interest: + + make clean - remove compilation byproducts, including executables + make odoc - make OCamlDoc documentation .html files + make setup - build *both* bytecode/native, debug/non-debug + +For convenience, we've put targets into the Makefile for various test +programs and benchmarks we use. For example: + + make go INFERBOX=infer - build spec95 "go" benchmark in ccured mode + make power - build Olden "power" benchmark in cil-only mode + +The line "below here are rules for building benchmarks" separates the +benchmark targets. + + +------------- Makefile.ccured ----------- +This file does three jobs: + - supplies parameters to Makefile.ocaml that let it build the + 'ccured' executable, which transforms C code to add runtime checks + - says how to build the CCured runtime library + - produce patched versions of some system #include files + +Among the info to build 'ccured', the most important is the "MODULES" +line, which says what are the ML modules which comprise this program. + +Note that order is *very* important: the OCaml linker wants to see +*no* forward references, so the modules admit a total order on +dependencies. (If modules A and B call each other, you can list A +first, and let B have an exported function reference which module A then +sets to point at one of A's functions. Ugly, I know.) + +Some of the configuration rules from Makefile are repeated in +Makefile.ocaml. This is unfortunate.. + +The runtime library contains wrappers for C library calls, and the +Boehm-Weiser conservative garbage collector. + +The library's name is dependent on (1) which compiler you're using, +(2) whether it's being build in debug mode or not, and (3) what the +extension for libraries is on the current platform. For +gcc/debug/linux, it's obj/ccured_GNUCC_debug.a. + +The garbage collector is built essentially independently, yielding +its "gc.a" library. The CCured modules are then added to this. + + +-------------- Makefile.ocaml ------------ +This makefile is a generic OCaml build system. You tell it the names +of the modules to build, and it compiles and links them. A major +choice is whether to build bytecode or native code, determined by +whether NATIVECAML is defined. + +The rules themselves are complicated because this makefile works +hard to allow the source files (.ml, etc.) to live in a different +directory than the compiled object files (.cmo, etc.). + +If you want to see the details of the build process, set the variable +ECHOSTYLE_SCOTT (in your .ccuredrc, for example). This will print +every command executed which has a side effect. Without this you'll +just see English descriptions of what's happening. + + +------------- stylistic conventions ---------- +For the most part, we try to use ":=" instead of "=". Basically, ":=" +evaluates its right-hand-side the moment it's parsed, whereas the +RHS of "=" is evaluated every time the variable is referenced. We +find it's easier to predict how ":=" will behave, so unless the delayed +evaluation of "=" is really desired, use ":=". + +Please indent the bodies of "ifdef..endif". This works fine, and +makes the files much easier to read. (I'm not going to explore here +the theology behind how *much* to indent...) + + +-------------- references -------------- +Main Cil docs: + http://raw.cs.berkeley.edu/ccured/cil/index.html + +GNU Make manual: + http://www.gnu.org/manual/make/html_chapter/make_toc.html + +"Recursive Make Considered Harmful", an interesting and informative +article about how to use and misuse make: + http://www.tip.net.au/~millerp/rmch/recu-make-cons-harm.html + diff --git a/cil/doc/ocamldoc.html b/cil/doc/ocamldoc.html new file mode 100644 index 0000000..9f1ae13 --- /dev/null +++ b/cil/doc/ocamldoc.html @@ -0,0 +1,88 @@ + + + How to build the ocamldoc tool + + + +

How to build the ocamldoc tool

+ +

ocamldoc +is a tool for extracting documentation from specially-formatted +comments in the source code. It works similarly to +javadoc. +The following instructions explain how to get, build, and use this tool, +especially in the context of the CCured project.

+ +

For the purposes of these instructions, pick some directories:

+
  • $DIST: directory where you'll download the tarballs + (e.g. /home/scott/dist) +
  • $BLD: directory where you'll compile the software + (e.g. /home/scott/bld) +
  • $PREFIX: directory into which the compiled files will be installed + (e.g. /home/scott/lib/ocaml-current or /usr/local) +
  • $CIL: toplevel directory of ccured ("cil") repository + (e.g. /home/scott/wrk/safec/cil) +
+ +

First, download and build the latest +CVS snapshot of the OCaml compiler: +

+  % cd $BLD
+  % cvs -d :pserver:anoncvs@camlcvs.inria.fr:/caml checkout ocaml
+  % cd ocaml
+  % ./configure --prefix $PREFIX
+  % make world
+  % make opt
+  % make ocamlc.opt         # ocamldoc wants this?
+  % make install
+

+ +

Next, download the +ocamldoc distribution tarball, and build it: +

+  % cd $BLD
+  % tar xvfz $DIST/ocamldoc_08_10_2001.tar.gz
+  % cd ocamldoc
+  % ln -s $BLD/ocaml ocaml
+  % patch -p1 < $CIL/doc/ocamldoc.patch     # fix configure.in
+  % PATH=$PREFIX/bin:$PATH                  # for sh/bash
+      or
+  % set path = ($PREFIX/bin $path)          # for csh/tcsh
+  % autoconf
+  % ./configure                             # inherits --prefix from above
+  % make depend
+  % make all
+  (fails with complaint about either missing .cmx (if ocamlc.opt not built)
+  or "inconsistent assumptions over implementation Odoc_misc", but this
+  doesn't matter since it makes 'odoc' successfully)
+  % make install
+  (succeeds in copying 'odoc' to $PREFIX/bin, but fails to copy odoc_info.cma; ignoring)
+
+The resulting odoc binary can be copied anywhere and used. However, +it contains within it the path to the 'ocamlrun' binary in $PREFIX/bin, so +that has to stay put. Building odoc.opt unfortunately fails.

+ +

(optional) Staying in $BLD/ocamldoc, we can have it +generate a few sample documentation files: +

+  % make doctest          # build docs of ocamldoc sources -> doctest/
+  % make stdlib           # build docs of ocaml library sources -> stdlib/
+  (appears to fail with "Unbound module Support", but actually succeeds)
+

+ + +

Finally, we can use this to generate documentation for the CCured sources: +

+  % cd $CIL
+  % make                  # need the .cmi files built
+  % make odoc
+
+This will dump a bunch of .html files into the odoc/ directory. It also may spew +some messages about errors parsing text inside comments; those messages are +nonfatal but should be addressed.

+ +
+

Originally written by Scott. + + + diff --git a/cil/doc/ocamldoc.patch b/cil/doc/ocamldoc.patch new file mode 100644 index 0000000..73560d7 --- /dev/null +++ b/cil/doc/ocamldoc.patch @@ -0,0 +1,141 @@ +diff -cb ocamldoc-orig/configure.in ocamldoc/configure.in +*** ocamldoc-orig/configure.in Fri Oct 5 13:15:45 2001 +--- ocamldoc/configure.in Sat Oct 20 13:04:20 2001 +*************** +*** 44,50 **** + else + AC_MSG_CHECKING(ocamlopt version) + TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` +! if test "$TMPVERSION" != $OCAMLVERSION ; then + AC_MSG_RESULT(differs from ocamlc; ocamlopt discarded.) + OCAMLOPT=no + else +--- 44,50 ---- + else + AC_MSG_CHECKING(ocamlopt version) + TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` +! if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(differs from ocamlc; ocamlopt discarded.) + OCAMLOPT=no + else +*************** +*** 58,64 **** + if test "$OCAMLCDOTOPT" != no ; then + AC_MSG_CHECKING(ocamlc.opt version) + TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` +! if test "$TMPVERSION" != $OCAMLVERSION ; then + AC_MSG_RESULT(differs from ocamlc; ocamlc.opt discarded.) + else + AC_MSG_RESULT(ok) +--- 58,64 ---- + if test "$OCAMLCDOTOPT" != no ; then + AC_MSG_CHECKING(ocamlc.opt version) + TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` +! if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(differs from ocamlc; ocamlc.opt discarded.) + else + AC_MSG_RESULT(ok) +*************** +*** 72,78 **** + if test "$OCAMLOPTDOTOPT" != no ; then + AC_MSG_CHECKING(ocamlc.opt version) + TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` +! if test "$TMPVER" != $OCAMLVERSION ; then + AC_MSG_RESULT(differs from ocamlc; ocamlopt.opt discarded.) + else + AC_MSG_RESULT(ok) +--- 72,78 ---- + if test "$OCAMLOPTDOTOPT" != no ; then + AC_MSG_CHECKING(ocamlc.opt version) + TMPVER=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` +! if test "$TMPVER" != "$OCAMLVERSION" ; then + AC_MSG_RESULT(differs from ocamlc; ocamlopt.opt discarded.) + else + AC_MSG_RESULT(ok) +diff -cb ocamldoc-orig/odoc_html.ml ocamldoc/odoc_html.ml +*** ocamldoc-orig/odoc_html.ml Mon Oct 8 08:32:51 2001 +--- ocamldoc/odoc_html.ml Sun Oct 21 01:11:24 2001 +*************** +*** 218,223 **** +--- 218,237 ---- + val mutable constructor_color = "SlateBlue" + + ++ (* sm: utility to get toplevel title string *) ++ method topTitle () : string = ( ++ match !Odoc_args.title with ++ None -> "" ++ | Some t -> Text.escape t ++ ) ++ ++ (* sm: title of something below the toplevel *) ++ method innerTitle (s:string) : string = ( ++ match !Odoc_args.title with ++ None -> s ++ | Some t -> (Text.escape t) ^ ": " ^ s ++ ) ++ + (** Return html code with the given string in the keyword color.*) + method keyword s = ""^s^"" + +*************** +*** 967,972 **** +--- 981,987 ---- + style^ + "\n"^ + "\n"^ ++ (self#innerTitle cl.cl_name)^ + "\n"^ + "\n"^ + "\n"^ +*************** +*** 1010,1015 **** +--- 1025,1031 ---- + style^ + "\n"^ + "\n"^ ++ (self#innerTitle clt.clt_name)^ + "\n"^ + "\n"^ + "\n"^ +*************** +*** 1053,1058 **** +--- 1069,1075 ---- + style^ + "\n"^ + "\n"^ ++ (self#innerTitle mt.mt_name)^ + "\n"^ + "\n"^ + "\n"^ +*************** +*** 1132,1137 **** +--- 1149,1155 ---- + style^ + "\n"^ + "\n"^ ++ (self#innerTitle modu.m_name)^ + "\n"^ + "\n"^ + "\n"^ +*************** +*** 1204,1214 **** + method generate_index module_list = + try + let chanout = open_out (Filename.concat !Odoc_args.target_dir "index.html") in +! let t = +! match !Odoc_args.title with +! None -> "" +! | Some t -> Text.escape t +! in + output_string chanout + ( + "\n"^ +--- 1222,1228 ---- + method generate_index module_list = + try + let chanout = open_out (Filename.concat !Odoc_args.target_dir "index.html") in +! let t = (self#topTitle ()) in + output_string chanout + ( + "\n"^ diff --git a/cil/doc/program.sty b/cil/doc/program.sty new file mode 100644 index 0000000..315faa6 --- /dev/null +++ b/cil/doc/program.sty @@ -0,0 +1,265 @@ +%% +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{program} + [1998/07/30 1.0 Source program environment for LaTeX] +\RequirePackage{keyval} + +% +% Style for writing programs +% +%\begin{program}[number,stretch=1.1] +% even if you do not have options better put [] (but in Latex's \newcommand) +% Options: +% number[=true] - numbers all the lines with \prognumstyle +% firstline=xxx - sets the first line number +% numberevery[=1]- put a number every n lines (first is always numbered) +% box[=true] - puts the whole program in a minipage +% valign[=t] - the valign to be passed to minipage +% width=xxx - the width to be passed to minipage +% style=xxx - the default style of text in env. Can be "math" or "tt" +% Or, redefine \Programstyle{#1}{#2} so that #1 is the +% style start and #2 is the style end +% stretch=xxx - factor to stretch the distance between lines +% +% line breaks are verbatim. Put % to prevent a newline +% !foo! writes foo with \formatname{foo}. Default \tt +% |bar| writes bar with \formatvariable{bar}. Default \mathit +% @foo@ writes foo with \formattext. Default \mbox +% \tab idents future lines here +% \stab{dim} puts a \tab forward of this location and backs up +% \qtab = \quad\tab +% \untab undoes the last undone \tab +% \rjust{txt} puts txt right justified +% \rcomment{txt} like \rjust but with \formatcomment{txt}. Default \mbox +% \lab{txt} puts a label leftjustified with \formatlabel{txt} +% \labspace{txt} use on first line to create indentation that clears labels +% \nonumber omits the line number in this line. The line number is not +% incremented +% \donumber makes sure a line number is emitted +% \bumpnumber{5} increments the line number by 5. Visible on current line +% +% This environment is built on top of Latex tabbing environment. As such the +% tabbing commands work here as well. However, some tabbing commands will +% interfere with the program environment. The command that you can use are: +% \> advance to the next tab +%\end{program} +% +% Define the options +% +% Define a boolean key with a default value if used without = +\def\Prog@defboolkey#1[#2]{% + \expandafter\newif\csname ifProg@#1\endcsname % Define the if + \define@key{Prog}{#1}[#2]{\csname Prog@#1##1\endcsname}} +\def\Prog@defvalkey#1[#2]{% + \define@key{Prog}{#1}[#2]{\expandafter\def\csname Prog@#1\endcsname{##1}}} +\def\Prog@defvalkeynodef#1{% + \define@key{Prog}{#1}{\expandafter\def\csname Prog@#1\endcsname{##1}}} + + +\Prog@defboolkey{number}[true] % numbers lines +\Prog@defboolkey{box}[true] % it puts the program in a parbox +\Prog@defboolkey{style}[math] % Can be math or tt +\Prog@defvalkey{valign}[t] % how to align the minipage (if in box) +\Prog@defvalkey{stretch}[1.0] % Factor to stretch the distance betwee lines +\Prog@defvalkeynodef{width} +\Prog@defvalkeynodef{firstline} +\Prog@defvalkey{numberevery}[1]% Put a line number every n lines. + +% Set the defaults +\setkeys{Prog}{box=true,number=false,firstline=1,numberevery=1, + valign=t,style=math,stretch=1.0,width=\z@} + +% Set the global defaults +% +% User parameters +% +\def\ProgramStyle#1#2{\def\ProgramStyleStart{#1}% + \def\ProgramStyleEnd{#1}} +\def\Prog@stylett{\ProgramStyle{\tt}{}} +\def\Prog@stylemath{\ProgramStyle{$}{$}} +\Prog@stylemath + +% How to print line numbers +\def\prognumstyle{\scriptsize\em} % The style for printing line nos +\def\formatkeyword#1{\keepspaceafter{\underbar{\bfseries #1}}} +\def\formatvariable#1{\keepspaceafter{\mbox{$\mathit{#1}$}}} +\def\formatcomment#1{\mbox{#1}} +\def\formattext#1{\keepspaceafter{\mbox{#1}}} +\def\proglabelskip{1mm} +\def\formatlabel#1{#1:\hskip\proglabelskip} + +\def\formatname#1{\keepspaceafter{\mbox{\ttfamily #1}}} + + +\def\tab{{}\=\+{}}% +\def\stab#1{\hskip #1\tab\hskip -#1} +\def\qtab{\quad\tab}% +\def\untab{{}\-{}}% +\def\rjust#1{\`#1} +\def\rcomment#1{\`\formatcomment{#1}}% +\def\lab#1{\gdef\prog@label{\formatlabel{#1}}}% +\def\labref#1{\mbox{#1}} +\def\labspace#1{\phantom{\formatlabel{#1}}} + +\def\proglabelwidth{1em} + +%%%%%%%%%%%%%% +\newcounter{programline} +\newcounter{programlineskip} +\newcounter{programid}\setcounter{programid}{0} + %This is for hyperref to make the line numbers + %unique in a document +\def\theHprogramline{\arabic{programid}.\arabic{programline}} + +\let\exclmark=! +{% Set |...| to print the ... as a variable + \catcode`\|=\active\relax + \let\prog@bar=|% + \gdef|#1|{\formatvariable{#1}} +% % Set ; to print a thick space after it in math mode +% \let\prog@semicolon=; +% \catcode`\;=\active\relax +% \gdef;{\ifmmode\prog@semicolon\;\else\prog@semicolon\fi} + % Set !...! to print the ... as a name + \catcode`\!=\active\relax + \gdef!#1!{\formatname{#1}} + % Set @...@ to print the ... as text + \catcode`\@=\active\relax + \gdef@#1@{\formattext{#1}} +} + % Define prog@space +\def\@tmp.{\futurelet\prog@space\relax}\@tmp. \relax + % Keep a space after something +\def\keepspaceafter#1{\def\@tmp{#1}% + \futurelet\@next\@keepspaceafteri} +\def\@keepspaceafteri{\ifx\@next\prog@space + \def\@tmpi{\@tmp\ }% + \else + \def\@tmpi{\@tmp}\fi + \@tmpi} + + + +% +% The next few macros override macros from the Latex tabbing environment +% +\def\prog@numberthisline{1}% Default is line numbering +\def\prog@nonumber{\gdef\prog@numberthisline{0}} +\def\prog@donumber{\gdef\prog@numberthisline{1}} +\def\prog@bumpnumber#1{\addtocounter{programline}{#1}} + +\def\prog@startline{% + \ifProg@number + \refstepcounter{programline}% Increment the program line before each line + \fi + \prog@origstartline} + +\def\prog@printlineno{\ifProg@number + \hskip\proglabelwidth + \ifnum\prog@numberthisline=1\relax + \ifnum\theprogramlineskip=0\relax + \llap{\prognumstyle\theprogramline}% + \setcounter{programlineskip}{\Prog@numberevery}% + \fi + \addtocounter{programlineskip}{-1}% + \else + \addtocounter{programline}{-1}% + \prog@donumber + \fi + \fi + \hskip\labelsep + % Now put the current label + \ifx\prog@label\empty \else + \setbox\z@\hbox{\prog@label}% + \copy\z@ \hskip -\wd\z@ + \global\let\prog@label=\empty + \fi + } + +\def\prog@startfield{% + \prog@origstartfield + \ProgramStyleStart} + +\def\prog@stopfield{% + \ProgramStyleEnd + \prog@origstopfield} + +% A new version of @stopline which ignores blank lines (lines with +% width 0pt) and prints line numbers. To print a blank line, put "\ \\" on it! +% +\def\prog@stopline{% + \unskip\@stopfield + \if@rjfield + \global\@rjfieldfalse + \@tempdima\@totalleftmargin \advance\@tempdima\linewidth + \hbox to\@tempdima{\@itemfudge\prog@printlineno\hskip\dimen\@curtabmar + \box\@curline\hfil\box\@curfield}% + \else + \@addfield + \ifdim\wd\@curline=0pt% + \ifProg@number \addtocounter{programline}{-1}\fi + \else + \hbox{\@itemfudge\prog@printlineno\hskip\dimen\@curtabmar\box\@curline}% + \fi +\fi +} + + +\newcommand\program[1][]{% + \stepcounter{programid}% + \bgroup % Start a group so that we can undo easily most assignments + % Process the optional arguments + \def\Prog@width{\z@}% + \setkeys{Prog}{#1}% + \ifdim\Prog@width=\z@ + \edef\Prog@width{\the\linewidth}% + \fi + % Line numbering + \ifProg@number + \prog@donumber + \else + \prog@nonumber + \fi + % Whether in a box + \ifProg@box + \begin{minipage}[\Prog@valign]{\Prog@width}% + \fi + % The distance between lines + \setbox\strutbox\hbox{% + \vrule\@height\Prog@stretch\ht\strutbox + \@depth\Prog@stretch\dp\strutbox + \@width\z@}% + \setcounter{programline}{\Prog@firstline}% + \addtocounter{programline}{-1}% Adjust for preincrement + \let\prog@label=\empty + \let\prog@origbar=|% + \catcode`\|=\active\relax + \catcode`\!=\active\relax + \catcode`\@=\active\relax + % Start a tabbing environment with obey lines + \let\prog@origstartline=\@startline + \let\@startline=\prog@startline + \let\@stopline=\prog@stopline + \let\prog@origstartfield=\@startfield + \let\@startfield=\prog@startfield + \let\prog@origstopfield=\@stopfield + \let\@stopfield=\prog@stopfield + \let\nonumber=\prog@nonumber + \let\donumber=\prog@donumber + \let\bumpnumber=\prog@bumpnumber + \obeycr% All lines after this must end with a comment + \tabbing% Everything after this is local to a field +% \@gobblecr +} + +\def\endprogram{% + \endtabbing% + \restorecr% + \ifProg@box + \end{minipage}% + \fi + \egroup +} + + + diff --git a/cil/doc/proof.sty b/cil/doc/proof.sty new file mode 100644 index 0000000..00d002c --- /dev/null +++ b/cil/doc/proof.sty @@ -0,0 +1,296 @@ +% proof.sty (Proof Figure Macros) +% +% version 3.0 (for both LaTeX 2.09 and LaTeX 2e) +% Mar 6, 1997 +% Copyright (C) 1990 -- 1997, Makoto Tatsuta (tatsuta@kusm.kyoto-u.ac.jp) +% +% This program is free software; you can redistribute it or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either versions 1, 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. +% +% Usage: +% In \documentstyle, specify an optional style `proof', say, +% \documentstyle[proof]{article}. +% +% The following macros are available: +% +% In all the following macros, all the arguments such as +% and are processed in math mode. +% +% \infer +% draws an inference. +% +% Use & in to delimit upper formulae. +% consists more than 0 formulae. +% +% \infer returns \hbox{ ... } or \vbox{ ... } and +% sets \@LeftOffset and \@RightOffset globally. +% +% \infer[

>" ,*q = "<>" ,*r = "<>" ; + char dest_buf[1024]; + char *s1, *s2; + + printf("printf: %s %ld %0.20s %x\n",p,x,q,y); + fprintf(stdout,"fprintf: %s %ld %0.20s %x\n",p,y,q,z); + sprintf(dest_buf,"sprintf: %s %ld %0.20s %x",p,z,q,x); + printf("printf: dest_buf = [%s]\n",dest_buf); + + s1 = &dest_buf[5]; + s2 = &s1[5]; + + printf("printf: chop 5: [%s]\n", s1); + printf("printf: chop 5 more, print %d: [%.*s]\n",len,len,s2); + + printf("printf: null = %s\n",(char*)0); + + return 0; +} diff --git a/cil/test/small1/printf2.c b/cil/test/small1/printf2.c new file mode 100644 index 0000000..a1b3436 --- /dev/null +++ b/cil/test/small1/printf2.c @@ -0,0 +1,17 @@ +#include "testharness.h" + +#include + + +int main() { + char buffer[16]; // Plenty of space + double d = 7.75; + + sprintf(buffer, "%5.2f", d); // Make sure we print this as a double + + printf("The buffer is: %s\n", buffer); + + if(buffer[0] != ' ' || buffer[1] != '7' || buffer[2] != '.') E(1); + + SUCCESS; +} diff --git a/cil/test/small1/printf_const.c b/cil/test/small1/printf_const.c new file mode 100755 index 0000000..4cf0060 --- /dev/null +++ b/cil/test/small1/printf_const.c @@ -0,0 +1,20 @@ +#include + +int main() { + char const * p1 = "first string"; + const char * p2 = "second string"; + const int x = 5; + const int y = 6; + int const * p3 = &x; + const int * p4 = &y; + const double d = 5.5; + + printf("p1 = %s\n",p1); + fprintf(stdout,"p2 = %s\n",p2); + printf("p3 = %p\n",(long)p3); + fprintf(stdout,"p4 = %s\n",(long)p4); + printf("x = %d\n",x); + printf("d = %g\n",d); + + return 0; +} diff --git a/cil/test/small1/proto1.c b/cil/test/small1/proto1.c new file mode 100644 index 0000000..cc2ea55 --- /dev/null +++ b/cil/test/small1/proto1.c @@ -0,0 +1,14 @@ + +int foo(); // Forward declaration + +struct bar { + int x, y; +}; + +int (*pfoo)() = (int (*)())foo; + +// Now the real declaration +int foo(struct bar *a) { + return a->x + a->y; +} + diff --git a/cil/test/small1/proto2.c b/cil/test/small1/proto2.c new file mode 100644 index 0000000..7116338 --- /dev/null +++ b/cil/test/small1/proto2.c @@ -0,0 +1,13 @@ +// From c-torture + +g (); // This line cannot be parsed + // add "int" in front and everythign is Ok + +f () +{ + long ldata[2]; + int seed; + + seed = (ldata[0]) + (ldata[1] << 16); + g (seed); +} diff --git a/cil/test/small1/pure.c b/cil/test/small1/pure.c new file mode 100644 index 0000000..e6bfd81 --- /dev/null +++ b/cil/test/small1/pure.c @@ -0,0 +1,8 @@ +int pure[700000 / sizeof (int)] = {0,} ; + +int main() { + char *blah = (char *)pure; + return 0; +} + + diff --git a/cil/test/small1/question.c b/cil/test/small1/question.c new file mode 100755 index 0000000..2f8b4c6 --- /dev/null +++ b/cil/test/small1/question.c @@ -0,0 +1,8 @@ +#include "testharness.h" + +int main() { + const char *string = "hello"; // works if you remove const! + const char *p; + p = string ? string : "NULL"; + SUCCESS; +} diff --git a/cil/test/small1/question2.c b/cil/test/small1/question2.c new file mode 100755 index 0000000..e0a6af2 --- /dev/null +++ b/cil/test/small1/question2.c @@ -0,0 +1,50 @@ +//Shorter version of ilog2 from the linux kernel. +//This tests for an exponential-time bug in cabs2cil's handling of ?: + +#define ilog2(n) \ +( \ + __builtin_constant_p(n) ? ( \ + (n) < 1 ? -1 : \ + (n) & (1ULL << 31) ? 31 : \ + (n) & (1ULL << 30) ? 30 : \ + (n) & (1ULL << 29) ? 29 : \ + (n) & (1ULL << 28) ? 28 : \ + (n) & (1ULL << 27) ? 27 : \ + (n) & (1ULL << 26) ? 26 : \ + (n) & (1ULL << 25) ? 25 : \ + (n) & (1ULL << 24) ? 24 : \ + (n) & (1ULL << 23) ? 23 : \ + (n) & (1ULL << 22) ? 22 : \ + (n) & (1ULL << 21) ? 21 : \ + (n) & (1ULL << 20) ? 20 : \ + (n) & (1ULL << 19) ? 19 : \ + (n) & (1ULL << 18) ? 18 : \ + (n) & (1ULL << 17) ? 17 : \ + (n) & (1ULL << 16) ? 16 : \ + (n) & (1ULL << 15) ? 15 : \ + (n) & (1ULL << 14) ? 14 : \ + (n) & (1ULL << 13) ? 13 : \ + (n) & (1ULL << 12) ? 12 : \ + (n) & (1ULL << 11) ? 11 : \ + (n) & (1ULL << 10) ? 10 : \ + (n) & (1ULL << 9) ? 9 : \ + (n) & (1ULL << 8) ? 8 : \ + (n) & (1ULL << 7) ? 7 : \ + (n) & (1ULL << 6) ? 6 : \ + (n) & (1ULL << 5) ? 5 : \ + (n) & (1ULL << 4) ? 4 : \ + (n) & (1ULL << 3) ? 3 : \ + (n) & (1ULL << 2) ? 2 : \ + (n) & (1ULL << 1) ? 1 : \ + (n) & (1ULL << 0) ? 0 : \ + -1 \ + ) : \ + 0 ) + + + +int main() { + int log = ilog2(63); + printf("%d\n", log); + return 0; +} diff --git a/cil/test/small1/restrict.c b/cil/test/small1/restrict.c new file mode 100644 index 0000000..7fa347f --- /dev/null +++ b/cil/test/small1/restrict.c @@ -0,0 +1,14 @@ +void vadd (const double * restrict a, + const double * restrict b, + double * restrict c, + int n) +{ + int i; + for(i=0;i +#include + +#define PAGE_SIZE 512; +#define FREAK() printf("wow.") + +typedef struct b_data_t { + int node_boot_start; + int node_low_pfn; +} bootmem_data_t; + +typedef struct pg_d_t { + struct b_data_t* bdata; +} pg_data_t; + +static void free_bootmem_core(bootmem_data_t *bdata, unsigned long addr, unsigned long size) { + unsigned long i; + unsigned long start; + unsigned long sidx; + unsigned long eidx, end; + eidx = (addr + size - bdata->node_boot_start)/PAGE_SIZE; + end = (addr + size)/PAGE_SIZE; + + if (!size) FREAK(); + if (end > bdata->node_low_pfn) + FREAK(); + +} + +void free_bootmem_node(pg_data_t *pgdat, unsigned long physaddr, unsigned long size) { + return(free_bootmem_core(pgdat->bdata, physaddr, size)); +} + +int main(int charc, char ** argv) { + return 0; +} diff --git a/cil/test/small1/retval.c b/cil/test/small1/retval.c new file mode 100644 index 0000000..d691d1c --- /dev/null +++ b/cil/test/small1/retval.c @@ -0,0 +1,9 @@ + +typedef struct rbNode { + int filler; + char data[0]; +} RBNode; + +char * ret_field(RBNode * r) { + return & (r->data[0]); +} diff --git a/cil/test/small1/rmtmps-attr.c b/cil/test/small1/rmtmps-attr.c new file mode 100644 index 0000000..b5a4cd0 --- /dev/null +++ b/cil/test/small1/rmtmps-attr.c @@ -0,0 +1,14 @@ +#include "testharness.h" + +int main() +{ + int a; + int b __attribute__((myattribute(a == a))); + b = 5; + // our remove-temps code will remove "a", even though GCC thinks it is + // necessary + + // GN: This is because the "a" in the attribute is not a reference to the + // variable, but just an indentifier ! + SUCCESS; +} diff --git a/cil/test/small1/rmtmps1.c b/cil/test/small1/rmtmps1.c new file mode 100644 index 0000000..5c94183 --- /dev/null +++ b/cil/test/small1/rmtmps1.c @@ -0,0 +1,17 @@ +#include "testharness.h" + +int system_utsname; + +struct nlm_rqst { + unsigned int a_flags; + char a_owner[(sizeof(system_utsname)+10) ]; +}; + + +int main() { + + struct nlm_rqst s; + if(sizeof(s) != sizeof(struct nlm_rqst)) E(1); + + SUCCESS; +} diff --git a/cil/test/small1/rmtmps2.c b/cil/test/small1/rmtmps2.c new file mode 100644 index 0000000..c5e006f --- /dev/null +++ b/cil/test/small1/rmtmps2.c @@ -0,0 +1,48 @@ +typedef struct { volatile int counter; } atomic_t; + + +static __inline__ int atomic_dec_and_test(atomic_t *v) +{ + unsigned char c; + + __asm__ __volatile__( + "" "decl %0; sete %1" + :"=m" (v->counter), "=qm" (c) + :"m" (v->counter) : "memory"); + return c != 0; +} + +struct mm_struct { + atomic_t mm_users; + atomic_t mm_count; +}; + + + +extern inline void __mmdrop(struct mm_struct *) __attribute__((regparm(3))) ; +static inline void mmdrop(struct mm_struct * mm) +{ + if (atomic_dec_and_test(&mm->mm_count)) + __mmdrop(mm); +} + + + +inline void __mmdrop(struct mm_struct *mm) +{ + return; +} + + + +void mmput(struct mm_struct *mm) +{ + if (atomic_dec_and_test(&mm->mm_users) ) { + mmdrop(mm); + } +} + +// Just want to check that __mmdrop is not dropped +int main() { + return 0; +} diff --git a/cil/test/small1/scope1.c b/cil/test/small1/scope1.c new file mode 100644 index 0000000..624ee38 --- /dev/null +++ b/cil/test/small1/scope1.c @@ -0,0 +1,44 @@ +extern void exit(int); + +int foo[5]; + +enum foo { + l1 = 0, + l2, l3 +}; + + +typedef struct Person { + char *name; +} Person; + + + +int main() { + int l, *l2 = & l; + extern int globint; + Person *Person = 0; + { + int * l1 = l2; + *l1 = *l2 + l3; + globint = 2; + } + { + extern int globint; + void increm(int *); + enum { + l1 = 7, + l2 = 9, + } z; + increm(& globint); + return ((l1 + l2 + l3) - 18) + (globint - 3); + } + *l2 = l3 + l1; + exit(1); +} + +void increm(int *i) { + (*i) ++; +} + +int globint; diff --git a/cil/test/small1/scope10.c b/cil/test/small1/scope10.c new file mode 100755 index 0000000..22f2bf3 --- /dev/null +++ b/cil/test/small1/scope10.c @@ -0,0 +1,14 @@ +int blah() +{ + static float test = 0; + test++; +} + +static int test = 0; + +int main(int argc, char **argv) +{ + blah(); + test = 1; + return 0; +} diff --git a/cil/test/small1/scope11.c b/cil/test/small1/scope11.c new file mode 100755 index 0000000..5b187d6 --- /dev/null +++ b/cil/test/small1/scope11.c @@ -0,0 +1,13 @@ +int blah() +{ + static float test = 0; + test++; +} + +int test = 0; + +int main(int argc, char **argv) +{ + blah(); + return 0; +} diff --git a/cil/test/small1/scope2.c b/cil/test/small1/scope2.c new file mode 100644 index 0000000..c3df204 --- /dev/null +++ b/cil/test/small1/scope2.c @@ -0,0 +1,35 @@ + +// Verify the coping for enum, struct union + +typedef struct str { + int x; +} STR; + +int f1(STR *s1) { + struct str { + int y; + } x; + s1->x = x.y; +} + +typedef struct { int g; } Z; + +struct str glob1; + +int f2() { + struct str { + int a; + }; + while(1) { + typedef struct str { + int z; + } Z; + + struct str a; + glob1.x = ((Z*)&glob1)->z; + } +} + + +Z globz; +int * globza = & globz.g; diff --git a/cil/test/small1/scope3.c b/cil/test/small1/scope3.c new file mode 100644 index 0000000..30ae334 --- /dev/null +++ b/cil/test/small1/scope3.c @@ -0,0 +1,19 @@ + + +struct def *bar(); // Forward declaration + + +typedef int INT; +enum lateenum { + FOO, BAR +}; + +typedef struct def { + int f1; +} *defnamed; + +void foo() { + bar(BAR, 5); +} + +defnamed bar(enum lateenum x1, INT x2); diff --git a/cil/test/small1/scope4.c b/cil/test/small1/scope4.c new file mode 100644 index 0000000..caa02fe --- /dev/null +++ b/cil/test/small1/scope4.c @@ -0,0 +1,22 @@ +/* Generated by Frontc */ +#include // malloc + +char * * pm_allocarray(int cols , int rows , int size ) +{ + char * * its ; + int i ; + its = (char * * )malloc(rows * sizeof(char * )); + its[0] = (char * )malloc(rows * cols * size); + return its; +} + + + +int ppm_parsecolor(char * colorname , int maxval ) +{ + int hexit[256] , i ; + int p ; + return p; +} + +static char colorname[200] ; diff --git a/cil/test/small1/scope5.c b/cil/test/small1/scope5.c new file mode 100644 index 0000000..41845b2 --- /dev/null +++ b/cil/test/small1/scope5.c @@ -0,0 +1,29 @@ + +int * external(int *); + + +int foo(int *y) { + int *external(int *z); // We must pull this out + int (* local1)() = 0; // We must leave this here + int (* local2[4])(); // And this one as well + + local2[0] = local1; // Use them somehow + + return * external(y); +} + +int *external(int *x) { + // Do something to prevent this on from being inlined. If it is inlined + // then the STACKPOINTER check will fail + return x + 1; +} + + + +int main(void) { + int x[2]; + x[0] = 1; + x[1] = 7; + return !(foo(x) == 7); +} + diff --git a/cil/test/small1/scope6.c b/cil/test/small1/scope6.c new file mode 100644 index 0000000..158a61e --- /dev/null +++ b/cil/test/small1/scope6.c @@ -0,0 +1,22 @@ +#include "testharness.h" + +struct foo { + int x; + int y; +} foo; + +int main() { + + typedef struct foo *PFOO; + + PFOO pfoo = &foo; + + struct foo { + int a; + int b; + } anotherfoo; + + int z = pfoo->x + anotherfoo.a; // This means that PFOO refers to the outer type + + SUCCESS; +} diff --git a/cil/test/small1/scope7.c b/cil/test/small1/scope7.c new file mode 100644 index 0000000..82aa973 --- /dev/null +++ b/cil/test/small1/scope7.c @@ -0,0 +1,18 @@ +#include "testharness.h" + +struct packet { + int (*pfun)(int, char **); + int *p; +}; + + +int main(int argc, char **argv) { + struct packet loc = { main, 0 }; + + static struct packet glob = { main, 0 }; + + if(loc.pfun != glob.pfun) E(1); + + SUCCESS; + +} diff --git a/cil/test/small1/scope8.c b/cil/test/small1/scope8.c new file mode 100644 index 0000000..0b7a3eb --- /dev/null +++ b/cil/test/small1/scope8.c @@ -0,0 +1,24 @@ +#include "testharness.h" +extern void abort(); + +// from c-torture +static inline +p (int *p) +{ + return !((long) p & 1); +} + +int +f (int *q) +{ + if (p (q) && *q) + return 1; + return 0; +} + +main () +{ + if (f ((int*) 0xffffffff) != 0) + abort (); + exit (0); +} diff --git a/cil/test/small1/scope9.c b/cil/test/small1/scope9.c new file mode 100644 index 0000000..e9c307d --- /dev/null +++ b/cil/test/small1/scope9.c @@ -0,0 +1,18 @@ +// From c-torture +int v = 3; + +f () +{ + int v = 4; + { + extern int v; + if (v != 3) + abort (); + } +} + +main () +{ + f (); + exit (0); +} diff --git a/cil/test/small1/semicolon.c b/cil/test/small1/semicolon.c new file mode 100755 index 0000000..6ef6524 --- /dev/null +++ b/cil/test/small1/semicolon.c @@ -0,0 +1,11 @@ + +struct foo { + int g;;; + char *d; +} x; + + +int main() { + x.g = 1; + return 0; +} diff --git a/cil/test/small1/signs.c b/cil/test/small1/signs.c new file mode 100644 index 0000000..a2dad37 --- /dev/null +++ b/cil/test/small1/signs.c @@ -0,0 +1,92 @@ +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned long +#define S32 long +#define UPOINT U32 +#define SPOINT S32 + +typedef UPOINT ITEM; +typedef UPOINT ITEMADDR; +#define NULLITEM (ITEM)0 + + /* The number of bits in an ITEM */ +#define BITS_IN_ITEM (sizeof(ITEM) * 8) + +/* The least-significant 3 bits of an ITEM are reserved for a tag that + * encodes whether the ITEM is a variable, a constant, an integer, an + * application or an abstraction. */ + +#define TAG_BITS 3 +#define TAG MASK(TAG_BITS) + + /* Reserve tags with the two least significant + * bits for pointers */ +#define INDIRECT 0 +#define VAR 1 +#define INT 2 +#define CONST 3 +#define NOTAG 4 /* Used for indirections on 32-bit machine. + * Everything before this fits completely in an + * ITEM */ +#define ABS 5 /* See ISAPPLORABS */ +#define COMM 6 +#define APPL 7 /* See ISAPPLORABS */ + + +#define LFWORD_SIZE 16 +#define DISK_TAG_BITS 4 + +#define MIN(x,y) ((x)<(y)?(x):(y)) +#define MAX(x,y) ((x)>(y)?(x):(y)) +#define ABSVAL(x) (((S32)(x)) >= 0 ? ((S32)(x)) : (- ((S32)(x)))) + +#define INT_SIZE MIN(BITS_IN_ITEM - TAG_BITS, 2 * LFWORD_SIZE - DISK_TAG_BITS) + +/* Use GETINT(item) to get the integer represented by item */ +#define GETINT(it) ((int)(((SPOINT)(it)) >> TAG_BITS)) + +#define ZERO INT /* Only the tag */ +#define MAX_INT ((int)((1 << (INT_SIZE - 1)) - 1)) +#define MIN_INT ((int)(- 1 - MAX_INT)) + + /* Make an integer */ +#define EXTRACTSIGNED(n,start,bits) \ + (((n) << (8*sizeof(int) - (start) - (bits))) >> (8*sizeof(int) - (bits))) + +ITEM CONS_HEAD(int tag); +void CONS_NEXT(ITEM head, ITEM i); +#define LONGINT_CONST 12 + +extern void exit(int); +extern ITEM builtIn[]; + /* Build an integer */ +ITEM CONS_INT(int n) { + if((n < MIN_INT) || (n > MAX_INT)) { + return 0; + } else { + return (ITEM)(INT | (((SPOINT)n) << TAG_BITS)); + } +} + + +int test(int n, int m) { + if(n < (- 5 - (unsigned)m)) { // The comparison should be unsigned !! + if(m < (int)(- 5 - (unsigned)n)) { // The comparison should be signed !! + return n; + } else + return n + m; + } else { + return m; + } +} + + +int foo(int n, int m) { + if (n < (1 << sizeof(ITEM))) /* The ISO says that this should be signed + * comparison. MSVC uses unsigned !!! */ + return n; + else + return m; +} diff --git a/cil/test/small1/simon6.c b/cil/test/small1/simon6.c new file mode 100644 index 0000000..df1d130 --- /dev/null +++ b/cil/test/small1/simon6.c @@ -0,0 +1,27 @@ + +#define ASZ 10 + +extern void printf(char *fmt, ...); +#pragma ccuredvararg("printf", printf(1)) +extern void exit(int); + +int argc; + +void main() +{ + int n = argc; + int i; + int a[ASZ]; + int *p = argc%2 ? 0 : a; + + a[0] = 10; + printf("%d\n", p[0]); + //printf("%d %d\n", p[0], p[1]); + + + for(i=0; ic) ]; + device[0] = 0; +} + +int main() { + if(foo() != 56) E(1); // Foo invokes bar + f1 + + if(pbar() != 55) E(2); // We have two copies of pbar + + qux(); + + SUCCESS; +} diff --git a/cil/test/small1/strcpy.c b/cil/test/small1/strcpy.c new file mode 100644 index 0000000..2bb7165 --- /dev/null +++ b/cil/test/small1/strcpy.c @@ -0,0 +1,23 @@ + +char * mod_gzip_strcpy( char *s1, char *s2 ) +{ + int len = 0; + if ( ( s1 != 0 )&&( s2 != 0 ) ) + { + while( *s2 != 0 ) { *s1++ = *s2++; len++; } + *s1=0; + } + return mod_gzip_strcpy(mod_gzip_strcpy(s1,s1),s2); +} + +int puts(char *s); + +int main() { + char * x; + char * y; + + y = mod_gzip_strcpy(x, "/tmp/"); + puts(y); + + return 1; +} diff --git a/cil/test/small1/string1.c b/cil/test/small1/string1.c new file mode 100644 index 0000000..74bee34 --- /dev/null +++ b/cil/test/small1/string1.c @@ -0,0 +1,29 @@ +#include "testharness.h" + + +#ifndef __RWSTRING +#define __RWSTRING +#define __FSEQN +#endif + +// an empty string; can't just use a string literal, because writing +// into C literals is undefined (and produces segfault on gcc/linux) +char empty[1] = { 0 }; + +int main() { + char * __RWSTRING p = empty; // A pointer to an empty string + char * __FSEQN pp; + + // Overwrite the zero. When handling strings specially, + // CCured will fail here. + *p = '1'; + + // Now convert it to a FSEQ. Will call strlen which will fail + pp = (char * __FSEQN)p; + + pp ++; // This should go outside of the string + *pp = 0; // Bang + + SUCCESS; + +} diff --git a/cil/test/small1/string2.c b/cil/test/small1/string2.c new file mode 100755 index 0000000..4979ce8 --- /dev/null +++ b/cil/test/small1/string2.c @@ -0,0 +1,14 @@ +#include +#include + +int main () { + int i; + char a[]="CCu"; + char b[3]; + + strcpy (b,a); + + for (i=0; i<4; i++) + printf ("b[%d] = %c (%d)\n", i, b[i], b[i]); + +} diff --git a/cil/test/small1/stringsize.c b/cil/test/small1/stringsize.c new file mode 100755 index 0000000..d83da3c --- /dev/null +++ b/cil/test/small1/stringsize.c @@ -0,0 +1,31 @@ +//All three of these cases work in gcc, but fail in CIL. The first case was +//a problem for OpenSSH, which uses something like the declaration of tmp +//below to initialize a string buffer + + +#include "testharness.h" +extern int strcmp(const char*, const char*); + +#define A_STRING "a string literal for testing." +int main() +{ + char tmp[sizeof(A_STRING)] = A_STRING; + + if(strcmp(A_STRING, tmp)) E(1); // Check the initialization + + //This fails because cabs2CIL thinks sizeof(A_STRING) == 4, + //so the array is not completely initialized. + if( sizeof(tmp) != 30 ) E(2); + if( tmp[10] != (A_STRING)[10] ) E(3); + + //This fails on CCured only because markptr inserts a cast to char* + if( sizeof("Hello, world.") != 14 ) E(4); + + //This fails because the CIL conversion drops the char* cast. + if( sizeof((char*)"Hello, world.") != sizeof(void*) ) E(5); + + printf("%d\n", sizeof("ertewrtert")); + + SUCCESS; +} + diff --git a/cil/test/small1/strloop.c b/cil/test/small1/strloop.c new file mode 100644 index 0000000..8cbfb5d --- /dev/null +++ b/cil/test/small1/strloop.c @@ -0,0 +1,30 @@ +#include "testharness.h" +#include + +void BuildWord(char * pchWord) { + int i; + char * pch = pchWord; + + /* original code: + * while ((i = *pch++) != '\0') { } + */ + + do { + i = *pch; + // printf("i = '%c'\n",i); + pch++; + } while (i != '\0'); + + printf("%s\n",pchWord); +} + +int main() { + char *test = "foo"; + + test++; + test--; + + BuildWord(test); + + SUCCESS; +} diff --git a/cil/test/small1/strloop3.c b/cil/test/small1/strloop3.c new file mode 100644 index 0000000..72a8f1f --- /dev/null +++ b/cil/test/small1/strloop3.c @@ -0,0 +1,51 @@ +#include "testharness.h" +#include +#include + +//matth: a test to show the difficulty with allowing end+1 access for reads. +// Here, CCured sees that *p can be written to, so it doesn't allow the +1 +// access that would let us read the NUL. + +//Normally, CCured solves this problem by adding a second NUL to the string: +// One the code can access, and one it can't. But if the string comes +// from a system call, we can't assume it has two NULs (and CCured will protect +// the one and only NUL from writing). Here, the __mkptr_string simulates +// a string returned by a system call. + +//To fix this: either change the solver to prevent p from being safe, or +// fix __mkptr_string to allow access to the NUL (probably by making all +// strings returned by __mkptr_string into FSeqs or Seqs, rather than FSeqN +// or SeqN). + +void BuildWord(char * pchWord) { + int i = 0; + char * pch = pchWord; + + while (1) + { + char* p = pchWord + i; //p is inferred SAFE + i++; + if (*p == '\0') + break; + else + *p = 'a'; + } + + printf("%s\n",pchWord); +} + +int main() { + char buffer[10]; + char* pchWord; + strcpy(buffer, "foo"); + +#ifdef CCURED + pchWord = __mkptr_string(buffer); +#else + pchWord = buffer; +#endif + + BuildWord(pchWord); + + SUCCESS; +} diff --git a/cil/test/small1/struct1.c b/cil/test/small1/struct1.c new file mode 100644 index 0000000..230cd48 --- /dev/null +++ b/cil/test/small1/struct1.c @@ -0,0 +1,20 @@ +#include "testharness.h" + +typedef struct { unsigned long pte_low; } pte_t; + + +typedef struct { unsigned long pgprot; } pgprot_t; + + +int main() { + + pte_t one, *pte = &one; + + *pte = ((pte_t) { ( (( ( 0 ) >> 12 ) << 12 ) + | ((((pgprot_t) { ( 0x001 | 0x004 + | 0x020 ) } )).pgprot)) } ); + if(pte->pte_low != 0x25) E(1); + + SUCCESS; +} + diff --git a/cil/test/small1/struct2.c b/cil/test/small1/struct2.c new file mode 100644 index 0000000..4961da8 --- /dev/null +++ b/cil/test/small1/struct2.c @@ -0,0 +1,335 @@ +#include "testharness.h" + +typedef unsigned int __kernel_size_t; + +typedef __kernel_size_t size_t; + +typedef unsigned int __u32; +typedef __u32 kernel_cap_t; + +typedef int pid_t; + +typedef unsigned int __kernel_uid32_t; +typedef unsigned int __kernel_gid32_t; + +typedef __kernel_uid32_t uid_t; + +typedef __kernel_gid32_t gid_t; + +typedef struct { + unsigned long seg; +} mm_segment_t; + +struct list_head { + struct list_head *next, *prev; +}; + +typedef struct { int gcc_is_buggy; } spinlock_t; + +struct __wait_queue_head { + spinlock_t lock; + struct list_head task_list; + +}; +typedef struct __wait_queue_head wait_queue_head_t; + +struct timer_list { + struct list_head list; + unsigned long expires; + unsigned long data; + void (*function)(unsigned long); +}; + +typedef long clock_t; +struct tms { + clock_t tms_utime; + clock_t tms_stime; + clock_t tms_cutime; + clock_t tms_cstime; +}; + + +typedef struct { + unsigned long sig[(64 / 32 ) ]; +} sigset_t; + + +struct i387_fsave_struct { + long cwd; + long swd; + long twd; + long fip; + long fcs; + long foo; + long fos; + long st_space[20]; + long status; +}; + +struct i387_fxsave_struct { + unsigned short cwd; + unsigned short swd; + unsigned short twd; + unsigned short fop; + long fip; + long fcs; + long foo; + long fos; + long mxcsr; + long reserved; + long st_space[32]; + long xmm_space[32]; + long padding[56]; +} __attribute__ ((aligned (16))); + +struct i387_soft_struct { + long cwd; + long swd; + long twd; + long fip; + long fcs; + long foo; + long fos; + long st_space[20]; + unsigned char ftop, changed, lookahead, no_update, rm, alimit; + struct info *info; + unsigned long entry_eip; +}; + +union i387_union { + struct i387_fsave_struct fsave; + struct i387_fxsave_struct fxsave; + struct i387_soft_struct soft; +}; + +struct thread_struct { + unsigned long esp0; + unsigned long eip; + unsigned long esp; + unsigned long fs; + unsigned long gs; + + unsigned long debugreg[8]; + + unsigned long cr2, trap_no, error_code; + + union i387_union i387; + + struct vm86_struct * vm86_info; + unsigned long screen_bitmap; + unsigned long v86flags, v86mask, v86mode, saved_esp0; + + int ioperm; + unsigned long io_bitmap[32 +1]; +}; + +struct rlimit { + unsigned long rlim_cur; + unsigned long rlim_max; +}; + + + + +typedef union sigval { + int sival_int; + void *sival_ptr; +} sigval_t; + + + +typedef struct siginfo { + int si_signo; + int si_errno; + int si_code; + + union { + int _pad[((128 /sizeof(int)) - 3) ]; + + + struct { + pid_t _pid; + uid_t _uid; + } _kill; + + + struct { + unsigned int _timer1; + unsigned int _timer2; + } _timer; + + + struct { + pid_t _pid; + uid_t _uid; + sigval_t _sigval; + } _rt; + + + struct { + pid_t _pid; + uid_t _uid; + int _status; + clock_t _utime; + clock_t _stime; + } _sigchld; + + + struct { + void *_addr; + } _sigfault; + + + struct { + int _band; + int _fd; + } _sigpoll; + } _sifields; +} siginfo_t; + +struct sigpending { + struct sigqueue *head, **tail; + sigset_t signal; +}; + +struct sigqueue { + struct sigqueue *next; + siginfo_t info; +}; + + + +struct task_struct { + + + + volatile long state; + unsigned long flags; + int sigpending; + mm_segment_t addr_limit; + + + + int /*struct exec_domain*/ *exec_domain; + volatile long need_resched; + unsigned long ptrace; + + int lock_depth; + + long counter; + long nice; + unsigned long policy; + int /*struct mm_struct */ *mm; + int has_cpu, processor; + unsigned long cpus_allowed; + + struct list_head run_list; + unsigned long sleep_time; + + struct task_struct *next_task, *prev_task; + int /*struct mm_struct */ *active_mm; + + + int /* struct linux_binfmt */ *binfmt; + int exit_code, exit_signal; + int pdeath_signal; + + unsigned long personality; + int dumpable:1; + int did_exec:1; + pid_t pid; + pid_t pgrp; + pid_t tty_old_pgrp; + pid_t session; + pid_t tgid; + + int leader; + + struct task_struct *p_opptr, *p_pptr, *p_cptr, *p_ysptr, *p_osptr; + struct list_head thread_group; + + + struct task_struct *pidhash_next; + struct task_struct **pidhash_pprev; + + wait_queue_head_t wait_chldexit; + int /* struct semaphore */ *vfork_sem; + unsigned long rt_priority; + unsigned long it_real_value, it_prof_value, it_virt_value; + unsigned long it_real_incr, it_prof_incr, it_virt_incr; + struct timer_list real_timer; + struct tms times; + unsigned long start_time; + long per_cpu_utime[1 ], per_cpu_stime[1 ]; + + unsigned long min_flt, maj_flt, nswap, cmin_flt, cmaj_flt, cnswap; + int swappable:1; + + uid_t uid,euid,suid,fsuid; + gid_t gid,egid,sgid,fsgid; + int ngroups; + gid_t groups[32 ]; + kernel_cap_t cap_effective, cap_inheritable, cap_permitted; + int keep_capabilities:1; + int /*struct user_struct */ *user; + + struct rlimit rlim[11 ]; + unsigned short used_math; + char comm[16]; + + int link_count; + int /*struct tty_struct */ *tty; + unsigned int locks; + + int /*struct sem_undo */ *semundo; + int /*struct sem_queue */ *semsleeping; + + struct thread_struct thread; + + int /* struct fs_struct */ *fs; + + int /* struct files_struct */ *files; + + spinlock_t sigmask_lock; + int /* struct signal_struct */ *sig; + + sigset_t blocked; + struct sigpending pending; + + unsigned long sas_ss_sp; + size_t sas_ss_size; + int (*notifier)(void *priv); + void *notifier_data; + sigset_t *notifier_mask; + + + __u32 parent_exec_id; + __u32 self_exec_id; + + spinlock_t alloc_lock; +}; + + +static void __attribute__ ((__section__ (".text.init"))) check_fpu(void) +{ + if (((size_t) &(( struct task_struct *)0)-> thread.i387.fxsave ) & 15) { + extern void __buggy_fxsr_alignment(void); + __buggy_fxsr_alignment(); + } + +} + + +int main() { + int offset; + + + offset = &(( struct task_struct *)0)-> thread.i387.fxsave; + printf("Offset is: %d\n", offset); + if (((size_t) &(( struct task_struct *)0)-> thread.i387.fxsave ) & 15) { + check_fpu(); + E(1); + } + + SUCCESS; +} diff --git a/cil/test/small1/struct_init.c b/cil/test/small1/struct_init.c new file mode 100644 index 0000000..163b6a3 --- /dev/null +++ b/cil/test/small1/struct_init.c @@ -0,0 +1,30 @@ +#ifndef __FSEQN +#define __FSEQN +#endif + +typedef struct { + char * name; + int data; +} cmd; + +cmd our_cmds[] = { + { "command 1", 1 }, + { "command 2", 2 }, + { "command 3", 3 }, + { 0, 0} }; + +struct { + int x; + cmd * cmds; + int y; +} main_struct = { + 100, + our_cmds, + 200 +}; + +int main() { + char * __FSEQN p = "HELLO"; + return 0; +} + diff --git a/cil/test/small1/structassign.c b/cil/test/small1/structassign.c new file mode 100644 index 0000000..75a8300 --- /dev/null +++ b/cil/test/small1/structassign.c @@ -0,0 +1,17 @@ + +typedef struct { + int *a[20]; + int b; +} STR; + +STR glob; + + +int main(STR *s) { + STR loc = glob; + + *s = glob; + + return 0; +} + diff --git a/cil/test/small1/tags.c b/cil/test/small1/tags.c new file mode 100644 index 0000000..5a2c365 --- /dev/null +++ b/cil/test/small1/tags.c @@ -0,0 +1,37 @@ + + +// A few test cases for tags + +typedef struct { + int x; + char *p; + int a[20]; +} S1; + +typedef struct { + S1 s1test; + double f1, f2; +} S2; + + +int extint = 5; +S1 exts1 = { 7, 0 }; +S2 exts2; + +int *fooptr = 5; + +extern extarr[]; +extern struct { + int i1, i2; + int a[4]; // sm: this was a[], but that's an error right?? +} extstruct; + + +int foo(int k) { + int t = extint + extarr[5]; + S2 locs2; + + * ((int*)& locs2) = 0; // The & counts here + + +} diff --git a/cil/test/small1/task.c b/cil/test/small1/task.c new file mode 100644 index 0000000..3f49309 --- /dev/null +++ b/cil/test/small1/task.c @@ -0,0 +1,33 @@ +/* this obscure structure definition actually comes up in the linux kernel + * ... */ + +typedef struct { } spinlock_t; + +struct task_struct { + spinlock_t sigmask_lock; +}; + +struct task_struct my_task; + +extern int printf(const char*, ...); + +int main() { + // int *p = (int*) & my_task; + spinlock_t *sp = & my_task.sigmask_lock; + + printf("Sizeof(mytask) = %d\n", sizeof(my_task)); + printf("Sizeof(void) = %d\n", sizeof(void)); + printf("Sizeof(spinlock_t) = %d\n", sizeof(spinlock_t)); + printf("& (spinlock_t) = %x\n", (long)sp); + printf("(& spinlock) + 1 = %x\n", (long)(sp + 1)); + + if(sizeof(my_task) != 0) return 1; + if(sizeof(spinlock_t) != 0) return 2; + { + spinlock_t sp1; + spinlock_t *sp_2 = sp + 1; + if(sp_2 != sp) return 3; + *sp_2 = *sp; + } + return 0; +} diff --git a/cil/test/small1/tempname.c b/cil/test/small1/tempname.c new file mode 100755 index 0000000..b7556ba --- /dev/null +++ b/cil/test/small1/tempname.c @@ -0,0 +1,9 @@ +//Test that the variable __cil_tmp7 (which may have come from an earlier pass +//through cil) doesn't conflict with any new vars added by CIL. + +int** foo() { return (int**)0;} + +int main() { + char* __cil_tmp7 = 0; + return (int)foo() + (int)foo() + **foo(); +} diff --git a/cil/test/small1/testharness.h b/cil/test/small1/testharness.h new file mode 100644 index 0000000..0b3ee2f --- /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 /* printf */ +#endif + +extern void exit(int); + +/* Always call E with a non-zero number */ +#define E(n) { printf("Error %d\n", (int)n); exit(n); } +#define SUCCESS { printf("Success\n"); exit(0); } + diff --git a/cil/test/small1/typeof1.c b/cil/test/small1/typeof1.c new file mode 100755 index 0000000..90ee555 --- /dev/null +++ b/cil/test/small1/typeof1.c @@ -0,0 +1,86 @@ +/* This test case was reported by Robert. It seems that CIL ought to + * understand that typeof is an abbreviation */ +extern int printf(const char* fmt, ...); + +#ifdef __GNUC__ +void foo(); + + +__typeof(foo) afun; // A prototype +void afun() {} + +void bfun(void); // A prototype for b +extern __typeof(afun) bfun __attribute__ ((alias ("afun"))); // And another + +int arr[9]; + +__typeof(arr) barr = { 0, 1, 2, 3 } ; + + +__typeof("a long string") str; // Str should have type array, not pointer ! + +struct foo { int a; int b; }; +struct foo returnsAStruct(int a) + { return (struct foo){a,2}; } +__typeof(returnsAStruct(42)) a_struct; + +#endif + + +typedef int FUN(int); + +FUN fptr; // fptr is defined to be a function! This is a prototype. + +FUN fptr; // This is another prototype + +int fptr(int x); // Yet another prototype + +int fptr(int x) { // Now another definition for it + return x - 1; +} + +typedef int ARRAY[8]; + +ARRAY carr; + +int main(void) +{ +#ifdef __GNUC__ + afun(); + bfun(); + /* Let's force CIL to compute some __alignof. This is tricky because it + * almost always leaves them alone, except when they are used in + * initializer designators */ +#define CHECK_CONST(e) {\ + char a[] = { [e] = 34 };\ + printf(# e " = %d (CIL) and %d (Compiler)\n", sizeof(a) - 1, (e)); \ + if(e != sizeof(a) - 1) { exit(1); }\ + } + CHECK_CONST(sizeof(foo)); + CHECK_CONST(sizeof(afun)); + CHECK_CONST(sizeof("a long string")); + CHECK_CONST(sizeof(str)); + CHECK_CONST(sizeof(arr)); + CHECK_CONST(sizeof(barr)); + + CHECK_CONST(__alignof("a string")); + CHECK_CONST(__alignof(str)); + CHECK_CONST(__alignof(foo)); + CHECK_CONST(__alignof(afun)); + CHECK_CONST(__alignof(arr)); + + // Here CIL is different from GCC: CIL=4, GCC=32? + // I have no idea where GCC is getting its result from + // CHECK_CONST(__alignof(barr)); + +#endif + if(sizeof(carr) != sizeof(ARRAY)) { + exit(8); + } + if ( (sizeof(a_struct) != sizeof(struct foo)) + ||(__alignof(a_struct) != __alignof(struct foo))) { + exit(9); + } + + return fptr(1); +} diff --git a/cil/test/small1/typespec1.c b/cil/test/small1/typespec1.c new file mode 100644 index 0000000..e0ddf4f --- /dev/null +++ b/cil/test/small1/typespec1.c @@ -0,0 +1,55 @@ +#include "testharness.h" + +typedef unsigned char __u8; +typedef signed char __s8; + + +__u8 unsigned uchartest; // This is unsigned char +unsigned char ucharorig; + +__u8 signed signedtest; // This is unsigned char +unsigned char signedorig; + + +__s8 unsigned uinttest; // This is like unsigned char +unsigned char uintorig; + + +__s8 long longtest; // This is just like long + long longorig; + +__s8 unsigned long ulongtest; // This is just like unsigned long + unsigned long ulongorig; + +#define TEST(name, err) \ + name ## test = 255; \ + name ## orig = 255; \ + if(name ## test != name ## orig) E(err + 1); \ + \ + name ## test = 65000; \ + name ## orig = 65000; \ + if(name ## test != name ## orig) E(err + 2); \ + \ + name ## test = 130000; \ + name ## orig = 130000; \ + if(name ## test != name ## orig) E(err + 3); \ + /* Test signs */ \ + name ## test = -1; name ## test >>= (8 * sizeof(name ## test) - 1); \ + name ## orig = -1; name ## orig >>= (8 * sizeof(name ## orig) - 1); \ + if(name ## test != name ## orig) E(err + 4); \ + + +int main() { + TEST(uchar, 0); + + TEST(uint, 20); + + TEST(long, 30); + + TEST(ulong, 40); + + TEST(signed, 50); + + SUCCESS; + +} diff --git a/cil/test/small1/unimplemented.c b/cil/test/small1/unimplemented.c new file mode 100644 index 0000000..ab9a320 --- /dev/null +++ b/cil/test/small1/unimplemented.c @@ -0,0 +1,30 @@ +#include +struct dirent { + char d_name[256]; +}; + + +typedef struct isc_direntry { + char name[256 ]; +} isc_direntry_t; + +typedef struct isc_dir { + isc_direntry_t entry; +} isc_dir_t; + + +void +isc_dir_init(isc_dir_t *dir) { + + dir->entry.name[0] = '\0'; + +} + +unsigned int +isc_dir_read(isc_dir_t *dir) { + struct dirent *entry; + + strcpy(dir->entry.name, entry->d_name); + + return (0); +} diff --git a/cil/test/small1/union1.c b/cil/test/small1/union1.c new file mode 100644 index 0000000..385e291 --- /dev/null +++ b/cil/test/small1/union1.c @@ -0,0 +1,16 @@ + + +typedef struct { + int tag; + union { + char *foo; + struct { + int a1; + int *bar; + } ptr; + } u SAFEUNION ; +} U; + + + + diff --git a/cil/test/small1/union2.c b/cil/test/small1/union2.c new file mode 100644 index 0000000..084763e --- /dev/null +++ b/cil/test/small1/union2.c @@ -0,0 +1,40 @@ +#include "testharness.h" + +typedef unsigned long ULONG; +typedef long LONG; +#ifdef _GNUCC +typedef long long LONGLONG; +#else +typedef __int64 LONGLONG; +#endif + +typedef union _LARGE_INTEGER { + struct { + ULONG LowPart; + LONG HighPart; + }; + struct { + ULONG LowPart; + LONG HighPart; + } u; + LONGLONG QuadPart; +} LARGE_INTEGER; + + +int main() { + LARGE_INTEGER foo; + + foo.LowPart = 3; + foo.HighPart = 7; + + if (foo.u.LowPart != 3) { + E(1); + } + if (foo.u.HighPart != 7) { + E(2); + } + + + SUCCESS; +} + diff --git a/cil/test/small1/union3.c b/cil/test/small1/union3.c new file mode 100644 index 0000000..fa89569 --- /dev/null +++ b/cil/test/small1/union3.c @@ -0,0 +1,59 @@ +#include "testharness.h" + +#define offsetof(T, f) ((int)(& ((T*)0)->f)) +#define printoffsetof(T, f, expected, err) \ + printf("Offset of " #f " in " #T " is %d. Expected %d\n", \ + offsetof(T, f), expected); \ + if(err && offsetof(T, f) != expected) E(err) + +typedef union test { + struct { + int large[256]; + }; + int a; + int b; +} TEST_UNION; + +typedef struct tests { + struct intests { + int large[10]; + union intestsu { + int i1; // The offset of this is 0 in GCC !!! + int i2; // The offset of this is 0 in GCC + }; // This is propagated as fields of struct tests + int i3; + }; + int a; + union intestu { // This is a union. Its fields become fields of struct tests + int u1, u2; + struct { + int f1, f2; + }; + }; + int b; +} TEST_STRUCT; + +int main() { + TEST_STRUCT tests = { /* large[0] = */ 5 }; + + // Even though the field is unnamed it does participate in initialization + if(tests.large[0] != 5) E(1); + + printoffsetof(TEST_STRUCT, large, 0, 3); + // There appears to be a bug in GCC. It thinks that fields i1 and i2 start + // at offset 0 !!! + printoffsetof(TEST_STRUCT, i1, 40, 4); + printoffsetof(TEST_STRUCT, i2, 40, 5); + + printoffsetof(TEST_STRUCT, i3, 44, 6); + printoffsetof(TEST_STRUCT, a, 48, 7); + printoffsetof(TEST_STRUCT, u1, 52, 8); + printoffsetof(TEST_STRUCT, u2, 52, 9); + printoffsetof(TEST_STRUCT, f1, 52, 10); + printoffsetof(TEST_STRUCT, f2, 56, 11); + printoffsetof(TEST_STRUCT, b, 60, 12); + + + SUCCESS; +} + diff --git a/cil/test/small1/union5.c b/cil/test/small1/union5.c new file mode 100755 index 0000000..97cea8f --- /dev/null +++ b/cil/test/small1/union5.c @@ -0,0 +1,37 @@ +union Argument { + int field1; + char *field2; +} __attribute__ ((__transparent_union__)); + + +int callee(union Argument arg) { + return *arg.field2 + 1; +} + +union Argument mkArgument() { + union Argument a; + return a; +} + +void caller(void) +{ + char c; + union Argument a; + struct { + double d; + union Argument a; + } s; + + // It should be Ok to pass individual fields + callee(5); + callee(&c); + /* It should be Ok to pass a whole union also, but the calling convention + * will still be that of the first field */ + callee(a); + callee(s.a); + + /* Now the same thing as above but when the actual argument is not an + * lvalue */ + callee(mkArgument()); +} + diff --git a/cil/test/small1/unsafe1.c b/cil/test/small1/unsafe1.c new file mode 100644 index 0000000..ea8615d --- /dev/null +++ b/cil/test/small1/unsafe1.c @@ -0,0 +1,31 @@ + +#include "testharness.h" + + +typedef struct foo { + struct foo *next; + int *data; +} S; + +typedef struct not_compatible_with_foo { + int xxx; + double *yyy; +} NOT_S; + +S array[2]; + +S *fseq; + +int main() { + NOT_S * data; + //fseq = array; + //array[1].next = & array[0]; + //fseq ++; + + { __NOCUREBLOCK + data = (NOT_S *) fseq; // We don't want this cast to polute fseq + } + + SUCCESS; + +} diff --git a/cil/test/small1/va-arg-1.c b/cil/test/small1/va-arg-1.c new file mode 100644 index 0000000..7bc0603 --- /dev/null +++ b/cil/test/small1/va-arg-1.c @@ -0,0 +1,29 @@ +// This is from c-torture +#include +extern void exit(int); +extern void abort(void); + +#pragma ccuredvararg("f", sizeof(union { long l; })) + +typedef unsigned long L; +f (L p0, L p1, L p2, L p3, L p4, L p5, L p6, L p7, L p8, ...) +{ + va_list select; + + va_start (select, p8); + + if (va_arg (select, L) != 10) + abort (); + if (va_arg (select, L) != 11) + abort (); + if (va_arg (select, L) != 0) + abort (); + + va_end (select); +} + +main () +{ + f (1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 0L); + exit (0); +} diff --git a/cil/test/small1/va-arg-2.c b/cil/test/small1/va-arg-2.c new file mode 100644 index 0000000..8bc5bb8 --- /dev/null +++ b/cil/test/small1/va-arg-2.c @@ -0,0 +1,313 @@ +void exit(int); +void abort(void); + +// From c-torture + +/* The purpose of this test is to catch edge cases when arguments are passed + in regs and on the stack. We test 16 cases, trying to catch multiple + targets (some use 3 regs for argument passing, some use 12, etc.). + We test both the arguments and the `lastarg' (the argument to va_start). */ + +#include + +extern unsigned int strlen (const char*); + +int +to_hex (unsigned int a) +{ + static char hex[] = "0123456789abcdef"; + + if (a > 15) + abort (); + return hex[a]; +} + +#pragma ccuredvararg("f0", sizeof(int)) +void +f0 (char* format, ...) +{ + va_list ap; + + va_start (ap, format); + if (strlen (format) != 16 - 0) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f1", sizeof(int)) +void +f1 (int a1, char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 1) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f2", sizeof(int)) +void +f2 (int a1, int a2, char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 2) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f3", sizeof(int)) +void +f3 (int a1, int a2, int a3, char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 3) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f4", sizeof(int)) +void +f4 (int a1, int a2, int a3, int a4, char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 4) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f5", sizeof(int)) +void +f5 (int a1, int a2, int a3, int a4, int a5, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 5) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f6", sizeof(int)) +void +f6 (int a1, int a2, int a3, int a4, int a5, + int a6, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 6) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f7", sizeof(int)) +void +f7 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 7) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f8", sizeof(int)) +void +f8 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 8) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f9", sizeof(int)) +void +f9 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 9) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f10", sizeof(int)) +void +f10 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, int a10, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 10) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f11", sizeof(int)) +void +f11 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, int a10, + int a11, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 11) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f12", sizeof(int)) +void +f12 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, int a10, + int a11, int a12, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 12) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f13", sizeof(int)) +void +f13 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, int a10, + int a11, int a12, int a13, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 13) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f14", sizeof(int)) +void +f14 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, int a10, + int a11, int a12, int a13, int a14, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 14) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +#pragma ccuredvararg("f15", sizeof(int)) +void +f15 (int a1, int a2, int a3, int a4, int a5, + int a6, int a7, int a8, int a9, int a10, + int a11, int a12, int a13, int a14, int a15, + char* format, ...) +{ + va_list ap; + + va_start(ap, format); + if (strlen (format) != 16 - 15) + abort (); + while (*format) + if (*format++ != to_hex (va_arg (ap, int))) + abort (); + va_end(ap); +} + +main () +{ + char *f = "0123456789abcdef"; + + f0 (f+0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f1 (0, f+1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f2 (0, 1, f+2, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f3 (0, 1, 2, f+3, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f4 (0, 1, 2, 3, f+4, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f5 (0, 1, 2, 3, 4, f+5, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f6 (0, 1, 2, 3, 4, 5, f+6, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f7 (0, 1, 2, 3, 4, 5, 6, f+7, 7, 8, 9, 10, 11, 12, 13, 14, 15); + f8 (0, 1, 2, 3, 4, 5, 6, 7, f+8, 8, 9, 10, 11, 12, 13, 14, 15); + f9 (0, 1, 2, 3, 4, 5, 6, 7, 8, f+9, 9, 10, 11, 12, 13, 14, 15); + f10 (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, f+10, 10, 11, 12, 13, 14, 15); + f11 (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, f+11, 11, 12, 13, 14, 15); + f12 (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, f+12, 12, 13, 14, 15); + f13 (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, f+13, 13, 14, 15); + f14 (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, f+14, 14, 15); + f15 (0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, f+15, 15); + + exit (0); +} diff --git a/cil/test/small1/va-arg-7.c b/cil/test/small1/va-arg-7.c new file mode 100644 index 0000000..5e7956e --- /dev/null +++ b/cil/test/small1/va-arg-7.c @@ -0,0 +1,53 @@ +void exit(int); +void abort(void); + +// From c-torture +/* Origin: Franz Sirl */ +//modified for stdarg.h + +#pragma ccuredvararg("debug", sizeof(union { int i; double d;})) + +#if __GNUC__ >= 3 || !defined __GNUC__ + +#include +inline void +debug(int i1, int i2, int i3, int i4, int i5, int i6, int i7, + double f1, double f2, double f3, double f4, double f5, double f6, + double f7, double f8, double f9, + ...) +#else +//old version: +#include +inline void +debug(i1, i2, i3, i4, i5, i6, i7, f1, f2, f3, f4, f5, f6, f7, f8, f9, va_alist) + int i1, i2, i3, i4, i5, i6, i7; + double f1, f2, f3, f4, f5, f6, f7, f8, f9; + va_dcl + +#endif +{ + va_list ap; + +#if __GNUC__ >= 3 || !defined __GNUC__ + va_start (ap, f9); +#else + va_start (ap); //varargs.h +#endif + + if (va_arg (ap,int) != 8) + abort (); + if (va_arg (ap,int) != 9) + abort (); + if (va_arg (ap,int) != 10) + abort (); + + va_end (ap); +} + +int +main(void) +{ + debug (1, 2, 3, 4, 5, 6, 7, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, + 8.0, 9.0, 8, 9, 10); + exit (0); +} diff --git a/cil/test/small1/var.c b/cil/test/small1/var.c new file mode 100644 index 0000000..8b05db1 --- /dev/null +++ b/cil/test/small1/var.c @@ -0,0 +1,15 @@ +int v2; + +F1() +{ + int v1,v2; + F2(v1); + F2(v2); +} + +int v1; + +F2(int a) { + v1=0; + v2=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 +#include +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/vararg10.c b/cil/test/small1/vararg10.c new file mode 100755 index 0000000..50584a4 --- /dev/null +++ b/cil/test/small1/vararg10.c @@ -0,0 +1,50 @@ +#include +#include +#include "../small1/testharness.h" + +//Test for OO and varargs. These features are not supported, +// so this is not in the regression suite. + +#ifndef CCURED +#define __RTTI +#endif + +typedef struct parent { + int *f1; +} Parent; + +#pragma ccured_extends("Schild", "Sparent") + +typedef struct child { + int *f1; + int f2; +} Child; + +// Expects a Child*, then a Parent*, then a Child +void vararg(int x, ...); + +int main() { + int x = 5; + Child c = {&x, 2}; + void* __RTTI cp = &c; + vararg(4, cp, cp, c); + SUCCESS; +} + + +void vararg(int x, ...) { + va_list marker; + va_start(marker, x); + + Child * cp = va_arg(marker, Child*); + if (cp->f2 != 2) E(10); + + void * __RTTI vp = va_arg(marker, void* __RTTI); + Parent* p = vp; + if (*(p->f1) != 5) E(11); + + Child c = va_arg(marker, Child); + if (c.f2 != 2) E(12); + +} + diff --git a/cil/test/small1/vararg11.c b/cil/test/small1/vararg11.c new file mode 100755 index 0000000..ed57c56 --- /dev/null +++ b/cil/test/small1/vararg11.c @@ -0,0 +1,31 @@ + +/* A test to see if we can split the last argument in a vararg function */ +#include + +// Takes just ints +#pragma ccuredvararg("myvararg", sizeof(int)); + + +int myvararg(char *format, ...) { + // Make sure the format is a FSEQ + va_list ap; + int sum = 0; + + va_start(ap, format); + // Get as many ints as there are letters in the string + while(*format ++) { + sum += va_arg(ap, int); + } + va_end(ap); + + return sum; +} + + +int main() { + if(10 != myvararg("1234", 1, 2, 3, 4)) + return 1; + + return 0; + +} diff --git a/cil/test/small1/vararg2.c b/cil/test/small1/vararg2.c new file mode 100644 index 0000000..336c456 --- /dev/null +++ b/cil/test/small1/vararg2.c @@ -0,0 +1,49 @@ + +#include +#include + +struct vararg_sum { + int ints; /* We only pass ints to this one */ + int *pints; +}; +#pragma ccuredvararg("sum", sizeof(struct vararg_sum)) + +int sum( int descriptor, ... ); + +#include "testharness.h" + +int main( void ) +{ + int i1 = 5; + int i2 = 7; + + /* Call with 3 integers (-1 is used as terminator). */ + if(sum(0xA, 3, &i1, 7, &i2, 0) != 22) E(1); + + SUCCESS; +} + + + +/* Returns the average of a variable list of integers and pointers to + * integers. Each bit in the descriptor says what type is the corresponding + * argument (1 for pointer). 0 is used as a terminator. */ +int sum( int descriptor, ... ) +{ + int sum = 0; + va_list marker; + + va_start( marker, descriptor ); /* Initialize variable arguments. */ + while(1) { + int next; + if (descriptor & 1) { + next = * va_arg (marker, int*); + } else { + next = va_arg(marker, int); + } + if(!next) return sum; + sum += next; + descriptor >>=1; + } + va_end(marker); +} diff --git a/cil/test/small1/vararg3.c b/cil/test/small1/vararg3.c new file mode 100644 index 0000000..84264df --- /dev/null +++ b/cil/test/small1/vararg3.c @@ -0,0 +1,162 @@ +#include +#include +#include +#include +#include + +#include "testharness.h" + +char* progname = "vararg3"; +int showmessages = 1; + +#pragma ccuredvararg("my_vfprintf", printf(2)) +int my_vfprintf(FILE *stream, char const *format, va_list args ); + +#pragma ccuredvararg("pm_error", printf(1)) +void pm_error( char* format, ... ) { + va_list args; + + va_start( args, format ); + + fprintf( stderr, "%s: ", progname ); + (void) my_vfprintf( stderr, format, args ); + fputc( '\n', stderr ); + va_end( args ); +} + + +/* Portable mini-vfprintf, for systems that don't have either vfprintf or +** _doprnt. This depends only on fprintf. If you don't have fprintf, +** you might consider getting a new stdio library. +*/ + +int my_vfprintf(FILE *stream, char const *format, va_list vargs ) { + int n; + char* ep; + char fchar; + char tformat[512]; + int do_long; + int i; + long l; + unsigned u; + unsigned long ul; + char* s; + double d; + + n = 0; + while ( *format != '\0' ) + { + if ( *format != '%' ) + { /* Not special, just write out the char. */ + (void) putc( *format, stream ); + ++n; + ++format; + } + else + { + do_long = 0; + ep = format + 1; + + /* Skip over all the field width and precision junk. */ + if ( *ep == '-' ) + ++ep; + if ( *ep == '0' ) + ++ep; + while ( isdigit( *ep ) ) + ++ep; + if ( *ep == '.' ) + { + ++ep; + while ( isdigit( *ep ) ) + ++ep; + } + if ( *ep == '#' ) + ++ep; + if ( *ep == 'l' ) + { + do_long = 1; + ++ep; + } + + /* Here's the field type. Extract it, and copy this format + ** specifier to a temp string so we can add an end-of-string. + */ + fchar = *ep; + (void) strncpy( tformat, format, ep - format + 1 ); + tformat[ep - format + 1] = '\0'; + + /* Now do a one-argument fprintf with the format string we have + ** isolated. + */ + switch ( fchar ) + { + case 'd': + if ( do_long ) + { + l = va_arg( vargs, long ); + n += fprintf( stream, tformat, l ); + } + else + { + i = va_arg( vargs, int ); + n += fprintf( stream, tformat, i ); + } + break; + + case 'o': + case 'x': + case 'X': + case 'u': + if ( do_long ) + { + ul = va_arg( vargs, unsigned long ); + n += fprintf( stream, tformat, ul ); + } + else + { + u = va_arg( vargs, unsigned ); + n += fprintf( stream, tformat, u ); + } + break; + + case 'c': + i = (char) va_arg( vargs, int ); + n += fprintf( stream, tformat, i ); + break; + + case 's': + s = va_arg( vargs, char* ); + n += fprintf( stream, tformat, s ); + break; + + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + d = va_arg( vargs, double ); + n += fprintf( stream, tformat, d ); + break; + + case '%': + (void) putc( '%', stream ); + ++n; + break; + + default: + return -1; + } + + /* Resume formatting on the next character. */ + format = ep + 1; + } + } + return n; + } + + + +int main() { + pm_error("Cucu %s", "Bau"); + SUCCESS; +} diff --git a/cil/test/small1/vararg4.c b/cil/test/small1/vararg4.c new file mode 100644 index 0000000..b519ae9 --- /dev/null +++ b/cil/test/small1/vararg4.c @@ -0,0 +1,61 @@ + +#include +#include + +union vararg_sum { + int ints; /* We only pass ints to this one */ + int *pints; +}; + + +#pragma ccuredvararg("sum", sizeof(union vararg_sum)) +int sum( int descriptor, ... ); + +// Argument 0 is a valist. +#pragma ccuredvararg("sum_valist", sizeof(union vararg_sum)) +int sum_valist(va_list args, int descriptor); + +#include "testharness.h" + +int main( void ) +{ + int i1 = 5; + int i2 = 7; + + /* Call with 3 integers (-1 is used as terminator). */ + if(sum(0xA, 3, &i1, 7, &i2, 0) != 22) E(1); + + SUCCESS; +} + + + +/* Returns the average of a variable list of integers and pointers to + * integers. Each bit in the descriptor says what type is the corresponding + * argument (1 for pointer). 0 is used as a terminator. */ +int sum( int descriptor, ... ) +{ + int sum; + va_list marker; + + va_start( marker, descriptor ); /* Initialize variable arguments. */ + sum = sum_valist(marker, descriptor); + va_end(marker); + return sum; +} + +int sum_valist(va_list args, int descriptor) { + int sum = 0; + while(1) { + int next; + if (descriptor & 1) { + next = * va_arg (args, int*); + } else { + next = va_arg(args, int); + } + if(!next) return sum; + sum += next; + descriptor >>=1; + } + return sum; +} diff --git a/cil/test/small1/vararg5.c b/cil/test/small1/vararg5.c new file mode 100644 index 0000000..13c57bb --- /dev/null +++ b/cil/test/small1/vararg5.c @@ -0,0 +1,48 @@ +#include "testharness.h" + + +/* +This file is a test for variable argument functions, where the call to +print is made in a separate function, talking. This checks to see if we +can retrieve the arguments in a variable argument function if we call a +separate function. +*/ + +#include +#include +#include +#include +#include + +#pragma ccuredvararg("talking", printf(2)) +void talking(FILE *out, char *s, ...); + +int main(int argc, char** argv) { + int x, y; + char* s; + char buff[128]; + float f = 5.0; + double d = 10.0; + + FILE *out = fopen("vararg.out", "w+"); + if(! out) E(1); + + x = 5; + y = 1; + s = "hello"; + talking(out, "%d %3.1f %3.1f\n", x, f, d); + fseek(out, 0, SEEK_SET); + fread(buff, 1, sizeof(buff)-1, out); + fclose(out); + buff[10] = '\0'; + printf("Should be 5 5.0 10.0: %s\n", buff); + if(strncmp(buff, "5 5.0 10.0", 10)) E(2); + SUCCESS; +} + +void talking(FILE *out, char* s, ...) { + va_list ap; + va_start(ap, s); + vfprintf(out, s, ap); + va_end(ap); +} diff --git a/cil/test/small1/vararg5.h b/cil/test/small1/vararg5.h new file mode 100644 index 0000000..e69de29 diff --git a/cil/test/small1/vararg6.c b/cil/test/small1/vararg6.c new file mode 100644 index 0000000..1dc1346 --- /dev/null +++ b/cil/test/small1/vararg6.c @@ -0,0 +1,49 @@ +// Original from c-torture +//modified for stdarg.h + +#include "testharness.h" + +typedef double TYPE; + +#pragma ccuredvararg("vafunction", sizeof(union { TYPE d; })) + +#if __GNUC__ >= 3 || !defined __GNUC__ +//new version: +#include +void vafunction (TYPE dummy1, TYPE dummy2, ...) +#else +//old version: +#include +void vafunction (dummy1, dummy2, va_alist) + TYPE dummy1, dummy2; + va_dcl +#endif +{ + va_list ap; + +#if __GNUC__ >= 3 || !defined __GNUC__ + va_start (ap, dummy2); +#else + va_start (ap); //varargs.h +#endif + if (dummy1 != 888.) exit(1); + if (dummy2 != 999.) exit(2); + if (va_arg (ap, TYPE) != 1.) exit(3); + if (va_arg (ap, TYPE) != 2.) exit(4); + if (va_arg (ap, TYPE) != 3.) exit(5); + if (va_arg (ap, TYPE) != 4.) exit(6); + if (va_arg (ap, TYPE) != 5.) exit(7); + if (va_arg (ap, TYPE) != 6.) exit(8); + if (va_arg (ap, TYPE) != 7.) exit(9); + if (va_arg (ap, TYPE) != 8.) exit(10); + if (va_arg (ap, TYPE) != 9.) exit(11); + va_end(ap); +} + + +int main (void) +{ + vafunction( 888., 999., 1., 2., 3., 4., 5., 6., 7., 8., 9. ); + + SUCCESS; +} diff --git a/cil/test/small1/vararg7.c b/cil/test/small1/vararg7.c new file mode 100644 index 0000000..620c92f --- /dev/null +++ b/cil/test/small1/vararg7.c @@ -0,0 +1,68 @@ +#include +#include + +// abstracted from bind + +#define ISC_FORMAT_PRINTF(fmt, args) __attribute__((__format__(__printf__, fmt, args))) + +struct mystruct { + int i; + char *s; +}; + +#define CCURED_PRINTF(fmt) __attribute__((__ccuredvararg__(sizeof(struct mystruct)))) +typedef struct dns_rdatacallbacks { + /* + * dns_load_master calls this when it has rdatasets to commit. + */ + long add; + /* + * dns_load_master / dns_rdata_fromtext call this to issue a error. + */ + void (CCURED_PRINTF(3) *error)(struct dns_rdatacallbacks *, + const char * , ...) + ISC_FORMAT_PRINTF(2,3) ; + /* + * dns_load_master / dns_rdata_fromtext call this to issue a warning. + */ + void (CCURED_PRINTF(3) *warn)(struct dns_rdatacallbacks *, + const char * , ...) + ISC_FORMAT_PRINTF(2,3) ; + + /* + * Private data handles for use by the above callback functions. + */ + void *add_private; + void *error_private; + void *warn_private; +} dns_rdatacallbacks_t; + +static void +stdio_error_warn_callback(dns_rdatacallbacks_t *, const char *, ...) + ISC_FORMAT_PRINTF(2, 3); + +static void +stdio_error_warn_callback(dns_rdatacallbacks_t *callbacks, + const char *fmt, ...) +{ + va_list ap; + +// UNUSED(callbacks); + + va_start(ap, fmt); + vfprintf(stderr, fmt, ap); + va_end(ap); + fprintf(stderr, "\n"); +} + +void +dns_rdatacallbacks_init(dns_rdatacallbacks_t *callbacks) { + callbacks->error = stdio_error_warn_callback; + callbacks->warn = stdio_error_warn_callback; +} + +int foo(dns_rdatacallbacks_t *ptr) { + stdio_error_warn_callback(ptr,"Does it work %s","if we call it directly?"); + ptr->warn(ptr,"Warning Int %d\n",55); + ptr->warn(ptr,"Warning String %s\n","mystring"); +} diff --git a/cil/test/small1/varargauto1.c b/cil/test/small1/varargauto1.c new file mode 100644 index 0000000..d30cb6e --- /dev/null +++ b/cil/test/small1/varargauto1.c @@ -0,0 +1,63 @@ +#include "testharness.h" +#include +#include + +// A test case with automatic vararg descriptors +struct foo { + int f; +}; +// This will be passed char*, int*, int and struct foo* +#define AN_INT 0 +#define AN_STR 1 +#define AN_INTPTR 2 +#define AN_FOOPTR 3 + +void myva1(int many, ...); + +int main() { + struct foo x = { 1 } , y = { 2 }; + struct foo *px = &x, *py = &y; + + myva1(4, AN_INT, 5, + AN_STR, "hello", + AN_STR, "world", + AN_INTPTR, &px->f); + SUCCESS; +} + + +void myva1(int many, ...) { + int count; + va_list marker; + + va_start(marker, many); + for(count=0;countf); + break; + } + } + } +} diff --git a/cil/test/small1/varied.c b/cil/test/small1/varied.c new file mode 100644 index 0000000..36435ae --- /dev/null +++ b/cil/test/small1/varied.c @@ -0,0 +1,78 @@ +/* An example with various kinds of pointers */ +extern void* copy(void *); + + +typedef struct list { + struct list *next; // We'll use this safely + char *data; +} LIST; + +#pragma ccuredpoly("copy") +void *copy(void *x) { + return x; +} + +int ga[8]; + +int **w; + +int main() { + int x; + int * px = &x; + int * * qx = & px; // SEQ to FSEQ to int + + int * * c = copy(qx); + + if(x) { + px = & ga[5]; + } else { + px ++; + } + c += *px; + + { + char * pw = &w; + char * * cpw = copy(& pw); + + x = * * cpw; + } + + { + int * intcast = (int *)6; + *px = *intcast; + } + + { + int ** pp1, *p2; + void *v1 = pp1; + void *v2 = p2; + v1 = v2; + } + + { + void *vi1 = 5; + void *vi2 = vi1; + } + + { + void *vi3 = 5; + void *vi4 = vi3; + int *p3 = vi4; + int **pp4 = vi4; + } + + + { + int *p; + int **q; + void **b5; + void **b6 = b5; + p = *b5; + *b6 = q; + } +} + + + + + diff --git a/cil/test/small1/version.c b/cil/test/small1/version.c new file mode 100644 index 0000000..e2b711a --- /dev/null +++ b/cil/test/small1/version.c @@ -0,0 +1,24 @@ +/* version.c: version definition for the ed editor. */ +/* ed line editor. + Copyright (C) 1993, 1994 Andrew Moore, Talke Studio + All Rights Reserved + + This program 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, 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., 675 Mass Ave, Cambridge, MA 02139, USA. + +*/ + +static char *rcsid = "@(#)$Id: version.c 192 2001-02-17 22:56:13Z necula $"; + +char version_string[] = "GNU ed version 0.2"; diff --git a/cil/test/small1/void.c b/cil/test/small1/void.c new file mode 100644 index 0000000..ff64944 --- /dev/null +++ b/cil/test/small1/void.c @@ -0,0 +1,27 @@ +#include +#include + +void f(int x, int y) { + printf("wow\n"); +} + +void g(int x, int y) { + printf("yippie!\n"); +} + +#define FUNC(x, y) ({ f((x), (y)); g((x), (y)); }) + +#define NUMBER 1 + +int k(int a) { + + int x, y, z; + z = 0; + FUNC(NUMBER, z); + return 1; +} + +int main(int argc, char** argv) { + k(5); + return 0; +} diff --git a/cil/test/small1/voidarg.c b/cil/test/small1/voidarg.c new file mode 100644 index 0000000..d43fa1b --- /dev/null +++ b/cil/test/small1/voidarg.c @@ -0,0 +1,12 @@ +#include + +int main(int argc, char** argv) { + + int (* badfunc) (); + + badfunc = puts; + + (*badfunc)("hello, nice to meet you."); + + return 0; +} diff --git a/cil/test/small1/voidstar.c b/cil/test/small1/voidstar.c new file mode 100644 index 0000000..e2c3333 --- /dev/null +++ b/cil/test/small1/voidstar.c @@ -0,0 +1,30 @@ +extern void* malloc(unsigned int); + +typedef struct list { + void* data; + struct list * next; +} LIST; + + +extern void* listfind(LIST *l, int nth); +extern void* listinsert(LIST **, int nth, void *elem); + +int listadd(LIST * * pl, void* elem) { + LIST *n = (LIST*)malloc(sizeof(LIST)); + n->data = elem; + n->next = *pl; + return pl; +} + +LIST * glob = 0; + +int add5(LIST *cell) { + cell->data = (void*)cell; + listadd(& glob, (void*)add5); + +} + + +int get1(void) { + LIST *l = (LIST*)listfind(glob, 5); +} diff --git a/cil/test/small1/voidtypedef.c b/cil/test/small1/voidtypedef.c new file mode 100755 index 0000000..9a7e153 --- /dev/null +++ b/cil/test/small1/voidtypedef.c @@ -0,0 +1,14 @@ +//test for using a typedef as void. +typedef void tVoid; + +void pimInit(void); + +tVoid pimInit(tVoid) +{ + return; +} + +int main() { + pimInit(); + return 0; +} diff --git a/cil/test/small1/vsp.c b/cil/test/small1/vsp.c new file mode 100644 index 0000000..5040eb2 --- /dev/null +++ b/cil/test/small1/vsp.c @@ -0,0 +1,38 @@ +#include +#include +#include "testharness.h" + +static void +ns_client_logv(void *client, void *category, + void *module, int level, const char *fmt, va_list ap) +{ + char msgbuf[2048]; + char peerbuf[2048]; + + vsnprintf(msgbuf, sizeof(msgbuf), fmt, ap); + puts(msgbuf); +} + +// You must add this pragma to prevent CCured from infering a bad +// descriptor +#pragma ccuredvararg("ns_client_log", printf(5)) +void +ns_client_log(void *client, void *category, void *module, int level, + const char *fmt, ...) +{ + va_list ap; + + va_start(ap,fmt); + ns_client_logv(client,category,module,level,fmt,ap); + va_end(ap); +} + +int main() +{ + int i; + + ns_client_log(NULL, NULL, NULL, 0, + "Hello, %s! 2+2=%d\n", "world", 4); + + return 0; +} diff --git a/cil/test/small1/warnings-cast.c b/cil/test/small1/warnings-cast.c new file mode 100755 index 0000000..3096092 --- /dev/null +++ b/cil/test/small1/warnings-cast.c @@ -0,0 +1,13 @@ +const int a = 3; + +const int *f() { + return &a; +} + +int main() { + // Make sure we keep the cast from "const int*" to "int*" + // If it's dropped, gcc emits a warning. + int *p = (int*) f(); + *p = 4; + return *p; +} diff --git a/cil/test/small1/warnings-noreturn.c b/cil/test/small1/warnings-noreturn.c new file mode 100644 index 0000000..8c0656b --- /dev/null +++ b/cil/test/small1/warnings-noreturn.c @@ -0,0 +1,22 @@ +#include "testharness.h" + + +void croak() __attribute__((noreturn)); +void die() __attribute__((noreturn)); + + +void terminate(int) __attribute__((noreturn)); + +void terminate(int frog) +{ + if (frog) + croak(); + else + die(); +} + + +int main() +{ + SUCCESS; +} diff --git a/cil/test/small1/warnings-unused-label.c b/cil/test/small1/warnings-unused-label.c new file mode 100644 index 0000000..c8b0e81 --- /dev/null +++ b/cil/test/small1/warnings-unused-label.c @@ -0,0 +1,27 @@ +#include "testharness.h" + + +/* What's going wrong here? CIL's printing routines try to eliminate + some trivial gotos. In this test program, the "goto successor" + statement is useless and therefore doesn't get printed out. + However, the "successor:" label is left behind. This yields a + warning about a label being defined but not used. */ + + +int branch(int selector) +{ + if (selector) + return 1; + else + goto successor; + + successor: + return 0; +} + + +int main() +{ + branch(0); + SUCCESS; +} diff --git a/cil/test/small1/wchar-bad.c b/cil/test/small1/wchar-bad.c new file mode 100644 index 0000000..1f5e4c0 --- /dev/null +++ b/cil/test/small1/wchar-bad.c @@ -0,0 +1,40 @@ +#include +#include "testharness.h" + +// NUMERRORS 4 + + + +int main(){ + unsigned char c1[] = "\7"; + unsigned char c2[] = "\77"; + + //character too big: + unsigned char c3[] = "\777"; //ERROR(1): too big + + //OK, because only the first three digits are part of the escape. + unsigned char c4[] = "\1111"; + + //OK, because it's a wide string. + wchar_t c5[] = L"\777"; + +#if defined _MSVC || defined __CYGWIN__ + // Assumes sizeof(wchar_t) == 16 + wchar_t w1[] = L"\x1"; + wchar_t w2[] = L"\x1234"; + wchar_t w3[] = L"\x12345"; //ERROR(2): too big + wchar_t w4[] = L"\xcdefg"; //OK, because g is not a hex digit. +#else + // Assumes sizeof(wchar_t) == 32 + wchar_t w1[] = L"\x1"; + wchar_t w2[] = L"\x12345678"; + wchar_t w3[] = L"\x123456789"; //ERROR(2): too big + wchar_t w4[] = L"\x89abcdefg"; //OK, because g is not a hex digit. +#endif + + //type mismatches in array initialization: + char s1[] = L"Hi"; //ERROR(3): a wide string literal + wchar_t s2[] = "Hi"; //ERROR(4): a string literal + + SUCCESS; +} 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 + +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/cil/test/small1/wchar1_freebsd.c b/cil/test/small1/wchar1_freebsd.c new file mode 100644 index 0000000..3808e30 --- /dev/null +++ b/cil/test/small1/wchar1_freebsd.c @@ -0,0 +1,250 @@ +//# 1 "wchar1.c" +//# 1 "testharness.h" 1 +extern int printf(const char *, ...); +extern void exit(int); + + + + + +//# 1 "wchar1.c" 2 + +//# 1 "/usr/include/stddef.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +//# 1 "/usr/include/machine/ansi.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef int __attribute__((__mode__(__DI__))) __int64_t; +typedef unsigned int __attribute__((__mode__(__DI__))) __uint64_t; + + + + + + + + + + +typedef __signed char __int8_t; +typedef unsigned char __uint8_t; +typedef short __int16_t; +typedef unsigned short __uint16_t; +typedef int __int32_t; +typedef unsigned int __uint32_t; + +typedef int __intptr_t; +typedef unsigned int __uintptr_t; + + + + + +typedef union { + char __mbstate8[128]; + __int64_t _mbstateL; +} __mbstate_t; + + +# 41 "/usr/include/stddef.h" 2 3 + + +typedef int ptrdiff_t; + + + +typedef int rune_t; + + + + + +typedef unsigned int size_t; + + + + +typedef int wchar_t; + + + + + + + + + + +# 2 "wchar1.c" 2 + + +int main() { + wchar_t *wbase = L"Hello" L", world"; + char * w = (char *)wbase; + char * s = "Hello" ", world"; + int i; + + for (i=0; i < 10; i++) { + if (w[i * sizeof(wchar_t)] != s[i]) { + { printf("Error %d\n", 1 ); exit( 1 ); } ; + } + if (w[i * sizeof(wchar_t)+ 1] != 0) { + { printf("Error %d\n", 2 ); exit( 2 ); } ; + } + } + { printf("Success\n"); exit(0); } ; +} diff --git a/cil/test/small1/wchar2.c b/cil/test/small1/wchar2.c new file mode 100644 index 0000000..f0cc75d --- /dev/null +++ b/cil/test/small1/wchar2.c @@ -0,0 +1,11 @@ +#include "testharness.h" + +int main() { + long w = L'W'; // wide character constant + char * s = "W"; + int i; + + if (w != s[0]) { E(1); } + SUCCESS; + +} diff --git a/cil/test/small1/wchar3.c b/cil/test/small1/wchar3.c new file mode 100644 index 0000000..cf3f87d --- /dev/null +++ b/cil/test/small1/wchar3.c @@ -0,0 +1,31 @@ +#include "testharness.h" + +int check(char *p1, char *p2, int size, int code) { + int i; + for (i=0; i +#include +#include "testharness.h" + +/* +void printchars(wchar_t* str) +{ + while (1){ + printf("0x%x", *str); + if (*str == 0) { + printf("\n\n"); + return; + } + printf(", "); + str++; + } +} +*/ + +int main(){ + wchar_t wa[] = L"H" L"i\xabcd" "e"; + // wa == L"Hi\xabcd\x65". Since 'e' was in a separate token from \xabcd, + //it is not part of the escape. Instead, it's a regular old 'e' (ascii 65h). + + //wa should equal one of these byte strings: + char *a_16bit = "H\0i\0\xcd\xab\x65\0"; + char *a_32bit = "H\0\0\0i\0\0\0\xcd\xab\0\0\x65\0\0\0"; + + wchar_t wb[] = L"Hi\300"; + unsigned char b[] = "Hi\300"; + + int i; + if (sizeof(wchar_t) == 2) // 16 bits + { + char* tmp = (char*)wa; + for (i = 0; i < 4*2; i++) { //byte-for-byte compare + if (tmp[i] != a_16bit[i]) E(1); + } + } + else if (sizeof(wchar_t) == 4) // 32 bites + { + char* tmp = (char*)wa; + for (i = 0; i < 4*4; i++) { //byte-for-byte compare + if (tmp[i] != a_32bit[i]) E(2); + } + } + else + { + E(3); //how big is wchar_t?? + } + + for (i = 0; i < 4; i++) { //char-to-wchar_t compare + if (b[i] != (unsigned char)wb[i]) E(4); + } + + //printchars(wa); + //printchars(wb); + + { + //Test character constants. + wchar_t c = L'\xabcd'; + unsigned short s = 0xABCD; + if (s != c) E(10); + int c2 = L'ac'; //wide constants are 16 bits wide, so truncate this to 'c'. + if (c2 != L'c') E(11); + } + + SUCCESS; +} diff --git a/cil/test/small1/wchar5.c b/cil/test/small1/wchar5.c new file mode 100644 index 0000000..8b61276 --- /dev/null +++ b/cil/test/small1/wchar5.c @@ -0,0 +1,22 @@ +#include +#include "testharness.h" + +//matth: some lexer bugs that I haven't had time to fix + + +int main(){ + //BUG: the "i\xabcd" has no L in front, so we treat it like a normal string, + // and can't handle the big value. + + wchar_t a[] = L"H" "i\xabcd"; + // should be the same as: + wchar_t b[] = L"Hi\xabcd"; + + + int i; + for (i = 0; i < 4; i++){ + if (a[i] != b[i]) E(i); + } + + SUCCESS; +} diff --git a/cil/test/small1/wchar6.c b/cil/test/small1/wchar6.c new file mode 100644 index 0000000..2d90f81 --- /dev/null +++ b/cil/test/small1/wchar6.c @@ -0,0 +1,35 @@ +#include +#include "testharness.h" + +int main() +{ + wchar_t aa[] = L"A\xabcd"; // 2 wide chars + wchar_t ba[] = L"A\\xabcd"; // 7 wide chars + wchar_t *ap = L"A\xabcd"; + wchar_t *bp = L"A\\xabcd"; + char *p1, *p2; + int i; + + if (wcslen(aa) != wcslen(ap)) { E(1); } + if (wcslen(ba) != wcslen(bp)) { E(2); } + if (wcslen(aa) == wcslen(ba)) { E(3); } + if (wcslen(ap) == wcslen(bp)) { E(4); } + + p1 = aa; + p2 = ap; + for (i=0; i<2 * sizeof(wchar_t); i++) { + if (p1[i] != p2[i]) { E(5); } + } + p1 = ba; + p2 = bp; + for (i=0; i<7 * sizeof(wchar_t); i++) { + if (p1[i] != p2[i]) { E(6); } + } + + if (wcscmp(aa,ap) != 0) { E(7); } + if (wcscmp(ba,bp) != 0) { E(8); } + if (wcscmp(aa,ba) == 0) { E(9); } + if (wcscmp(ap,bp) == 0) { E(10); } + + SUCCESS; +} diff --git a/cil/test/small1/wchar7.c b/cil/test/small1/wchar7.c new file mode 100644 index 0000000..737ac3f --- /dev/null +++ b/cil/test/small1/wchar7.c @@ -0,0 +1,20 @@ +#include +#include "testharness.h" + +int main() +{ + wchar_t aa[] = L"\""; // 1 wide char + wchar_t *ap = L"\""; + char *p1, *p2; + int i; + + if (wcslen(aa) != wcslen(ap)) { E(1); } + p1 = aa; + p2 = ap; + for (i=0; i<2 * sizeof(wchar_t); i++) { + if (p1[i] != p2[i]) { E(2); } + } + if (wcscmp(aa,ap) != 0) { E(3); } + + SUCCESS; +} diff --git a/cil/test/small1/wrongnumargs.c b/cil/test/small1/wrongnumargs.c new file mode 100644 index 0000000..eb4e98a --- /dev/null +++ b/cil/test/small1/wrongnumargs.c @@ -0,0 +1,13 @@ +#include + +void f(s1, s2) char *s1, *s2; +{ + printf(s1, s2); +} + +int main(int argc, char** argv) { + f("hello %S!\n", "wow"); + f("hello there: %s!\n", "wow"); + f("hello again!\n"); +} + diff --git a/cil/test/small1/zerotags.c b/cil/test/small1/zerotags.c new file mode 100644 index 0000000..23723e9 --- /dev/null +++ b/cil/test/small1/zerotags.c @@ -0,0 +1,25 @@ +typedef struct { + int *foo; + int bar; +} wildstruct; + +int makewild(void *x) { + return *((int *)x); +} + +int main() { + wildstruct w; + int p = 55, q; + int *ptr; + + makewild(&w); + + w.foo = &p; + w.foo = 0; + + ptr = w.foo; + + q = *ptr; + + return q; +} diff --git a/cil/test/small2/.cvsignore b/cil/test/small2/.cvsignore new file mode 100644 index 0000000..89b6caa --- /dev/null +++ b/cil/test/small2/.cvsignore @@ -0,0 +1,182 @@ +hola +*cil.c +*infer.c +*box.c +*cabs.c +*.pdb +*.i +*_ppp.c +*.origi +*_all.c +*.pdb +*.ilk +*cured.c +*.cured.s +*_comb.c +*.browser +*-tmp.* +comb +ocamlprof* +voidfree +recursetype +rmunused +regbeforeassign +partialbracket +enuminit +staticafternostorage +voidfree +simplewild +multiplestatics +*.log +ptrtolocal +tprintf +ptrinint +ptrmanip +twoprintfs +regthenprintf +nested +debug_table +s59 +tmp.c +tmp +putc +bogus_redef +cof +lexnum +funcptr +ptrkinds +transpunion +sockaddr +oldstyle +typeof +asmfndecl +funcname +qsort +memset_sizeof +jpeg_compress_struct +funcptr2 +argv +ctype +heapify +xlsubr +baddef +baddef.rept +litstruct +cmpzero +a.out +ioctl +stralloc +segfault +strpbrk +fgets +memcpy +open +constdecl +mknod +realloc +strchr +getopt +scary +scary*.s +*.s +ope.m +*cured.c +*.optim.c +*.stackdump +fmtstr +bisonerror +errorinfn +globalprob +invalredef +invalredef2 +kernel? +main +memberofptr +xcheckers +unionassign +models +test-bad-tmp* +alloca2 +poly +getpwnam +reply +stackptrptr +popen +execv +sockets +printfllong +stat +replydirname +boundaries +constfold +hufftable +scanf +rusage +bzero +memset_int +rmunused2 +gimpdouble +struct_cs +retptr +arraytags +strloop2 +mode_sizes +*-tmp.c +*tmp +*.tmp.exe +test-bad.err +brlock +test-bad.out +qsort_wild +regparm0 +unscomp +*optimcured* +mergestruct +trace +globstackptr +complex_float +mergeinline +ehstack +setjmp +suppress_optim +name-capture-bitand +dblarg.int +wildfun2 +gdb.log +decl_inl +tagfile +.gdbinit +monthname +floatarg +structs_edg_stl_ccuredlib_test +ptrarith +chararr1 +thing +chararr2 +strerror1 +merged-once.c +merged-twice.c +funptr1 +union5 +arrayexpand +byteprintf +null_pointer_field +bufferlinegetter +checkinit +voidstarint +signal +*.out +seq_align_malloc +bsearch +readv +getaddrinfo +sockunion +fseq1 +closefunc +addr +polystruct-tmp +glob +sin_zero +bloop +funcptr3 +merge-ar diff --git a/cil/test/small2/Makefile b/cil/test/small2/Makefile new file mode 100644 index 0000000..60db88b --- /dev/null +++ b/cil/test/small2/Makefile @@ -0,0 +1,24 @@ +# Makefile in small2 + +hola: hola.c + gcc -g -Wall -o hola hola.c + ./hola + +holabox: holabox.c + gcc -g -Wall -o holabox -D_GNUCC -Dx86_LINUX -DBEFOREBOX \ + -I /home/scott/wrk/safec/cil/lib \ + ./holabox.c \ + /home/scott/wrk/safec/cil/lib/../obj/safecdebuglib.a + +# sm: clean-cvsignore is a script of mine, I make it ok to fail below +clean: + rm -f *.o *_all.c *cil.c *box.c *_ppp.c *.i *.origi *infer.c *cabs.c + rm -f comb enuminit multiplestatics staticafternostorage + rm -f hola partialbracket ptrtolocal rmunused recursetype + rm -f regbeforeassign simplewild tprintf voidfree + rm -f *.exe *.obj *.pdb *.ilk + rm -f __scalar2pointer.txt ocamlprof.dump "#"* + rm -f *cured.c *.optim.c *_comb.c + rm -rf *.browser + clean-cvsignore || true + diff --git a/cil/test/small2/align.c b/cil/test/small2/align.c new file mode 100644 index 0000000..70c5cf8 --- /dev/null +++ b/cil/test/small2/align.c @@ -0,0 +1,14 @@ + +typedef struct { + volatile unsigned int lock; +} spinlock_t; + +typedef struct { +} __attribute__((__aligned__((1 << ((5) ) ) ))) irq_desc_t; +extern irq_desc_t irq_desc [224 ]; + + + +int main () { + return 0; +} diff --git a/cil/test/small2/alpha.c b/cil/test/small2/alpha.c new file mode 100755 index 0000000..9d43d51 --- /dev/null +++ b/cil/test/small2/alpha.c @@ -0,0 +1,28 @@ + +//KEEP baseline: success + +const unsigned char G___152598331 = 0; +void f() { + const unsigned char G___152598331 = 0; +} + +//This suffix is so long that it will be alpha-renamed as G___1525983317___0 +const unsigned char G___1525983317 = 0; +void f2() { + const unsigned char G___1525983317 = 0; +} + +const unsigned char G___1525983317999999999994352352523523993424999 = 0; +void f3() { +const unsigned char G__1525983317999999999994352352523523993424999 = 0; +} + + +const unsigned char G___999999999 = 0; //KEEP overflow:error = Encountered a variable name containing ___ and many digits +void f4() { + const unsigned char G___152598331 = 0; +} + +int main() { + return 0; +} diff --git a/cil/test/small2/arrayinit.c b/cil/test/small2/arrayinit.c new file mode 100644 index 0000000..6dc7050 --- /dev/null +++ b/cil/test/small2/arrayinit.c @@ -0,0 +1,17 @@ +// arrayinit.c +// char array with initializer exactly filling it, not including NUL +// from sac at stevechamberlain dot com + +#include // assert + +char a[5]="12345"; // CIL prior to 8/01/03 16:17 yielded a warning +char b[5]="1234"; // 5th char is a NUL +char c[]="12345"; // 6th char is a NUL +char d[5]="123"; // 4th, 5th char are NULs +//char e[5]="123456"; // too big! (yields a warning) + +int main() +{ + assert(sizeof(a) / sizeof(a[0]) == 5); + return 0; +} diff --git a/cil/test/small2/arrsize.c b/cil/test/small2/arrsize.c new file mode 100755 index 0000000..16da76b --- /dev/null +++ b/cil/test/small2/arrsize.c @@ -0,0 +1,38 @@ +#include "../small1/testharness.h" + +// NUMERRORS 8 + +int g1[-1]; // ERROR(1):Length of array is negative + +#define MAXINT (1ull << ((8 * sizeof(int)) - 1)) + +int g1[ MAXINT / sizeof(int) ]; //ERROR(2):Length of array is too large +typedef int g1[ MAXINT / sizeof(int) - 1 ];//ERROR(3):Error 3 + +char g1[ MAXINT / sizeof(char) ]; //ERROR(4):Length of array is too large +typedef char g1[ MAXINT / sizeof(char) - 1 ]; //ERROR(5):Error 5 + +double g1[ MAXINT / sizeof(double) ]; //ERROR(6):Length of array is too large +typedef double g1[ MAXINT / sizeof(double) - 1 ]; //ERROR(7):Error 7 + +#if ERROR == 8 +struct cmsghdr { + int cmsg_type; + + __extension__ unsigned char __cmsg_data []; + + }; + +void os_rcv_fd() +{ + char buf[sizeof(struct cmsghdr)]; +} +#endif + +int main() { + g1 *p; E(3); //ERROR(3) + g1 *p; E(5); //ERROR(5) + g1 *p; E(7); //ERROR(7) + E(8); //ERROR(8) + return 0; +} diff --git a/cil/test/small2/asmfndecl.c b/cil/test/small2/asmfndecl.c new file mode 100644 index 0000000..bbc09d1 --- /dev/null +++ b/cil/test/small2/asmfndecl.c @@ -0,0 +1,13 @@ +typedef void (*__sighandler_t) (int) ; + +extern __sighandler_t + mysignal(int __sig, __sighandler_t __handler) + __asm__ ( "" "__sysv_signal" ) ; + +int main() +{ + // make some use of the signal function so that we don't drop it + mysignal(5, (__sighandler_t)0); + return 0; +} + diff --git a/cil/test/small2/attrib.c b/cil/test/small2/attrib.c new file mode 100644 index 0000000..66368c6 --- /dev/null +++ b/cil/test/small2/attrib.c @@ -0,0 +1,8 @@ +struct mpc_config_bus +{ + unsigned char mpc_bustype[6] __attribute((packed)); +}; + +int main () { + return 0; +} diff --git a/cil/test/small2/badasm.c b/cil/test/small2/badasm.c new file mode 100644 index 0000000..ef0d3d5 --- /dev/null +++ b/cil/test/small2/badasm.c @@ -0,0 +1,15 @@ +extern inline void __set_64bit (unsigned long long * ptr, + unsigned int low, unsigned int high) +{ + __asm__ __volatile__ ( + "\n1:\t" + "movl (%0), %%eax\n\t" + "movl 4(%0), %%edx\n\t" + "cmpxchg8b (%0)\n\t" + "jnz 1b" + : + : "D"(ptr), + "b"(low), + "c"(high) + : "ax","dx","memory"); +} diff --git a/cil/test/small2/baddef1.c b/cil/test/small2/baddef1.c new file mode 100644 index 0000000..7e73d91 --- /dev/null +++ b/cil/test/small2/baddef1.c @@ -0,0 +1,8 @@ +// baddef1.c: complain about inconsistent redef + +struct S { + int x; + int y; +}; + +int size1() { return sizeof(struct S); } diff --git a/cil/test/small2/baddef2.c b/cil/test/small2/baddef2.c new file mode 100644 index 0000000..a78d2a8 --- /dev/null +++ b/cil/test/small2/baddef2.c @@ -0,0 +1,30 @@ +// baddef2.c: other def'n + +#include + +struct S { + int x; + int y; + int z; // third field! +}; + +int size2() { return sizeof(struct S); } +int size1(); // from baddef1 + +int main() +{ + int s1, s2; + + printf("size1: %d\n", s1=size1()); + printf("size2: %d\n", s2=size2()); + printf("(correct output is 8, then 12)\n"); + + if (s1==8 && s2==12) { + return 0; + } + else { + return 2; + } +} + + diff --git a/cil/test/small2/bisonerror.c b/cil/test/small2/bisonerror.c new file mode 100644 index 0000000..34fd1f6 --- /dev/null +++ b/cil/test/small2/bisonerror.c @@ -0,0 +1,16 @@ +/* Generated by Frontc */ + +typedef struct core { + int somefield; +} core ; + +void closure(short * core , int n ) +{ + short * csend ; + csend = core + n; +} + +int main () { + core x; + return 0; +} diff --git a/cil/test/small2/bogus_redef.c b/cil/test/small2/bogus_redef.c new file mode 100644 index 0000000..602a305 --- /dev/null +++ b/cil/test/small2/bogus_redef.c @@ -0,0 +1,21 @@ +// provoke bogus "redefinition" message + +//This will not compile on gcc 4.0 or later, but CIL handles it. + +int foo() +{ + // call before decl + return bar(); +} + +// now define statically +static // comment me out to make problem disappear +int bar() +{ + return 4; +} + +int main() +{ + return foo() - 4; +} diff --git a/cil/test/small2/brlock.c b/cil/test/small2/brlock.c new file mode 100644 index 0000000..19ecf2c --- /dev/null +++ b/cil/test/small2/brlock.c @@ -0,0 +1,20 @@ +// brlock.c +// reproduce compile problem with linux lib/brlock.c + +typedef struct { + volatile unsigned int lock; + + + +} rwlock_t; +typedef rwlock_t brlock_read_lock_t; + +enum brlock_indices { + BR_GLOBALIRQ_LOCK, + BR_NETPROTO_LOCK, + + __BR_END +}; + +brlock_read_lock_t __brlock_array[32 ][(((sizeof(brlock_read_lock_t)*__BR_END + (1 << ((5) ) ) -1) & ~((1 << ((5) ) ) -1)) / sizeof(brlock_read_lock_t)) ] = + { [0 ... 32 -1] = { [0 ... (((sizeof(brlock_read_lock_t)*__BR_END + (1 << ((5) ) ) -1) & ~((1 << ((5) ) ) -1)) / sizeof(brlock_read_lock_t)) -1] = (rwlock_t) { 0x01000000 } } }; diff --git a/cil/test/small2/bzero.c b/cil/test/small2/bzero.c new file mode 100644 index 0000000..b78c7be --- /dev/null +++ b/cil/test/small2/bzero.c @@ -0,0 +1,12 @@ +// bzero.c +// we call bzero w/o any complaint? + +//#include // bzero + +char buf[80]; + +int main() +{ + bzero(buf, (void*)80); // this is how anagram does it + return 0; +} diff --git a/cil/test/small2/checkinit.c b/cil/test/small2/checkinit.c new file mode 100644 index 0000000..cd968e9 --- /dev/null +++ b/cil/test/small2/checkinit.c @@ -0,0 +1,70 @@ +// Checking of initialization code +#include "../small1/testharness.h" +#include "../small1/testkinds.h" + +// NUMERRORS 6 + +//Prevent inlinging of these functions. We want to make sure their +//stack frames overlap. +#if __GNUC__ >= 3 +#define NOINLINE __attribute__((noinline)) +#else +#define NOINLINE +#endif + + +// Fill the stack with values that are invalid as pointers +void dirtyStack() NOINLINE { + int i, frame[1024]; + for(i=0;ip = &a; + plocalStruct->p = &b; +} + +//Store a stack variable that sits higher in the stack inside a local +void storeToStack(int* pStack) +{ + struct aPointer localStruct; + struct aPointer *plocalStruct = &localStruct; + + //This should be legal, since localStruct will go away before *pStack does. + plocalStruct->p = pStack; +} + +int *gptr; + +int global; + +int function() { + int local; + + // This should work + gptr = &global; //ERROR(0) + + // so should this + storeLocals(); + // and this + storeToStack(&local); + + // This should fail + gptr = &local; // ERROR(1):STORE_SP + + // Play a trick with pointer arithemtic (SEQ) +#if ERROR == 2 + { + // ERROR(2):Storing stack address + int *t = &local; t += (&global - t); + if(! HAS_KIND(t, SEQ_KIND)) E(2); + gptr = t; // Should fail + local = *(gptr + (&local - gptr)); + } +#endif + + // The same trick with WILD +#if ERROR == 3 + { + // ERROR(3):Storing stack address + int *t = (int**)&local; // t is WILD now + if(! HAS_KIND(t, WILD_KIND)) E(3); + t += (&global - t); gptr = t; // Should fail + } +#endif + + // The same trick with FSEQ +#if ERROR == 4 + { + //matth: we get an LBound failure in Linux in "f = s" because the global is + // stored below the stack. In windows, we get a UBound failure converting f + // to a SAFE in "gptr = f" because the global is above the stack. + // ERROR(4):bound + int *f = &local; + int *s = &local; s += (&global - s); // s is SEQ + f ++; // f has type FSEQ + if(! HAS_KIND(f, FSEQ_KIND)) E(4); + f = s; //Actually we fail here because s is below its home + gptr = f; // Should fail + } +#endif + + + // Now writing structures +#if 5 <= ERROR && ERROR <= 7 + { + static struct str1 { + int i1; + struct { + int *s2; + } i2; + int * i3; + } gstr; + struct str1 res = { 0, &global, &global };//ERROR(5):Error 5 + struct str1 res = { 0, &local, &global };//ERROR(6):Storing stack address + struct str1 res = { 0, &global, &local };//ERROR(7):Storing stack address + gstr = res; + E(5); + } +#endif + + // Now write an array +#if 8 <= ERROR && ERROR <= 10 + { + static struct strarr { + int *a[4]; + } garr; + struct strarr res = { &global, &global, &global };//ERROR(8):Error 8 + struct strarr res = { 0, &local, &global };//ERROR(9):Storing stack address + struct strarr res = { 0, &global, &local };//ERROR(10):Storing stack address + garr = res; + E(8); + } +#endif + + // Now write a union +#if 11 <= ERROR && ERROR <= 13 + { + static union un { + int *a[4]; + struct { int *a1, *a2, *a3; } b; + } gun; + union un res = { &global, &global, &global };//ERROR(11):Error 11 + union un res = { 0, &local, &global };//ERROR(12):Storing stack address + union un res = { 0, &global, &local };//ERROR(13):Storing stack address + gun = res; + E(11); + } +#endif + + //make this function look recursive to discourage inlining. + // (if we are inlined into main, then 'local' looks like one of main's + // locals, and will be treated like a global because we treate main + // as a special case.) + if (gptr == 0xdeadbeef) { + function (); + } + +} + + +// We must do all tests not in main, because CCured now allows +// addresses of locals in main to be stored into the heap +int main() { + function(); +} diff --git a/cil/test/small2/checkstore2.c b/cil/test/small2/checkstore2.c new file mode 100644 index 0000000..f13632f --- /dev/null +++ b/cil/test/small2/checkstore2.c @@ -0,0 +1,17 @@ + +int *globptr; + +int global; + +int foo() { + int local; + int *s = &local; s += (&global - s); // s == &global but with the home of the local + globptr = s; // Store away the pointer. Succeeds because s's value is not on the stack + return (int)&local; // We'll need this later +} + +int main() { + int localaddr = foo(); + globptr += (localaddr - (int)globptr);// glob == &local with the home of the &local + return *globptr; // We are reading from a dead stack frame +} diff --git a/cil/test/small2/checkstore3.c b/cil/test/small2/checkstore3.c new file mode 100644 index 0000000..4fe9aff --- /dev/null +++ b/cil/test/small2/checkstore3.c @@ -0,0 +1,24 @@ +// Makes sure that pointers within structures are checked. +// NUMERRORS 1 + +struct foo +{ + char * __FSEQ p; +}; + +int +bar(struct foo *fp) +{ + struct foo f; + char buf[10]; + f.p = buf; + *fp = f; // ERROR(1):Storing stack address + return 0; +} + +int +main(void) +{ + struct foo f; + return bar(&f); +} diff --git a/cil/test/small2/checksymbol.c b/cil/test/small2/checksymbol.c new file mode 100644 index 0000000..487c94e --- /dev/null +++ b/cil/test/small2/checksymbol.c @@ -0,0 +1,102 @@ +typedef unsigned short setword; + +typedef struct { setword S[6]; } symset; + +typedef char boolean; +boolean Member(), Le(), Ge(), Eq(), Ne(); + +typedef enum { sand, sarray, sbegin, scase, + sconst, sdiv, sdo, sdownto, + selse, send, sextern, sfile, + sfor, sforward, sfunc, sgoto, + sif, sinn, slabel, smod, + snil, snot, sof, sor, + sother, spacked, sproc, spgm, + srecord, srepeat, sset, sthen, + sto, stype, suntil, svar, + swhile, swith, seof, sinteger, + sreal, sstring, schar, sid, + splus, sminus, smul, squot, + sarrow, slpar, srpar, slbrack, + srbrack, seq, sne, slt, + sle, sgt, sge, scomma, + scolon, ssemic, sassign, sdotdot, + sdot } symtyp; + +typedef unsigned char hashtyp; +typedef unsigned short strindx; + +typedef struct S59 * idptr; +typedef struct S59 { + idptr inext; + unsigned char inref; + hashtyp ihash; + strindx istr; +} idnode; + + +typedef struct S180 { + symtyp st; + union { + struct { + idptr vid; + } V1; + struct { + char vchr; + } V2; +#if 0 + struct { + integer vint; + } V3; + struct { + strindx vflt; + } V4; + struct { + strindx vstr; + } V5; +#endif // 0 + } U; +} lexsym; + +lexsym currsym; + +void error(); + +typedef enum { ebadsymbol, elongstring, elongtokn, erange, + emanytokn, enotdeclid, emultdeclid, enotdecllab, + emultdecllab, emuldeflab, ebadstring, enulchr, + ebadchar, eeofcmnt, eeofstr, evarpar, + enew, esetbase, esetsize, eoverflow, + etree, etag, euprconf, easgnconf, + ecmpconf, econfconf, evrntfile, evarfile, + emanymachs, ebadmach } errors; + + void +checksymbol(ss) + symset ss; +{ + if (!(Member((unsigned)(currsym.st), ss.S))) + error(ebadsymbol); +} + +#if 0 +static boolean +Member(m, sp) + register unsigned int m; + register setptr sp; +{ + register unsigned int i = m / (setbits+1) + 1; + + if ((i <= *sp) && (sp[i] & (1 << (m % (setbits+1))))) + return (true); + return (false); +} +#else +static boolean Member() { return 1; } +#endif + + +int main() +{ + return 0; +} diff --git a/cil/test/small2/cilreturn.c b/cil/test/small2/cilreturn.c new file mode 100755 index 0000000..935f7c6 --- /dev/null +++ b/cil/test/small2/cilreturn.c @@ -0,0 +1,40 @@ + +// A CIL test. But use CCured on it for stricter checking of the foo2 case. + +int z; +typedef struct bar { int* ip; } Bar; +Bar global = {0}; + +int foo (int x) { + switch (x) { + case 0: + x++; + z++; + break; + default: + return z; + } + // we need a return here. Make sure there's a warning if it's missing. + return z; //DROP switch: success = Warning: Body of function foo falls-through +} + +Bar foo2 (int x) { + while (1) { + if (z++) + return global; + } + // no need for a return here. If CIL falsely assumes we need a return, + // ccured will fail to compile since it doesn't know how to make a Bar. +} + +Bar foo3 (int x) { + while (z < 10) { + z++; + } + // we need this return. + return global; //DROP loop: error +} + +int main(){ + return 0; +} diff --git a/cil/test/small2/cmpzero.c b/cil/test/small2/cmpzero.c new file mode 100644 index 0000000..761501a --- /dev/null +++ b/cil/test/small2/cmpzero.c @@ -0,0 +1,29 @@ +// comparison of 0 and '\0' .. + +#include // printf + +int main() +{ + int *i = (int*)512; // low byte is 0 + char c = (char)i; // should be 0 + + printf("i: %d\n", (int)i); + printf("c: %d\n", (int)c); + + if (i == '\0') { + printf("yes. This is not correct!!\n"); // cil'd code does this! + return 1; + } + else { + printf("no\n"); // ordinary gcc does this + } + + if ((int)(char)i == (int)'\0') { + printf("2nd yes\n"); // ordinary gcc does this + } + else { + printf("2nd no\n"); + } + printf("Success\n"); + return 0; +} diff --git a/cil/test/small2/cof.c b/cil/test/small2/cof.c new file mode 100644 index 0000000..312405c --- /dev/null +++ b/cil/test/small2/cof.c @@ -0,0 +1,8681 @@ +# 1 "cof.c" +# 1 "/home/scott/wrk/safec/cil/lib/fixup.h" 1 + + +# 21 "/home/scott/wrk/safec/cil/lib/fixup.h" + + + + + + + + + + + + +# 55 "/home/scott/wrk/safec/cil/lib/fixup.h" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +void exit(int); + + + + + +#pragma ccuredalloc("malloc", nozero, sizein(1)) +#pragma ccuredalloc("alloca", nozero, sizein(1)) +#pragma ccuredalloc("calloc", zero, sizemul(1,2)) + +#pragma ccuredvararg("printf", printf(1)) +#pragma ccuredvararg("fprintf", printf(2)) +#pragma ccuredvararg("sprintf", printf(2)) +#pragma ccuredvararg("snprintf", printf(3)) + +#pragma ccuredexported("main") + + + + + +# 1 "cof.c" 2 +# 1 "espresso.h" 1 + + + + +# 1 "port.h" 1 + + + + + + + +# 19 "port.h" + + + + + + + + + + + + + + + + +typedef long int32; +typedef int int16; + + + + +# 57 "port.h" + + + + + + +# 1 "/usr/include/stdio.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/features.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 137 "/usr/include/features.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 195 "/usr/include/features.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/sys/cdefs.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 71 "/usr/include/sys/cdefs.h" 3 + + + + + + + + + + + + + + +# 103 "/usr/include/sys/cdefs.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 249 "/usr/include/features.h" 2 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/gnu/stubs.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 277 "/usr/include/features.h" 2 3 + + + + +# 27 "/usr/include/stdio.h" 2 3 + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef unsigned int size_t; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 271 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + +# 283 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 33 "/usr/include/stdio.h" 2 3 + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stdarg.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef void *__gnuc_va_list; + + + + + +# 116 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stdarg.h" 3 + + + + + + + + + + + + + + + + + + + +# 202 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stdarg.h" 3 + + + + +# 38 "/usr/include/stdio.h" 2 3 + + +# 1 "/usr/include/bits/types.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + +# 188 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + +# 271 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + +# 283 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 29 "/usr/include/bits/types.h" 2 3 + + + +typedef unsigned char __u_char; +typedef unsigned short __u_short; +typedef unsigned int __u_int; +typedef unsigned long __u_long; + +__extension__ typedef unsigned long long int __u_quad_t; +__extension__ typedef long long int __quad_t; +# 48 "/usr/include/bits/types.h" 3 + +typedef signed char __int8_t; +typedef unsigned char __uint8_t; +typedef signed short int __int16_t; +typedef unsigned short int __uint16_t; +typedef signed int __int32_t; +typedef unsigned int __uint32_t; + +__extension__ typedef signed long long int __int64_t; +__extension__ typedef unsigned long long int __uint64_t; + +typedef __quad_t *__qaddr_t; + +typedef __u_quad_t __dev_t; +typedef __u_int __uid_t; +typedef __u_int __gid_t; +typedef __u_long __ino_t; +typedef __u_int __mode_t; +typedef __u_int __nlink_t; +typedef long int __off_t; +typedef __quad_t __loff_t; +typedef int __pid_t; +typedef int __ssize_t; +typedef long int __rlim_t; +typedef __quad_t __rlim64_t; +typedef __u_int __id_t; + +typedef struct + { + int __val[2]; + } __fsid_t; + + +typedef int __daddr_t; +typedef char *__caddr_t; +typedef long int __time_t; +typedef long int __swblk_t; + +typedef long int __clock_t; + + +typedef unsigned long int __fd_mask; + + + + + + + + + + +typedef struct + { + + + + + + + __fd_mask __fds_bits[1024 / (8 * sizeof (__fd_mask)) ]; + + + } __fd_set; + + +typedef int __key_t; + + +typedef unsigned short int __ipc_pid_t; + + + + + +typedef long int __blkcnt_t; +typedef __quad_t __blkcnt64_t; + + +typedef __u_long __fsblkcnt_t; +typedef __u_quad_t __fsblkcnt64_t; + + +typedef __u_long __fsfilcnt_t; +typedef __u_quad_t __fsfilcnt64_t; + + +typedef __u_long __ino64_t; + + +typedef __loff_t __off64_t; + + +typedef int __t_scalar_t; +typedef unsigned int __t_uscalar_t; + + +typedef int __intptr_t; + + + + + + + + +# 40 "/usr/include/stdio.h" 2 3 + + + + + + + + +typedef struct _IO_FILE FILE; + + + + + + + + +# 1 "/usr/include/libio.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/_G_config.h" 1 3 + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + +# 188 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef long int wchar_t; + + + + + + + + + + + + + + + + + + + + + + + + +typedef unsigned int wint_t; + + + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 14 "/usr/include/_G_config.h" 2 3 + + + + + + + + + + + + + + + + + + + + + +typedef int _G_int16_t __attribute__ ((__mode__ (__HI__))); +typedef int _G_int32_t __attribute__ ((__mode__ (__SI__))); +typedef unsigned int _G_uint16_t __attribute__ ((__mode__ (__HI__))); +typedef unsigned int _G_uint32_t __attribute__ ((__mode__ (__SI__))); + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 30 "/usr/include/libio.h" 2 3 + + + + + + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stdarg.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 116 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stdarg.h" 3 + + + + + + + + + + + + + + + + + + + +# 202 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stdarg.h" 3 + + + + +# 48 "/usr/include/libio.h" 2 3 + + + + + + + +# 67 "/usr/include/libio.h" 3 + + + + + + + + + + + + + + + + + + + + +# 98 "/usr/include/libio.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +struct _IO_jump_t; struct _IO_FILE; + + + + + + + + + +typedef void _IO_lock_t; + + + + + +struct _IO_marker { + struct _IO_marker *_next; + struct _IO_FILE *_sbuf; + + + + int _pos; +# 186 "/usr/include/libio.h" 3 + +}; + +struct _IO_FILE { + int _flags; + + + + + char* _IO_read_ptr; + char* _IO_read_end; + char* _IO_read_base; + char* _IO_write_base; + char* _IO_write_ptr; + char* _IO_write_end; + char* _IO_buf_base; + char* _IO_buf_end; + + char *_IO_save_base; + char *_IO_backup_base; + char *_IO_save_end; + + struct _IO_marker *_markers; + + struct _IO_FILE *_chain; + + int _fileno; + int _blksize; + __off_t _old_offset; + + + + unsigned short _cur_column; + signed char _vtable_offset; + char _shortbuf[1]; + + + + _IO_lock_t *_lock; + + + + + + + + + __off64_t _offset; + + int _unused2[16]; + +}; + + +typedef struct _IO_FILE _IO_FILE; + + +struct _IO_FILE_plus; +extern struct _IO_FILE_plus _IO_2_1_stdin_; +extern struct _IO_FILE_plus _IO_2_1_stdout_; +extern struct _IO_FILE_plus _IO_2_1_stderr_; + + + + + + + + + + + + + + + +typedef __ssize_t __io_read_fn (void * __cookie, char *__buf, + size_t __nbytes) ; + + + + + + + +typedef __ssize_t __io_write_fn (void * __cookie, __const char *__buf, + size_t __n) ; + + + + + + + +typedef int __io_seek_fn (void * __cookie, __off_t __pos, int __w) ; + + +typedef int __io_close_fn (void * __cookie) ; + + +# 311 "/usr/include/libio.h" 3 + + + + + + + +extern int __underflow (_IO_FILE *) ; +extern int __uflow (_IO_FILE *) ; +extern int __overflow (_IO_FILE *, int) ; + + + + + + + + + + + + + + + + +extern int _IO_getc (_IO_FILE *__fp) ; +extern int _IO_putc (int __c, _IO_FILE *__fp) ; +extern int _IO_feof (_IO_FILE *__fp) ; +extern int _IO_ferror (_IO_FILE *__fp) ; + +extern int _IO_peekc_locked (_IO_FILE *__fp) ; + + + + + +extern void _IO_flockfile (_IO_FILE *) ; +extern void _IO_funlockfile (_IO_FILE *) ; +extern int _IO_ftrylockfile (_IO_FILE *) ; + + + + + + + + + + + + +extern int _IO_vfscanf (_IO_FILE * , const char * , + __gnuc_va_list , int * ) ; +extern int _IO_vfprintf (_IO_FILE * , const char * , + __gnuc_va_list ) ; +extern __ssize_t _IO_padn (_IO_FILE *, int, __ssize_t ) ; +extern size_t _IO_sgetn (_IO_FILE *, void *, size_t ) ; + +extern __off64_t _IO_seekoff (_IO_FILE *, __off64_t , int, int) ; +extern __off64_t _IO_seekpos (_IO_FILE *, __off64_t , int) ; + +extern void _IO_free_backup_area (_IO_FILE *) ; + + + + + + +# 57 "/usr/include/stdio.h" 2 3 + + + + +typedef __off_t fpos_t; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/stdio_lim.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 110 "/usr/include/stdio.h" 2 3 + + + + +extern FILE *stdin; +extern FILE *stdout; +extern FILE *stderr; + + + +extern int remove (__const char *__filename) ; + +extern int rename (__const char *__old, __const char *__new) ; + + + + +extern FILE *tmpfile (void) ; + + + + + + + + + + + +extern char *tmpnam (char *__s) ; + + + + +extern char *tmpnam_r (char *__s) ; + + + + + + + + + + + +extern char *tempnam (__const char *__dir, __const char *__pfx) ; + + + + +extern int fclose (FILE *__stream) ; + +extern int fflush (FILE *__stream) ; + + + +extern int fflush_unlocked (FILE *__stream) ; + + + + + + + + + + +extern FILE *fopen (__const char * __filename, + __const char * __modes) ; + +extern FILE *freopen (__const char * __filename, + __const char * __modes, + FILE * __stream) ; +# 197 "/usr/include/stdio.h" 3 + + + + + + + + + + + +extern FILE *fdopen (int __fd, __const char *__modes) ; + + +# 223 "/usr/include/stdio.h" 3 + + + + + +extern void setbuf (FILE * __stream, char * __buf) ; + + + +extern int setvbuf (FILE * __stream, char * __buf, + int __modes, size_t __n) ; + + + + +extern void setbuffer (FILE * __stream, char * __buf, + size_t __size) ; + + +extern void setlinebuf (FILE *__stream) ; + + + + +extern int fprintf (FILE * __stream, + __const char * __format, ...) ; + +extern int printf (__const char * __format, ...) ; + +extern int sprintf (char * __s, + __const char * __format, ...) ; + + +extern int vfprintf (FILE * __s, + __const char * __format, + __gnuc_va_list __arg) ; + +extern int vprintf (__const char * __format, + __gnuc_va_list __arg) ; + +extern int vsprintf (char * __s, + __const char * __format, + __gnuc_va_list __arg) ; + + + +extern int snprintf (char * __s, size_t __maxlen, + __const char * __format, ...) + __attribute__ ((__format__ (__printf__, 3, 4))); + +extern int __vsnprintf (char * __s, size_t __maxlen, + __const char * __format, + __gnuc_va_list __arg) + __attribute__ ((__format__ (__printf__, 3, 0))); +extern int vsnprintf (char * __s, size_t __maxlen, + __const char * __format, + __gnuc_va_list __arg) + __attribute__ ((__format__ (__printf__, 3, 0))); + + +# 302 "/usr/include/stdio.h" 3 + + + + +extern int fscanf (FILE * __stream, + __const char * __format, ...) ; + +extern int scanf (__const char * __format, ...) ; + +extern int sscanf (__const char * __s, + __const char * __format, ...) ; + +# 330 "/usr/include/stdio.h" 3 + + + + +extern int fgetc (FILE *__stream) ; +extern int getc (FILE *__stream) ; + + +extern int getchar (void) ; + + + + + + + +extern int getc_unlocked (FILE *__stream) ; +extern int getchar_unlocked (void) ; + + + + +extern int fgetc_unlocked (FILE *__stream) ; + + + + +extern int fputc (int __c, FILE *__stream) ; +extern int putc (int __c, FILE *__stream) ; + + +extern int putchar (int __c) ; + + + + + + + +extern int fputc_unlocked (int __c, FILE *__stream) ; + + + + +extern int putc_unlocked (int __c, FILE *__stream) ; +extern int putchar_unlocked (int __c) ; + + + + + +extern int getw (FILE *__stream) ; + + +extern int putw (int __w, FILE *__stream) ; + + + + +extern char *fgets (char * __s, int __n, + FILE * __stream) ; + + + + + + + + + +extern char *gets (char *__s) ; + + +# 420 "/usr/include/stdio.h" 3 + + + + +extern int fputs (__const char * __s, + FILE * __stream) ; + + + + + + + + +extern int puts (__const char *__s) ; + + + +extern int ungetc (int __c, FILE *__stream) ; + + + +extern size_t fread (void * __ptr, size_t __size, + size_t __n, FILE * __stream) ; + +extern size_t fwrite (__const void * __ptr, size_t __size, + size_t __n, FILE * __s) ; + + + +extern size_t fread_unlocked (void * __ptr, size_t __size, + size_t __n, FILE * __stream) ; +extern size_t fwrite_unlocked (__const void * __ptr, + size_t __size, size_t __n, + FILE * __stream) ; + + + + +extern int fseek (FILE *__stream, long int __off, int __whence) ; + +extern long int ftell (FILE *__stream) ; + +extern void rewind (FILE *__stream) ; + + + + + + + + + +typedef __off_t off_t; + + + + + + + + + + + + + + + + + + + + + +extern int fgetpos (FILE * __stream, + fpos_t * __pos) ; + +extern int fsetpos (FILE *__stream, __const fpos_t *__pos) ; +# 519 "/usr/include/stdio.h" 3 + + +# 529 "/usr/include/stdio.h" 3 + + + +extern void clearerr (FILE *__stream) ; + +extern int feof (FILE *__stream) ; + +extern int ferror (FILE *__stream) ; + + + +extern void clearerr_unlocked (FILE *__stream) ; +extern int feof_unlocked (FILE *__stream) ; +extern int ferror_unlocked (FILE *__stream) ; + + + + +extern void perror (__const char *__s) ; + + + + +extern int sys_nerr; +extern __const char *__const sys_errlist[]; + + + + + + + + + +extern int fileno (FILE *__stream) ; + + + + +extern int fileno_unlocked (FILE *__stream) ; + + + + + + +extern FILE *popen (__const char *__command, __const char *__modes) ; + + +extern int pclose (FILE *__stream) ; + + + + + +extern char *ctermid (char *__s) ; + + + + + + + + + +# 603 "/usr/include/stdio.h" 3 + + + + + + + +extern void flockfile (FILE *__stream) ; + + + +extern int ftrylockfile (FILE *__stream) ; + + +extern void funlockfile (FILE *__stream) ; + + + + + + + + + + + + + + + + + + + + + +# 63 "port.h" 2 + +# 1 "/usr/include/ctype.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/endian.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/endian.h" 1 3 + + + + + + + +# 35 "/usr/include/endian.h" 2 3 + + + + + + + + + + + + + + + + +# 40 "/usr/include/ctype.h" 2 3 + + + + + + + +enum +{ + _ISupper = (( 0 ) < 8 ? ((1 << ( 0 )) << 8) : ((1 << ( 0 )) >> 8)) , + _ISlower = (( 1 ) < 8 ? ((1 << ( 1 )) << 8) : ((1 << ( 1 )) >> 8)) , + _ISalpha = (( 2 ) < 8 ? ((1 << ( 2 )) << 8) : ((1 << ( 2 )) >> 8)) , + _ISdigit = (( 3 ) < 8 ? ((1 << ( 3 )) << 8) : ((1 << ( 3 )) >> 8)) , + _ISxdigit = (( 4 ) < 8 ? ((1 << ( 4 )) << 8) : ((1 << ( 4 )) >> 8)) , + _ISspace = (( 5 ) < 8 ? ((1 << ( 5 )) << 8) : ((1 << ( 5 )) >> 8)) , + _ISprint = (( 6 ) < 8 ? ((1 << ( 6 )) << 8) : ((1 << ( 6 )) >> 8)) , + _ISgraph = (( 7 ) < 8 ? ((1 << ( 7 )) << 8) : ((1 << ( 7 )) >> 8)) , + _ISblank = (( 8 ) < 8 ? ((1 << ( 8 )) << 8) : ((1 << ( 8 )) >> 8)) , + _IScntrl = (( 9 ) < 8 ? ((1 << ( 9 )) << 8) : ((1 << ( 9 )) >> 8)) , + _ISpunct = (( 10 ) < 8 ? ((1 << ( 10 )) << 8) : ((1 << ( 10 )) >> 8)) , + _ISalnum = (( 11 ) < 8 ? ((1 << ( 11 )) << 8) : ((1 << ( 11 )) >> 8)) +}; + + + + + + + + + + + + + +extern __const unsigned short int *__ctype_b; +extern __const __int32_t *__ctype_tolower; +extern __const __int32_t *__ctype_toupper; + + + + + + + + + + + + + +extern int isalnum (int) ; +extern int isalpha (int) ; +extern int iscntrl (int) ; +extern int isdigit (int) ; +extern int islower (int) ; +extern int isgraph (int) ; +extern int isprint (int) ; +extern int ispunct (int) ; +extern int isspace (int) ; +extern int isupper (int) ; +extern int isxdigit (int) ; + + + + + + + +extern int tolower (int __c) ; + + +extern int toupper (int __c) ; + + + + + + +extern int isascii (int __c) ; + + + +extern int toascii (int __c) ; + + + + + + +extern int _toupper (int) ; +extern int _tolower (int) ; + + + + + + + + + + + + + + + + + + + +# 164 "/usr/include/ctype.h" 3 + + +# 186 "/usr/include/ctype.h" 3 + + + + + + + + + + + + + +# 273 "/usr/include/ctype.h" 3 + + + + + +# 64 "port.h" 2 + +# 1 "/usr/include/sys/types.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef __u_char u_char; +typedef __u_short u_short; +typedef __u_int u_int; +typedef __u_long u_long; +typedef __quad_t quad_t; +typedef __u_quad_t u_quad_t; +typedef __fsid_t fsid_t; + + +typedef __loff_t loff_t; + + + +typedef __ino_t ino_t; + + + + + + + + + + +typedef __dev_t dev_t; + + + + +typedef __gid_t gid_t; + + + + +typedef __mode_t mode_t; + + + + +typedef __nlink_t nlink_t; + + + + +typedef __uid_t uid_t; + + + + + + + + + + + + + + + + + +typedef __pid_t pid_t; + + + + +typedef __id_t id_t; + + + +typedef __ssize_t ssize_t; + + + + +typedef __daddr_t daddr_t; +typedef __caddr_t caddr_t; + + + +typedef __key_t key_t; + + + + + + +# 1 "/usr/include/time.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 51 "/usr/include/time.h" 3 + + + +# 62 "/usr/include/time.h" 3 + + + + + + + + + +typedef __time_t time_t; + + + + + +# 89 "/usr/include/time.h" 3 + + + + +# 279 "/usr/include/time.h" 3 + + + +# 121 "/usr/include/sys/types.h" 2 3 + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + +# 188 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + +# 271 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + +# 283 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 124 "/usr/include/sys/types.h" 2 3 + + + + +typedef unsigned long int ulong; +typedef unsigned short int ushort; +typedef unsigned int uint; + + + + +# 158 "/usr/include/sys/types.h" 3 + + + + + + + + + + +typedef int int8_t __attribute__ ((__mode__ ( __QI__ ))) ; +typedef int int16_t __attribute__ ((__mode__ ( __HI__ ))) ; +typedef int int32_t __attribute__ ((__mode__ ( __SI__ ))) ; +typedef int int64_t __attribute__ ((__mode__ ( __DI__ ))) ; + + +typedef unsigned int u_int8_t __attribute__ ((__mode__ ( __QI__ ))) ; +typedef unsigned int u_int16_t __attribute__ ((__mode__ ( __HI__ ))) ; +typedef unsigned int u_int32_t __attribute__ ((__mode__ ( __SI__ ))) ; +typedef unsigned int u_int64_t __attribute__ ((__mode__ ( __DI__ ))) ; + +typedef int register_t __attribute__ ((__mode__ (__word__))); + + + + + + + + + + + + + +# 1 "/usr/include/sys/select.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/select.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 36 "/usr/include/bits/select.h" 3 + + + + + + + + + + + + +# 56 "/usr/include/bits/select.h" 3 + +# 72 "/usr/include/bits/select.h" 3 + +# 31 "/usr/include/sys/select.h" 2 3 + + + +# 1 "/usr/include/bits/sigset.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + +typedef int __sig_atomic_t; + + + + +typedef struct + { + unsigned long int __val[(1024 / (8 * sizeof (unsigned long int))) ]; + } __sigset_t; + + + + + + + + + + +# 125 "/usr/include/bits/sigset.h" 3 + +# 34 "/usr/include/sys/select.h" 2 3 + + + + +# 1 "/usr/include/time.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 51 "/usr/include/time.h" 3 + + + +# 62 "/usr/include/time.h" 3 + + + +# 73 "/usr/include/time.h" 3 + + + + + + + + + + +struct timespec + { + long int tv_sec; + long int tv_nsec; + }; + + + + + +# 279 "/usr/include/time.h" 3 + + + +# 38 "/usr/include/sys/select.h" 2 3 + + + + + + + + +struct timeval; + +typedef __fd_mask fd_mask; + + +typedef __fd_set fd_set; + + + + + + + + + + + + + + + + + + + + + + +extern int __select (int __nfds, __fd_set *__readfds, + __fd_set *__writefds, __fd_set *__exceptfds, + struct timeval *__timeout) ; +extern int select (int __nfds, __fd_set *__readfds, + __fd_set *__writefds, __fd_set *__exceptfds, + struct timeval *__timeout) ; + +# 91 "/usr/include/sys/select.h" 3 + + + + + +# 193 "/usr/include/sys/types.h" 2 3 + + + +# 1 "/usr/include/sys/sysmacros.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 47 "/usr/include/sys/sysmacros.h" 3 + + + +# 196 "/usr/include/sys/types.h" 2 3 + + + + + + +typedef __blkcnt_t blkcnt_t; +typedef __fsblkcnt_t fsblkcnt_t; +typedef __fsfilcnt_t fsfilcnt_t; + + + + + + + + + + + + + + + +# 65 "port.h" 2 + + +# 1 "/usr/include/math.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/huge_val.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 68 "/usr/include/bits/huge_val.h" 3 + +# 33 "/usr/include/math.h" 2 3 + + + + + + + +# 1 "/usr/include/bits/mathdef.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + +# 45 "/usr/include/bits/mathdef.h" 3 + +# 40 "/usr/include/math.h" 2 3 + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/mathcalls.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +extern double acos (double __x) ; extern double __acos (double __x) ; + +extern double asin (double __x) ; extern double __asin (double __x) ; + +extern double atan (double __x) ; extern double __atan (double __x) ; + +extern double atan2 (double __y, double __x) ; extern double __atan2 (double __y, double __x) ; + + +extern double cos (double __x) ; extern double __cos (double __x) ; + +extern double sin (double __x) ; extern double __sin (double __x) ; + +extern double tan (double __x) ; extern double __tan (double __x) ; + + + + + + + + + + +extern double cosh (double __x) ; extern double __cosh (double __x) ; + +extern double sinh (double __x) ; extern double __sinh (double __x) ; + +extern double tanh (double __x) ; extern double __tanh (double __x) ; + + + +extern double acosh (double __x) ; extern double __acosh (double __x) ; + +extern double asinh (double __x) ; extern double __asinh (double __x) ; + +extern double atanh (double __x) ; extern double __atanh (double __x) ; + + + + + +extern double exp (double __x) ; extern double __exp (double __x) ; + + + + + + + + + +extern double frexp (double __x, int *__exponent) ; extern double __frexp (double __x, int *__exponent) ; + + +extern double ldexp (double __x, int __exponent) ; extern double __ldexp (double __x, int __exponent) ; + + +extern double log (double __x) ; extern double __log (double __x) ; + + +extern double log10 (double __x) ; extern double __log10 (double __x) ; + + +extern double modf (double __x, double *__iptr) ; extern double __modf (double __x, double *__iptr) ; + + + +extern double expm1 (double __x) ; extern double __expm1 (double __x) ; + + +extern double log1p (double __x) ; extern double __log1p (double __x) ; + + +extern double logb (double __x) ; extern double __logb (double __x) ; + + + + + + + + + + + + + + +extern double pow (double __x, double __y) ; extern double __pow (double __x, double __y) ; + + +extern double sqrt (double __x) ; extern double __sqrt (double __x) ; + + + +extern double hypot (double __x, double __y) ; extern double __hypot (double __x, double __y) ; + + + + +extern double cbrt (double __x) ; extern double __cbrt (double __x) ; + + + + + + +extern double ceil (double __x) ; extern double __ceil (double __x) ; + + +extern double fabs (double __x) __attribute__ ( (__const__) ); extern double __fabs (double __x) __attribute__ ( (__const__) ) ; + + +extern double floor (double __x) ; extern double __floor (double __x) ; + + +extern double fmod (double __x, double __y) ; extern double __fmod (double __x, double __y) ; + + + + +extern int __isinf (double __value) __attribute__ ((__const__)); + + + + +extern int isinf (double __value) __attribute__ ((__const__)); + + +extern int finite (double __value) __attribute__ ( (__const__) ); extern int __finite (double __value) __attribute__ ( (__const__) ) ; + + + + + + + +extern double infnan (int __error) __attribute__ ( (__const__) ); extern double __infnan (int __error) __attribute__ ( (__const__) ) ; + + +extern double drem (double __x, double __y) ; extern double __drem (double __x, double __y) ; + + + +extern double significand (double __x) ; extern double __significand (double __x) ; + + + + +extern double copysign (double __x, double __y) __attribute__ ( (__const__) ); extern double __copysign (double __x, double __y) __attribute__ ( (__const__) ) ; + + + + + + + + + + +extern int isnan (double __value) __attribute__ ( (__const__) ); extern int __isnan (double __value) __attribute__ ( (__const__) ) ; + + +extern double j0 (double ) ; extern double __j0 (double ) ; +extern double j1 (double ) ; extern double __j1 (double ) ; +extern double jn (int, double ) ; extern double __jn (int, double ) ; +extern double y0 (double ) ; extern double __y0 (double ) ; +extern double y1 (double ) ; extern double __y1 (double ) ; +extern double yn (int, double ) ; extern double __yn (int, double ) ; + + + + + +extern double erf (double ) ; extern double __erf (double ) ; +extern double erfc (double ) ; extern double __erfc (double ) ; +extern double lgamma (double ) ; extern double __lgamma (double ) ; +extern double tgamma (double ) ; extern double __tgamma (double ) ; + + + + +extern double gamma (double ) ; extern double __gamma (double ) ; + + + + + + +extern double lgamma_r (double , int *__signgamp) ; extern double __lgamma_r (double , int *__signgamp) ; + + + + + + +extern double rint (double __x) ; extern double __rint (double __x) ; + + +extern double nextafter (double __x, double __y) __attribute__ ( (__const__) ); extern double __nextafter (double __x, double __y) __attribute__ ( (__const__) ) ; + + + + + +extern double remainder (double __x, double __y) ; extern double __remainder (double __x, double __y) ; + + + +extern double scalb (double __x, double __n) ; extern double __scalb (double __x, double __n) ; + + + +extern double scalbn (double __x, int __n) ; extern double __scalbn (double __x, int __n) ; + + +extern int ilogb (double __x) ; extern int __ilogb (double __x) ; + + +# 330 "/usr/include/bits/mathcalls.h" 3 + +# 63 "/usr/include/math.h" 2 3 + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/mathcalls.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +extern float acosf (float __x) ; extern float __acosf (float __x) ; + +extern float asinf (float __x) ; extern float __asinf (float __x) ; + +extern float atanf (float __x) ; extern float __atanf (float __x) ; + +extern float atan2f (float __y, float __x) ; extern float __atan2f (float __y, float __x) ; + + +extern float cosf (float __x) ; extern float __cosf (float __x) ; + +extern float sinf (float __x) ; extern float __sinf (float __x) ; + +extern float tanf (float __x) ; extern float __tanf (float __x) ; + + + + + + + + + + +extern float coshf (float __x) ; extern float __coshf (float __x) ; + +extern float sinhf (float __x) ; extern float __sinhf (float __x) ; + +extern float tanhf (float __x) ; extern float __tanhf (float __x) ; + + + +extern float acoshf (float __x) ; extern float __acoshf (float __x) ; + +extern float asinhf (float __x) ; extern float __asinhf (float __x) ; + +extern float atanhf (float __x) ; extern float __atanhf (float __x) ; + + + + + +extern float expf (float __x) ; extern float __expf (float __x) ; + + + + + + + + + +extern float frexpf (float __x, int *__exponent) ; extern float __frexpf (float __x, int *__exponent) ; + + +extern float ldexpf (float __x, int __exponent) ; extern float __ldexpf (float __x, int __exponent) ; + + +extern float logf (float __x) ; extern float __logf (float __x) ; + + +extern float log10f (float __x) ; extern float __log10f (float __x) ; + + +extern float modff (float __x, float *__iptr) ; extern float __modff (float __x, float *__iptr) ; + + + +extern float expm1f (float __x) ; extern float __expm1f (float __x) ; + + +extern float log1pf (float __x) ; extern float __log1pf (float __x) ; + + +extern float logbf (float __x) ; extern float __logbf (float __x) ; + + + + + + + + + + + + + + +extern float powf (float __x, float __y) ; extern float __powf (float __x, float __y) ; + + +extern float sqrtf (float __x) ; extern float __sqrtf (float __x) ; + + + +extern float hypotf (float __x, float __y) ; extern float __hypotf (float __x, float __y) ; + + + + +extern float cbrtf (float __x) ; extern float __cbrtf (float __x) ; + + + + + + +extern float ceilf (float __x) ; extern float __ceilf (float __x) ; + + +extern float fabsf (float __x) __attribute__ ( (__const__) ); extern float __fabsf (float __x) __attribute__ ( (__const__) ) ; + + +extern float floorf (float __x) ; extern float __floorf (float __x) ; + + +extern float fmodf (float __x, float __y) ; extern float __fmodf (float __x, float __y) ; + + + + +extern int __isinff (float __value) __attribute__ ((__const__)); + + + + +extern int isinff (float __value) __attribute__ ((__const__)); + + +extern int finitef (float __value) __attribute__ ( (__const__) ); extern int __finitef (float __value) __attribute__ ( (__const__) ) ; + + + + + + + +extern float infnanf (int __error) __attribute__ ( (__const__) ); extern float __infnanf (int __error) __attribute__ ( (__const__) ) ; + + +extern float dremf (float __x, float __y) ; extern float __dremf (float __x, float __y) ; + + + +extern float significandf (float __x) ; extern float __significandf (float __x) ; + + + + +extern float copysignf (float __x, float __y) __attribute__ ( (__const__) ); extern float __copysignf (float __x, float __y) __attribute__ ( (__const__) ) ; + + + + + + + + + + +extern int isnanf (float __value) __attribute__ ( (__const__) ); extern int __isnanf (float __value) __attribute__ ( (__const__) ) ; + + +extern float j0f (float ) ; extern float __j0f (float ) ; +extern float j1f (float ) ; extern float __j1f (float ) ; +extern float jnf (int, float ) ; extern float __jnf (int, float ) ; +extern float y0f (float ) ; extern float __y0f (float ) ; +extern float y1f (float ) ; extern float __y1f (float ) ; +extern float ynf (int, float ) ; extern float __ynf (int, float ) ; + + + + + +extern float erff (float ) ; extern float __erff (float ) ; +extern float erfcf (float ) ; extern float __erfcf (float ) ; +extern float lgammaf (float ) ; extern float __lgammaf (float ) ; +extern float tgammaf (float ) ; extern float __tgammaf (float ) ; + + + + +extern float gammaf (float ) ; extern float __gammaf (float ) ; + + + + + + +extern float lgammaf_r (float , int *__signgamp) ; extern float __lgammaf_r (float , int *__signgamp) ; + + + + + + +extern float rintf (float __x) ; extern float __rintf (float __x) ; + + +extern float nextafterf (float __x, float __y) __attribute__ ( (__const__) ); extern float __nextafterf (float __x, float __y) __attribute__ ( (__const__) ) ; + + + + + +extern float remainderf (float __x, float __y) ; extern float __remainderf (float __x, float __y) ; + + + +extern float scalbf (float __x, float __n) ; extern float __scalbf (float __x, float __n) ; + + + +extern float scalbnf (float __x, int __n) ; extern float __scalbnf (float __x, int __n) ; + + +extern int ilogbf (float __x) ; extern int __ilogbf (float __x) ; + + +# 330 "/usr/include/bits/mathcalls.h" 3 + +# 82 "/usr/include/math.h" 2 3 + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/mathcalls.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +extern long double acosl (long double __x) ; extern long double __acosl (long double __x) ; + +extern long double asinl (long double __x) ; extern long double __asinl (long double __x) ; + +extern long double atanl (long double __x) ; extern long double __atanl (long double __x) ; + +extern long double atan2l (long double __y, long double __x) ; extern long double __atan2l (long double __y, long double __x) ; + + +extern long double cosl (long double __x) ; extern long double __cosl (long double __x) ; + +extern long double sinl (long double __x) ; extern long double __sinl (long double __x) ; + +extern long double tanl (long double __x) ; extern long double __tanl (long double __x) ; + + + + + + + + + + +extern long double coshl (long double __x) ; extern long double __coshl (long double __x) ; + +extern long double sinhl (long double __x) ; extern long double __sinhl (long double __x) ; + +extern long double tanhl (long double __x) ; extern long double __tanhl (long double __x) ; + + + +extern long double acoshl (long double __x) ; extern long double __acoshl (long double __x) ; + +extern long double asinhl (long double __x) ; extern long double __asinhl (long double __x) ; + +extern long double atanhl (long double __x) ; extern long double __atanhl (long double __x) ; + + + + + +extern long double expl (long double __x) ; extern long double __expl (long double __x) ; + + + + + + + + + +extern long double frexpl (long double __x, int *__exponent) ; extern long double __frexpl (long double __x, int *__exponent) ; + + +extern long double ldexpl (long double __x, int __exponent) ; extern long double __ldexpl (long double __x, int __exponent) ; + + +extern long double logl (long double __x) ; extern long double __logl (long double __x) ; + + +extern long double log10l (long double __x) ; extern long double __log10l (long double __x) ; + + +extern long double modfl (long double __x, long double *__iptr) ; extern long double __modfl (long double __x, long double *__iptr) ; + + + +extern long double expm1l (long double __x) ; extern long double __expm1l (long double __x) ; + + +extern long double log1pl (long double __x) ; extern long double __log1pl (long double __x) ; + + +extern long double logbl (long double __x) ; extern long double __logbl (long double __x) ; + + + + + + + + + + + + + + +extern long double powl (long double __x, long double __y) ; extern long double __powl (long double __x, long double __y) ; + + +extern long double sqrtl (long double __x) ; extern long double __sqrtl (long double __x) ; + + + +extern long double hypotl (long double __x, long double __y) ; extern long double __hypotl (long double __x, long double __y) ; + + + + +extern long double cbrtl (long double __x) ; extern long double __cbrtl (long double __x) ; + + + + + + +extern long double ceill (long double __x) ; extern long double __ceill (long double __x) ; + + +extern long double fabsl (long double __x) __attribute__ ( (__const__) ); extern long double __fabsl (long double __x) __attribute__ ( (__const__) ) ; + + +extern long double floorl (long double __x) ; extern long double __floorl (long double __x) ; + + +extern long double fmodl (long double __x, long double __y) ; extern long double __fmodl (long double __x, long double __y) ; + + + + +extern int __isinfl (long double __value) __attribute__ ((__const__)); + + + + +extern int isinfl (long double __value) __attribute__ ((__const__)); + + +extern int finitel (long double __value) __attribute__ ( (__const__) ); extern int __finitel (long double __value) __attribute__ ( (__const__) ) ; + + + + + + + +extern long double infnanl (int __error) __attribute__ ( (__const__) ); extern long double __infnanl (int __error) __attribute__ ( (__const__) ) ; + + +extern long double dreml (long double __x, long double __y) ; extern long double __dreml (long double __x, long double __y) ; + + + +extern long double significandl (long double __x) ; extern long double __significandl (long double __x) ; + + + + +extern long double copysignl (long double __x, long double __y) __attribute__ ( (__const__) ); extern long double __copysignl (long double __x, long double __y) __attribute__ ( (__const__) ) ; + + + + + + + + + + +extern int isnanl (long double __value) __attribute__ ( (__const__) ); extern int __isnanl (long double __value) __attribute__ ( (__const__) ) ; + + +extern long double j0l (long double ) ; extern long double __j0l (long double ) ; +extern long double j1l (long double ) ; extern long double __j1l (long double ) ; +extern long double jnl (int, long double ) ; extern long double __jnl (int, long double ) ; +extern long double y0l (long double ) ; extern long double __y0l (long double ) ; +extern long double y1l (long double ) ; extern long double __y1l (long double ) ; +extern long double ynl (int, long double ) ; extern long double __ynl (int, long double ) ; + + + + + +extern long double erfl (long double ) ; extern long double __erfl (long double ) ; +extern long double erfcl (long double ) ; extern long double __erfcl (long double ) ; +extern long double lgammal (long double ) ; extern long double __lgammal (long double ) ; +extern long double tgammal (long double ) ; extern long double __tgammal (long double ) ; + + + + +extern long double gammal (long double ) ; extern long double __gammal (long double ) ; + + + + + + +extern long double lgammal_r (long double , int *__signgamp) ; extern long double __lgammal_r (long double , int *__signgamp) ; + + + + + + +extern long double rintl (long double __x) ; extern long double __rintl (long double __x) ; + + +extern long double nextafterl (long double __x, long double __y) __attribute__ ( (__const__) ); extern long double __nextafterl (long double __x, long double __y) __attribute__ ( (__const__) ) ; + + + + + +extern long double remainderl (long double __x, long double __y) ; extern long double __remainderl (long double __x, long double __y) ; + + + +extern long double scalbl (long double __x, long double __n) ; extern long double __scalbl (long double __x, long double __n) ; + + + +extern long double scalbnl (long double __x, int __n) ; extern long double __scalbnl (long double __x, int __n) ; + + +extern int ilogbl (long double __x) ; extern int __ilogbl (long double __x) ; + + +# 330 "/usr/include/bits/mathcalls.h" 3 + +# 99 "/usr/include/math.h" 2 3 + + + + + + + + + + + + + + +extern int signgam; + + + + +# 232 "/usr/include/math.h" 3 + + + + +typedef enum +{ + _IEEE_ = -1, + _SVID_, + _XOPEN_, + _POSIX_, + _ISOC_ +} _LIB_VERSION_TYPE; + + + + +extern _LIB_VERSION_TYPE _LIB_VERSION; + + + + + + + + + + + + +struct exception + + { + int type; + char *name; + double arg1; + double arg2; + double retval; + }; + + + + +extern int matherr (struct exception *__exc) ; + + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/float.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +union __convert_long_double { + unsigned __convert_long_double_i[4]; + long double __convert_long_double_d; +}; + + + + + + + + + + + + + + + + + + + + + + +# 289 "/usr/include/math.h" 2 3 + + +# 299 "/usr/include/math.h" 3 + + + + + + + + + + + + + + + + + + + + + + + +# 336 "/usr/include/math.h" 3 + + + + + + + + + + + + + + + + +# 407 "/usr/include/math.h" 3 + + + + + + +# 67 "port.h" 2 + +# 1 "/usr/include/signal.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/sigset.h" 1 3 + + + + + + + + + + + + + + + + + + + +# 33 "/usr/include/bits/sigset.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 97 "/usr/include/bits/sigset.h" 3 + + + + + + +extern int __sigismember (__const __sigset_t *, int); +extern int __sigaddset (__sigset_t *, int); +extern int __sigdelset (__sigset_t *, int); + +# 122 "/usr/include/bits/sigset.h" 3 + + + + +# 33 "/usr/include/signal.h" 2 3 + + + + + + + + +typedef __sig_atomic_t sig_atomic_t; + + + + + + + +typedef __sigset_t sigset_t; + + + + + + +# 1 "/usr/include/bits/signum.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 56 "/usr/include/signal.h" 2 3 + + + + + + + + + +typedef void (*__sighandler_t) (int) ; + + + + +extern __sighandler_t __sysv_signal (int __sig, + __sighandler_t __handler) ; + + + + + + + + +extern __sighandler_t signal (int __sig, __sighandler_t __handler) ; +# 90 "/usr/include/signal.h" 3 + + + + + + + + + + + + +extern int kill (__pid_t __pid, int __sig) ; + + + + + + +extern int killpg (__pid_t __pgrp, int __sig) ; + + + +extern int raise (int __sig) ; + + + +extern __sighandler_t ssignal (int __sig, __sighandler_t __handler) ; +extern int gsignal (int __sig) ; + + + + +extern void psignal (int __sig, __const char *__s) ; + + + + + + + + +extern int __sigpause (int __sig_or_mask, int __is_sig) ; + + + + +extern int sigpause (int __mask) ; + + + + + + + + + + + + + + + + + + + +extern int sigblock (int __mask) ; + + +extern int sigsetmask (int __mask) ; + + +extern int siggetmask (void) ; + + + + + + + + + + + + + +typedef __sighandler_t sig_t; + + + + + + + +# 1 "/usr/include/time.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 51 "/usr/include/time.h" 3 + + + +# 62 "/usr/include/time.h" 3 + + + +# 73 "/usr/include/time.h" 3 + + + + +# 89 "/usr/include/time.h" 3 + + + + +# 279 "/usr/include/time.h" 3 + + + +# 185 "/usr/include/signal.h" 2 3 + + + +# 1 "/usr/include/bits/siginfo.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef union sigval + { + int sival_int; + void *sival_ptr; + } sigval_t; + + + + +typedef struct siginfo + { + int si_signo; + int si_errno; + + int si_code; + + union + { + int _pad[((128 / sizeof (int)) - 3) ]; + + + struct + { + __pid_t si_pid; + __uid_t si_uid; + } _kill; + + + struct + { + unsigned int _timer1; + unsigned int _timer2; + } _timer; + + + struct + { + __pid_t si_pid; + __uid_t si_uid; + sigval_t si_sigval; + } _rt; + + + struct + { + __pid_t si_pid; + __uid_t si_uid; + int si_status; + __clock_t si_utime; + __clock_t si_stime; + } _sigchld; + + + struct + { + void *si_addr; + } _sigfault; + + + struct + { + int si_band; + int si_fd; + } _sigpoll; + } _sifields; + } siginfo_t; + + + + + + + + + + + + + + + + + + +enum +{ + SI_SIGIO = -5, + + SI_ASYNCIO, + + SI_MESGQ, + + SI_TIMER, + + SI_QUEUE, + + SI_USER + +}; + + + +enum +{ + ILL_ILLOPC = 1, + + ILL_ILLOPN, + + ILL_ILLADR, + + ILL_ILLTRP, + + ILL_PRVOPC, + + ILL_PRVREG, + + ILL_COPROC, + + ILL_BADSTK + +}; + + +enum +{ + FPE_INTDIV = 1, + + FPE_INTOVF, + + FPE_FLTDIV, + + FPE_FLTOVF, + + FPE_FLTUND, + + FPE_FLTRES, + + FPE_FLTINV, + + FPE_FLTSUB + +}; + + +enum +{ + SEGV_MAPERR = 1, + + SEGV_ACCERR + +}; + + +enum +{ + BUS_ADRALN = 1, + + BUS_ADRERR, + + BUS_OBJERR + +}; + + +enum +{ + TRAP_BRKPT = 1, + + TRAP_TRACE + +}; + + +enum +{ + CLD_EXITED = 1, + + CLD_KILLED, + + CLD_DUMPED, + + CLD_TRAPPED, + + CLD_STOPPED, + + CLD_CONTINUED + +}; + + +enum +{ + POLL_IN = 1, + + POLL_OUT, + + POLL_MSG, + + POLL_ERR, + + POLL_PRI, + + POLL_HUP + +}; + + + + + + + + + + + + +typedef struct sigevent + { + sigval_t sigev_value; + int sigev_signo; + int sigev_notify; + + union + { + int _pad[((64 / sizeof (int)) - 3) ]; + + struct + { + void (*_function) (sigval_t) ; + void *_attribute; + } _sigev_thread; + } _sigev_un; + } sigevent_t; + + + + + + +enum +{ + SIGEV_SIGNAL = 0, + + SIGEV_NONE, + + SIGEV_THREAD + +}; + + +# 188 "/usr/include/signal.h" 2 3 + + + + +extern int sigemptyset (sigset_t *__set) ; + + +extern int sigfillset (sigset_t *__set) ; + + +extern int sigaddset (sigset_t *__set, int __signo) ; + + +extern int sigdelset (sigset_t *__set, int __signo) ; + + +extern int sigismember (__const sigset_t *__set, int __signo) ; + +# 217 "/usr/include/signal.h" 3 + + + + +# 1 "/usr/include/bits/sigaction.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + +struct sigaction + { + + + union + { + + __sighandler_t sa_handler; + + void (*sa_sigaction) (int, siginfo_t *, void *) ; + } + __sigaction_handler; + + + + + + + + __sigset_t sa_mask; + + + int sa_flags; + + + void (*sa_restorer) (void) ; + }; + + + + + + + + + + + + + + + + + + + + + + + + + +# 221 "/usr/include/signal.h" 2 3 + + + +extern int sigprocmask (int __how, + __const sigset_t *__set, sigset_t *__oset) ; + + + +extern int sigsuspend (__const sigset_t *__set) ; + + +extern int __sigaction (int __sig, __const struct sigaction *__act, + struct sigaction *__oact) ; +extern int sigaction (int __sig, __const struct sigaction *__act, + struct sigaction *__oact) ; + + +extern int sigpending (sigset_t *__set) ; + + + +extern int sigwait (__const sigset_t *__set, int *__sig) ; + + + +extern int sigwaitinfo (__const sigset_t *__set, siginfo_t *__info) ; + + + +extern int sigtimedwait (__const sigset_t *__set, siginfo_t *__info, + __const struct timespec *__timeout) ; + + + +extern int sigqueue (__pid_t __pid, int __sig, + __const union sigval __val) ; + + + + + + + + +extern __const char *__const _sys_siglist[64 ]; +extern __const char *__const sys_siglist[64 ]; + + +struct sigvec + { + __sighandler_t sv_handler; + int sv_mask; + + int sv_flags; + + }; + + + + + + + + + + + + +extern int sigvec (int __sig, __const struct sigvec *__vec, + struct sigvec *__ovec) ; + + + +# 1 "/usr/include/bits/sigcontext.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/asm/sigcontext.h" 1 3 + + + + + + + + + + + +struct _fpreg { + unsigned short significand[4]; + unsigned short exponent; +}; + +struct _fpstate { + unsigned long cw, + sw, + tag, + ipoff, + cssel, + dataoff, + datasel; + struct _fpreg _st[8]; + unsigned long status; +}; + +struct sigcontext { + unsigned short gs, __gsh; + unsigned short fs, __fsh; + unsigned short es, __esh; + unsigned short ds, __dsh; + unsigned long edi; + unsigned long esi; + unsigned long ebp; + unsigned long esp; + unsigned long ebx; + unsigned long edx; + unsigned long ecx; + unsigned long eax; + unsigned long trapno; + unsigned long err; + unsigned long eip; + unsigned short cs, __csh; + unsigned long eflags; + unsigned long esp_at_signal; + unsigned short ss, __ssh; + struct _fpstate * fpstate; + unsigned long oldmask; + unsigned long cr2; +}; + + + +# 28 "/usr/include/bits/sigcontext.h" 2 3 + + +# 294 "/usr/include/signal.h" 2 3 + + + +extern int sigreturn (struct sigcontext *__scp) ; + + + + + + + + + +extern int siginterrupt (int __sig, int __interrupt) ; + +# 1 "/usr/include/bits/sigstack.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + +struct sigstack + { + void * ss_sp; + int ss_onstack; + }; + + + +enum +{ + SS_ONSTACK = 1, + + SS_DISABLE + +}; + + + + + + + + + +typedef struct sigaltstack + { + void * ss_sp; + int ss_flags; + size_t ss_size; + } stack_t; +# 309 "/usr/include/signal.h" 2 3 + + + + + +extern int sigstack (__const struct sigstack *__ss, + struct sigstack *__oss) ; + + + +extern int sigaltstack (__const struct sigaltstack *__ss, + struct sigaltstack *__oss) ; + + + +# 342 "/usr/include/signal.h" 3 + + + + + + +extern int __libc_current_sigrtmin (void) ; + +extern int __libc_current_sigrtmax (void) ; + + + + + + +# 68 "port.h" 2 + + +# 80 "port.h" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 147 "port.h" + + + + + +# 1 "/usr/include/stdlib.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + +# 188 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + +# 269 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + +# 283 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 33 "/usr/include/stdlib.h" 2 3 + + + + + + + + +typedef struct + { + int quot; + int rem; + } div_t; + + + +typedef struct + { + long int quot; + long int rem; + } ldiv_t; + + + +# 65 "/usr/include/stdlib.h" 3 + + + + + + + + + + + + + + + +extern size_t __ctype_get_mb_cur_max (void) ; + + + +extern double atof (__const char *__nptr) ; + +extern int atoi (__const char *__nptr) ; + +extern long int atol (__const char *__nptr) ; + + + +__extension__ extern long long int atoll (__const char *__nptr) ; + + + +extern double strtod (__const char * __nptr, + char ** __endptr) ; + + + + + + + + + + + +extern long int strtol (__const char * __nptr, + char ** __endptr, int __base) ; + +extern unsigned long int strtoul (__const char * __nptr, + char ** __endptr, + int __base) ; + + + +__extension__ +extern long long int strtoq (__const char * __nptr, + char ** __endptr, int __base) ; + +__extension__ +extern unsigned long long int strtouq (__const char * __nptr, + char ** __endptr, + int __base) ; + + + + + + +__extension__ +extern long long int strtoll (__const char * __nptr, + char ** __endptr, int __base) ; + +__extension__ +extern unsigned long long int strtoull (__const char * __nptr, + char ** __endptr, + int __base) ; + + + +# 190 "/usr/include/stdlib.h" 3 + + + + + + +extern double __strtod_internal (__const char * __nptr, + char ** __endptr, + int __group) ; +extern float __strtof_internal (__const char * __nptr, + char ** __endptr, int __group) ; +extern long double __strtold_internal (__const char * + __nptr, + char ** __endptr, + int __group) ; + +extern long int __strtol_internal (__const char * __nptr, + char ** __endptr, + int __base, int __group) ; + + + +extern unsigned long int __strtoul_internal (__const char * + __nptr, + char ** __endptr, + int __base, int __group) ; + + + + +__extension__ +extern long long int __strtoll_internal (__const char * __nptr, + char ** __endptr, + int __base, int __group) ; + + + +__extension__ +extern unsigned long long int __strtoull_internal (__const char * + __nptr, + char ** + __endptr, + int __base, + int __group) ; + + + + +# 326 "/usr/include/stdlib.h" 3 + + + + + + + +extern char *l64a (long int __n) ; + + +extern long int a64l (__const char *__s) ; + + + + + + + + + +extern int32_t random (void) ; + + +extern void srandom (unsigned int __seed) ; + + + + + +extern void * initstate (unsigned int __seed, void * __statebuf, + size_t __statelen) ; + + + +extern void * setstate (void * __statebuf) ; + + + + + + + +struct random_data + { + int32_t *fptr; + int32_t *rptr; + int32_t *state; + int rand_type; + int rand_deg; + int rand_sep; + int32_t *end_ptr; + }; + +extern int random_r (struct random_data * __buf, + int32_t * __result) ; + +extern int srandom_r (unsigned int __seed, struct random_data *__buf) ; + +extern int initstate_r (unsigned int __seed, + void * __statebuf, + size_t __statelen, + struct random_data * __buf) ; + +extern int setstate_r (void * __statebuf, + struct random_data * __buf) ; + + + + + +extern int rand (void) ; + +extern void srand (unsigned int __seed) ; + + + +extern int rand_r (unsigned int *__seed) ; + + + + + + + +extern double drand48 (void) ; +extern double erand48 (unsigned short int __xsubi[3]) ; + + +extern long int lrand48 (void) ; +extern long int nrand48 (unsigned short int __xsubi[3]) ; + + +extern long int mrand48 (void) ; +extern long int jrand48 (unsigned short int __xsubi[3]) ; + + +extern void srand48 (long int __seedval) ; +extern unsigned short int *seed48 (unsigned short int __seed16v[3]) ; +extern void lcong48 (unsigned short int __param[7]) ; + + +struct drand48_data + { + unsigned short int x[3]; + unsigned short int a[3]; + unsigned short int c; + unsigned short int old_x[3]; + int init; + }; + + + +extern int drand48_r (struct drand48_data * __buffer, + double * __result) ; +extern int erand48_r (unsigned short int __xsubi[3], + struct drand48_data * __buffer, + double * __result) ; + + +extern int lrand48_r (struct drand48_data * __buffer, + long int * __result) ; +extern int nrand48_r (unsigned short int __xsubi[3], + struct drand48_data * __buffer, + long int * __result) ; + + +extern int mrand48_r (struct drand48_data * __buffer, + long int * __result) ; +extern int jrand48_r (unsigned short int __xsubi[3], + struct drand48_data * __buffer, + long int * __result) ; + + +extern int srand48_r (long int __seedval, struct drand48_data *__buffer) ; + +extern int seed48_r (unsigned short int __seed16v[3], + struct drand48_data *__buffer) ; + +extern int lcong48_r (unsigned short int __param[7], + struct drand48_data *__buffer) ; + + + + + + + + +extern void * malloc (size_t __size) ; + +extern void * calloc (size_t __nmemb, size_t __size) ; + + + + + +extern void * realloc (void * __ptr, size_t __size) ; + +extern void free (void * __ptr) ; + + + +extern void cfree (void * __ptr) ; + + + +# 1 "/usr/include/alloca.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + +# 188 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + +# 271 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + +# 283 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 25 "/usr/include/alloca.h" 2 3 + + + + + + + + +extern void * alloca (size_t __size) ; + + + + + + + + +# 492 "/usr/include/stdlib.h" 2 3 + + + + + +extern void * valloc (size_t __size) ; + + + + +extern void abort (void) __attribute__ ((__noreturn__)); + + + +extern int atexit (void (*__func) (void)) ; + + + + +extern int __on_exit (void (*__func) (int __status, void * __arg), + void * __arg) ; +extern int on_exit (void (*__func) (int __status, void * __arg), + void * __arg) ; + + + + + +extern void exit (int __status) __attribute__ ((__noreturn__)); + + + + + + + + + +extern char *getenv (__const char *__name) ; + + + +extern char *__secure_getenv (__const char *__name) ; + + + + + +extern int putenv (__const char *__string) ; + + + + + +extern int setenv (__const char *__name, __const char *__value, + int __replace) ; + + +extern void unsetenv (__const char *__name) ; + + + + + + +extern int clearenv (void) ; + + + + + + + + +extern char *mktemp (char *__template) ; + + + + + + +extern int mkstemp (char *__template) ; + + + + +extern int system (__const char *__command) ; + + + + + + + + + + + + + + + + +extern char *realpath (__const char * __name, + char * __resolved) ; + + + + + + +typedef int (*__compar_fn_t) (__const void * , __const void * ) ; + + + + + + + + +extern void * bsearch (__const void * __key, __const void * __base, + size_t __nmemb, size_t __size, + __compar_fn_t __compar) ; + + + +extern void qsort (void * __base, size_t __nmemb, size_t __size, + __compar_fn_t __compar) ; + + + +extern int abs (int __x) __attribute__ ((__const__)); +extern long int labs (long int __x) __attribute__ ((__const__)); + + + + + + + + + +extern div_t div (int __numer, int __denom) __attribute__ ((__const__)); +extern ldiv_t ldiv (long int __numer, long int __denom) + __attribute__ ((__const__)); + + + + + + + + + + + + + + +extern char *ecvt (double __value, int __ndigit, int * __decpt, + int * __sign) ; + + + + +extern char *fcvt (double __value, int __ndigit, int * __decpt, + int * __sign) ; + + + + +extern char *gcvt (double __value, int __ndigit, char *__buf) ; + + +extern char *qecvt (long double __value, int __ndigit, + int * __decpt, int * __sign) ; +extern char *qfcvt (long double __value, int __ndigit, + int * __decpt, int * __sign) ; +extern char *qgcvt (long double __value, int __ndigit, char *__buf) ; + + + + + +extern int ecvt_r (double __value, int __ndigit, int * __decpt, + int * __sign, char * __buf, + size_t __len) ; +extern int fcvt_r (double __value, int __ndigit, int * __decpt, + int * __sign, char * __buf, + size_t __len) ; + +extern int qecvt_r (long double __value, int __ndigit, + int * __decpt, int * __sign, + char * __buf, size_t __len) ; +extern int qfcvt_r (long double __value, int __ndigit, + int * __decpt, int * __sign, + char * __buf, size_t __len) ; + + + + + + +extern int mblen (__const char *__s, size_t __n) ; + + +extern int mbtowc (wchar_t * __pwc, + __const char * __s, size_t __n) ; + + +extern int wctomb (char *__s, wchar_t __wchar) ; + + + +extern size_t mbstowcs (wchar_t * __pwcs, + __const char * __s, size_t __n) ; + +extern size_t wcstombs (char * __s, + __const wchar_t * __pwcs, size_t __n) ; + + + + + + + +extern int rpmatch (__const char *__response) ; + + + +# 732 "/usr/include/stdlib.h" 3 + + + +# 756 "/usr/include/stdlib.h" 3 + + +# 766 "/usr/include/stdlib.h" 3 + + + + + + + + +# 152 "port.h" 2 + +# 175 "port.h" + + + + + +# 1 "/usr/include/string.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 1 3 + + + + + + + + + +# 19 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + +# 61 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 131 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + +# 188 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + +# 271 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + +# 283 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + +# 317 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/stddef.h" 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 33 "/usr/include/string.h" 2 3 + + + + +extern void * memcpy (void * __dest, + __const void * __src, size_t __n) ; + + +extern void * memmove (void * __dest, __const void * __src, + size_t __n) ; + + + + + +extern void * memccpy (void * __dest, __const void * __src, + int __c, size_t __n) ; + + + + +extern void * memset (void * __s, int __c, size_t __n) ; + + +extern int memcmp (__const void * __s1, __const void * __s2, + size_t __n) ; + + +extern void * memchr (__const void * __s, int __c, size_t __n) ; + + + + + + + + + +extern char *strcpy (char * __dest, + __const char * __src) ; + +extern char *strncpy (char * __dest, + __const char * __src, size_t __n) ; + + +extern char *strcat (char * __dest, + __const char * __src) ; + +extern char *strncat (char * __dest, + __const char * __src, size_t __n) ; + + +extern int strcmp (__const char *__s1, __const char *__s2) ; + +extern int strncmp (__const char *__s1, __const char *__s2, size_t __n) ; + + +extern int strcoll (__const char *__s1, __const char *__s2) ; + +extern size_t strxfrm (char * __dest, + __const char * __src, size_t __n) ; + +# 107 "/usr/include/string.h" 3 + + + + +extern char *__strdup (__const char *__s) ; +extern char *strdup (__const char *__s) ; + + + + + + + + + +# 143 "/usr/include/string.h" 3 + + + +extern char *strchr (__const char *__s, int __c) ; + +extern char *strrchr (__const char *__s, int __c) ; + + + + + + + + + +extern size_t strcspn (__const char *__s, __const char *__reject) ; + + +extern size_t strspn (__const char *__s, __const char *__accept) ; + +extern char *strpbrk (__const char *__s, __const char *__accept) ; + +extern char *strstr (__const char *__haystack, __const char *__needle) ; + + + + + + + + + + +extern char *strtok (char * __s, + __const char * __delim) ; + + + +extern char *__strtok_r (char * __s, + __const char * __delim, + char ** __save_ptr) ; + +extern char *strtok_r (char * __s, + __const char * __delim, + char ** __save_ptr) ; + + +# 203 "/usr/include/string.h" 3 + + + + +extern size_t strlen (__const char *__s) ; + + + + + + + + + +extern char *strerror (int __errnum) ; + + + +extern char *__strerror_r (int __errnum, char *__buf, size_t __buflen) ; +extern char *strerror_r (int __errnum, char *__buf, size_t __buflen) ; + + + + +extern void __bzero (void * __s, size_t __n) ; + + + +extern void bcopy (__const void * __src, void * __dest, size_t __n) ; + + +extern void bzero (void * __s, size_t __n) ; + + +extern int bcmp (__const void * __s1, __const void * __s2, size_t __n) ; + + +extern char *index (__const char *__s, int __c) ; + + +extern char *rindex (__const char *__s, int __c) ; + + + +extern int __ffs (int __i) __attribute__ ((const)); +extern int ffs (int __i) __attribute__ ((const)); + + + + + + + + + + + + +extern int __strcasecmp (__const char *__s1, __const char *__s2) ; +extern int strcasecmp (__const char *__s1, __const char *__s2) ; + + +extern int strncasecmp (__const char *__s1, __const char *__s2, + size_t __n) ; + + +# 277 "/usr/include/string.h" 3 + + + + + +extern char *strsep (char ** __stringp, + __const char * __delim) ; + + +# 319 "/usr/include/string.h" 3 + + + + +# 347 "/usr/include/string.h" 3 + + + + + + +# 180 "port.h" 2 + +# 192 "port.h" + + + + + + + + + + + + + + +extern void srandom(); + + + + + + + + + + +extern void sleep(); + + + + + + +# 1 "/usr/include/assert.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + +# 32 "/usr/include/assert.h" 3 + + + + + + + + + + +# 56 "/usr/include/assert.h" 3 + + + + + +extern void __assert_fail (__const char *__assertion, + __const char *__file, + unsigned int __line, + __const char *__function) + __attribute__ ((__noreturn__)); + + +extern void __assert_perror_fail (int __errnum, + __const char *__file, + unsigned int __line, + __const char *__function) + __attribute__ ((__noreturn__)); + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 224 "port.h" 2 + +# 238 "port.h" + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/limits.h" 1 3 + + + + + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/syslimits.h" 1 3 + + + + + + +# 1 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/limits.h" 1 3 + + + + + +# 114 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/limits.h" 3 + + + +# 1 "/usr/include/limits.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/posix1_lim.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/bits/local_lim.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "/usr/include/linux/limits.h" 1 3 + + + + + + + + + + + + + + + + + + + +# 27 "/usr/include/bits/local_lim.h" 2 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 126 "/usr/include/bits/posix1_lim.h" 2 3 + + + + + + + + + + + + + + + + +# 30 "/usr/include/limits.h" 2 3 + + + + +# 1 "/usr/include/bits/posix2_lim.h" 1 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 34 "/usr/include/limits.h" 2 3 + + + + + + + + + + + + + + + + +# 121 "/usr/include/limits.h" 3 + + + + + + + + + + + + + +# 117 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/limits.h" 2 3 + + + + +# 7 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/syslimits.h" 2 3 + + +# 11 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/limits.h" 2 3 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 107 "/usr/lib/gcc-lib/i386-slackware-linux/egcs-2.91.66/include/limits.h" 3 + + + + + + + + + + + + + + +# 243 "port.h" 2 + + + + + + + + + + + + +# 5 "espresso.h" 2 + +# 1 "utility.h" 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 1 "ansi.h" 1 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 42 "utility.h" 2 + + +extern long util_cpu_time + () ; +extern char *util_path_search + (char *program) ; +extern char *util_file_search + (char *file, char *path, char *mode) ; +extern int util_pipefork + (char **argv, FILE **toCommand, FILE **fromCommand, int *pid) ; +extern int util_csystem + (char *command) ; +extern char *util_print_time + (long t) ; +extern char *util_strsav + (char *ptr) ; +extern char *util_tilde_expand + (char *filename) ; +extern char *util_tilde_compress + (char *filename) ; +extern void util_register_user + (char *user, char *directory) ; + + + + + + + + + + + + + + + + + + + + + + + + + +# 6 "espresso.h" 2 + +# 1 "sparse.h" 1 + + + + + + + +typedef struct sm_element_struct sm_element; +typedef struct sm_row_struct sm_row; +typedef struct sm_col_struct sm_col; +typedef struct sm_matrix_struct sm_matrix; + + + + + +struct sm_element_struct { + int row_num; + int col_num; + sm_element *next_row; + sm_element *prev_row; + sm_element *next_col; + sm_element *prev_col; + char *user_word; +}; + + + + + +struct sm_row_struct { + int row_num; + int length; + int flag; + sm_element *first_col; + sm_element *last_col; + sm_row *next_row; + sm_row *prev_row; + char *user_word; +}; + + + + + +struct sm_col_struct { + int col_num; + int length; + int flag; + sm_element *first_row; + sm_element *last_row; + sm_col *next_col; + sm_col *prev_col; + char *user_word; +}; + + + + + +struct sm_matrix_struct { + sm_row **rows; + int rows_size; + sm_col **cols; + int cols_size; + sm_row *first_row; + sm_row *last_row; + int nrows; + sm_col *first_col; + sm_col *last_col; + int ncols; + char *user_word; +}; + + + + + + + + + + + + + + + + + + + + + + + + + + + + +extern sm_matrix *sm_alloc(), *sm_alloc_size(), *sm_dup(); +extern void sm_free(), sm_delrow(), sm_delcol(), sm_resize(); +extern void sm_write(), sm_print(), sm_dump(), sm_cleanup(); +extern void sm_copy_row(), sm_copy_col(); +extern void sm_remove(), sm_remove_element(); +extern sm_element *sm_insert(), *sm_find(); +extern sm_row *sm_longest_row(); +extern sm_col *sm_longest_col(); +extern int sm_read(), sm_read_compressed(); + +extern sm_row *sm_row_alloc(), *sm_row_dup(), *sm_row_and(); +extern void sm_row_free(), sm_row_remove(), sm_row_print(); +extern sm_element *sm_row_insert(), *sm_row_find(); +extern int sm_row_contains(), sm_row_intersects(); +extern int sm_row_compare(), sm_row_hash(); + +extern sm_col *sm_col_alloc(), *sm_col_dup(), *sm_col_and(); +extern void sm_col_free(), sm_col_remove(), sm_col_print(); +extern sm_element *sm_col_insert(), *sm_col_find(); +extern int sm_col_contains(), sm_col_intersects(); +extern int sm_col_compare(), sm_col_hash(); + +extern int sm_row_dominance(), sm_col_dominance(), sm_block_partition(); + + +# 7 "espresso.h" 2 + +# 1 "mincov.h" 1 + +extern sm_row *sm_minimum_cover(); +# 8 "espresso.h" 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +typedef unsigned int *pset; + + +typedef struct set_family { + int wsize; + int sf_size; + int capacity; + int count; + int active_count; + pset data; + struct set_family *next; +} set_family_t, *pset_family; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# 178 "espresso.h" + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +extern int bit_count[256]; + + + + + + + + + + + + + + + + + + + + +typedef struct cost_struct { + int cubes; + int in; + int out; + int mv; + int total; + int primes; +} cost_t, *pcost; + + + +typedef struct pair_struct { + int cnt; + int *var1; + int *var2; +} pair_t, *ppair; + + + +typedef struct symbolic_list_struct { + int variable; + int pos; + struct symbolic_list_struct *next; +} symbolic_list_t; + + + +typedef struct symbolic_label_struct { + char *label; + struct symbolic_label_struct *next; +} symbolic_label_t; + + + +typedef struct symbolic_struct { + symbolic_list_t *symbolic_list; + int symbolic_list_length; + symbolic_label_t *symbolic_label; + int symbolic_label_length; + struct symbolic_struct *next; +} symbolic_t; + + + +typedef struct { + pset_family F, D, R; + char *filename; + int pla_type; + pset phase; + ppair pair; + char **label; + symbolic_t *symbolic; + symbolic_t *symbolic_output; +} PLA_t, *pPLA; + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +extern unsigned int debug; +extern int verbose_debug; +extern char *total_name[16 ]; +extern long total_time[16 ]; +extern int total_calls[16 ]; + +extern int echo_comments; +extern int echo_unknown_commands; +extern int force_irredundant; +extern int skip_make_sparse; +extern int kiss; +extern int pos; +extern int print_solution; +extern int recompute_onset; +extern int remove_essential; +extern int single_expand; +extern int summary; +extern int trace; +extern int unwrap_onset; +extern int use_random_order; +extern int use_super_gasp; +extern char *filename; +extern int debug_exact_minimization; + + + + + +struct pla_types_struct { + char *key; + int value; +}; + + + + + + + + + + +struct cube_struct { + int size; + int num_vars; + int num_binary_vars; + int *first_part; + int *last_part; + int *part_size; + int *first_word; + int *last_word; + pset binary_mask; + pset mv_mask; + pset *var_mask; + pset *temp; + pset fullset; + pset emptyset; + unsigned int inmask; + int inword; + int *sparse; + int num_mv_vars; + int output; +}; + +struct cdata_struct { + int *part_zeros; + int *var_zeros; + int *parts_active; + int *is_unate; + int vars_active; + int vars_unate; + int best; +}; + + +extern struct pla_types_struct pla_types[]; +/*extern*/ struct cube_struct cube, temp_cube_save; +extern struct cdata_struct cdata, temp_cdata_save; + + + + + + + + + + + + + + extern int binate_split_select(); + extern pset_family cubeunlist(); + extern pset *cofactor(); + extern pset *cube1list(); + extern pset *cube2list(); + extern pset *cube3list(); + extern pset *scofactor(); + extern void massive_count(); + extern pset_family complement(); + extern pset_family simplify(); + extern void simp_comp(); + extern int d1_rm_equal(); + extern int rm2_contain(); + extern int rm2_equal(); + extern int rm_contain(); + extern int rm_equal(); + extern int rm_rev_contain(); + extern pset *sf_list(); + extern pset *sf_sort(); + extern pset_family d1merge(); + extern pset_family dist_merge(); + extern pset_family sf_contain(); + extern pset_family sf_dupl(); + extern pset_family sf_ind_contain(); + extern pset_family sf_ind_unlist(); + extern pset_family sf_merge(); + extern pset_family sf_rev_contain(); + extern pset_family sf_union(); + extern pset_family sf_unlist(); + extern void cube_setup(); + extern void restore_cube_struct(); + extern void save_cube_struct(); + extern void setdown_cube(); + extern PLA_labels(); + extern char *get_word(); + extern int label_index(); + extern int read_pla(); + extern int read_symbolic(); + extern pPLA new_PLA(); + extern void PLA_summary(); + extern void free_PLA(); + extern void parse_pla(); + extern void read_cube(); + extern void skip_line(); + extern foreach_output_function(); + extern int cubelist_partition(); + extern int so_both_do_espresso(); + extern int so_both_do_exact(); + extern int so_both_save(); + extern int so_do_espresso(); + extern int so_do_exact(); + extern int so_save(); + extern pset_family cof_output(); + extern pset_family lex_sort(); + extern pset_family mini_sort(); + extern pset_family random_order(); + extern pset_family size_sort(); + extern pset_family sort_reduce(); + extern pset_family uncof_output(); + extern pset_family unravel(); + extern pset_family unravel_range(); + extern void so_both_espresso(); + extern void so_espresso(); + extern char *fmt_cost(); + extern char *print_cost(); + extern char *strsav(); + extern void copy_cost(); + extern void cover_cost(); + extern void fatal(); + extern void print_trace(); + extern void size_stamp(); + extern void totals(); + extern char *fmt_cube(); + extern char *fmt_expanded_cube(); + extern char *pc1(); + extern char *pc2(); + extern char *pc3(); + extern int makeup_labels(); + extern kiss_output(); + extern kiss_print_cube(); + extern output_symbolic_constraints(); + extern void cprint(); + extern void debug1_print(); + extern void debug_print(); + extern void eqn_output(); + extern void fpr_header(); + extern void fprint_pla(); + extern void pls_group(); + extern void pls_label(); + extern void pls_output(); + extern void print_cube(); + extern void print_expanded_cube(); + extern void sf_debug_print(); + extern find_equiv_outputs(); + extern int check_equiv(); + extern pset_family espresso(); + extern int essen_cube(); + extern pset_family cb_consensus(); + extern pset_family cb_consensus_dist0(); + extern pset_family essential(); + extern pset_family minimize_exact(); + extern pset_family minimize_exact_literals(); + extern int feasibly_covered(); + extern int most_frequent(); + extern pset_family all_primes(); + extern pset_family expand(); + extern pset_family find_all_primes(); + extern void elim_lowering(); + extern void essen_parts(); + extern void essen_raising(); + extern void expand1(); + extern void mincov(); + extern void select_feasible(); + extern void setup_BB_CC(); + extern pset_family expand_gasp(); + extern pset_family irred_gasp(); + extern pset_family last_gasp(); + extern pset_family super_gasp(); + extern void expand1_gasp(); + extern int getopt(); + extern find_dc_inputs(); + extern find_inputs(); + extern form_bitvector(); + extern map_dcset(); + extern map_output_symbolic(); + extern map_symbolic(); + extern pset_family map_symbolic_cover(); + extern symbolic_hack_labels(); + extern int cube_is_covered(); + extern int taut_special_cases(); + extern int tautology(); + extern pset_family irredundant(); + extern void mark_irredundant(); + extern void irred_split_cover(); + extern sm_matrix *irred_derive_table(); + extern pset minterms(); + extern void explode(); + extern void map(); + extern output_phase_setup(); + extern pPLA set_phase(); + extern pset_family opo(); + extern pset find_phase(); + extern pset_family find_covers(); + extern pset_family form_cover_table(); + extern pset_family opo_leaf(); + extern pset_family opo_recur(); + extern void opoall(); + extern void phase_assignment(); + extern void repeated_phase_assignment(); + extern generate_all_pairs(); + extern int **find_pairing_cost(); + extern int find_best_cost(); + extern int greedy_best_cost(); + extern int minimize_pair(); + extern int pair_free(); + extern pair_all(); + extern pset_family delvar(); + extern pset_family pairvar(); + extern ppair pair_best_cost(); + extern ppair pair_new(); + extern ppair pair_save(); + extern print_pair(); + extern void find_optimal_pairing(); + extern void set_pair(); + extern void set_pair1(); + extern pset_family primes_consensus(); + extern int sccc_special_cases(); + extern pset_family reduce(); + extern pset reduce_cube(); + extern pset sccc(); + extern pset sccc_cube(); + extern pset sccc_merge(); + extern int set_andp(); + extern int set_orp(); + extern int setp_disjoint(); + extern int setp_empty(); + extern int setp_equal(); + extern int setp_full(); + extern int setp_implies(); + extern char *pbv1(); + extern char *ps1(); + extern int *sf_count(); + extern int *sf_count_restricted(); + extern int bit_index(); + extern int set_dist(); + extern int set_ord(); + extern void set_adjcnt(); + extern pset set_and(); + extern pset set_clear(); + extern pset set_copy(); + extern pset set_diff(); + extern pset set_fill(); + extern pset set_merge(); + extern pset set_or(); + extern pset set_xor(); + extern pset sf_and(); + extern pset sf_or(); + extern pset_family sf_active(); + extern pset_family sf_addcol(); + extern pset_family sf_addset(); + extern pset_family sf_append(); + extern pset_family sf_bm_read(); + extern pset_family sf_compress(); + extern pset_family sf_copy(); + extern pset_family sf_copy_col(); + extern pset_family sf_delc(); + extern pset_family sf_delcol(); + extern pset_family sf_inactive(); + extern pset_family sf_join(); + extern pset_family sf_new(); + extern pset_family sf_permute(); + extern pset_family sf_read(); + extern pset_family sf_save(); + extern pset_family sf_transpose(); + extern void set_write(); + extern void sf_bm_print(); + extern void sf_cleanup(); + extern void sf_delset(); + extern void sf_free(); + extern void sf_print(); + extern void sf_write(); + extern int ccommon(); + extern int cdist0(); + extern int full_row(); + extern int ascend(); + extern int cactive(); + extern int cdist(); + extern int cdist01(); + extern int cvolume(); + extern int d1_order(); + extern int d1_order_size(); + extern int desc1(); + extern int descend(); + extern int lex_order(); + extern int lex_order1(); + extern pset force_lower(); + extern void consensus(); + extern pset_family cb1_dsharp(); + extern pset_family cb_dsharp(); + extern pset_family cb_recur_dsharp(); + extern pset_family cb_recur_sharp(); + extern pset_family cb_sharp(); + extern pset_family cv_dsharp(); + extern pset_family cv_intersect(); + extern pset_family cv_sharp(); + extern pset_family dsharp(); + extern pset_family make_disjoint(); + extern pset_family sharp(); + pset do_sm_minimum_cover(); + extern pset_family make_sparse(); + extern pset_family mv_reduce(); + + extern qst(); + extern pset_family find_all_minimal_covers_petrick(); + extern pset_family map_cover_to_unate(); + extern pset_family map_unate_to_cover(); + extern pset_family exact_minimum_cover(); + extern pset_family gen_primes(); + extern pset_family unate_compl(); + extern pset_family unate_complement(); + extern pset_family unate_intersect(); + extern PLA_permute(); + extern int PLA_verify(); + extern int check_consistency(); + extern int verify(); +# 1 "cof.c" 2 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +pset *cofactor(T, c) + pset *T; + register pset c; +{ + pset temp = cube.temp[0], *Tc_save, *Tc, *T1; + register pset p; + int listlen; + + +# 49 "cof.c" + + + + for(T1 = T+2; (p = *T1++) != ((void *)0) ; ) { + if (p != c) { + + + { + register int w, last; + register unsigned int x; + + if ((last=cube.inword) != -1) { + x = p[last] & c[last]; + if (~(x|x>>1) & cube.inmask) + goto false; + for (w=1;w>1) & 0x55555555 ) + goto false; + } + } + } + + { + register int w, var, last; + register pset mask; + + for (var=cube.num_binary_vars; var // strlen + +// first declare the fn +static int foo(char const *a, char const *b); + +// now define it using old-style args +static int foo(a, b) + #if 0 + char const *a, *b; // looks like we're not associating 'const' with 'b'? + #else + char const *a; // actually, this fails too.. + char const *b; + #endif +{ + return strlen(a) + strlen(b); +} + +int main() +{ + return foo("aa", "bbb") - 5; +} diff --git a/cil/test/small2/constfold.c b/cil/test/small2/constfold.c new file mode 100644 index 0000000..97388da --- /dev/null +++ b/cil/test/small2/constfold.c @@ -0,0 +1,22 @@ +// constfold.c +// problem with ijpeg and power constant folding + +double sqrt(double x) +{ + return x*x; // close enough for parsing testing +} + +int main() +{ + { + float z10, z5, tmp12; + tmp12 = (float )(- 2.613125930) * z10 + z5; // ijpeg + } + + { + double a,b,c,root; + root = (-b-sqrt(b*b-4*a*c))/(2*a); // power + } + + return 0; +} diff --git a/cil/test/small2/constfold2.c b/cil/test/small2/constfold2.c new file mode 100755 index 0000000..62c8953 --- /dev/null +++ b/cil/test/small2/constfold2.c @@ -0,0 +1,23 @@ + + +enum foo { + e0 = sizeof(int), + e1, + e2 = e0 + 1 +}; + +int useenum(enum foo x) { + switch(x) { + case e1: return 0; + case e2 * 2: return 1; + case sizeof(int): return 2; + + } +} + +TESTDEF "enum1" : success ~ case +sizeof *\( *int *\) +TESTDEF "enum2" : success ~ e2 *\* *2 +TESTDEF "enum3" : success ~ e0 *\+ *1 +int main() { + return 0; +} diff --git a/cil/test/small2/ctype.c b/cil/test/small2/ctype.c new file mode 100644 index 0000000..844c2ed --- /dev/null +++ b/cil/test/small2/ctype.c @@ -0,0 +1,22 @@ +// test ctype functions + +#include // various +#include // printf + +void analyze(int ch) +{ + printf("character: %c\n", ch); + printf(" decimal: %d\n", ch); + printf(" isalpha: %d\n", !!isalpha(ch)); + printf(" isdigit: %d\n", !!isdigit(ch)); +} + +int main() +{ + analyze('a'); + analyze('5'); + analyze('$'); + analyze('Z'); + return 0; +} + diff --git a/cil/test/small2/debug_table.c b/cil/test/small2/debug_table.c new file mode 100644 index 0000000..f245b33 --- /dev/null +++ b/cil/test/small2/debug_table.c @@ -0,0 +1,24 @@ +struct Foo { + char *name; + int value; +}; +struct Foo debug_table[] = { + { "", 0x0004 + 0x0002 + 0x0020 + 0x0040 + 0x0100 + 0x0010 + 0x2000 + 0x0800 }, + { "compl", 0x0001 , },{ "essen", 0x0002 }, + { "expand", 0x0004 , },{ "expand1", 0x0008 | 0x0004 }, + { "irred", 0x0020 , },{ "irred1", 0x4000 | 0x0020 }, + { "reduce", 0x0040 , },{ "reduce1", 0x0080 | 0x0040 }, + { "mincov", 0x0800 , },{ "mincov1", 0x1000 | 0x0800 }, + { "sparse", 0x0100 , },{ "sharp", 0x2000 }, + { "taut", 0x0200 , },{ "gasp", 0x0010 }, + { "exact", 0x0400 }, + { 0 }, +}; + +unsigned int debug; + +int main() +{ + debug = debug_table[0].value; + return 0; +} diff --git a/cil/test/small2/ehstack.c b/cil/test/small2/ehstack.c new file mode 100644 index 0000000..054a827 --- /dev/null +++ b/cil/test/small2/ehstack.c @@ -0,0 +1,43 @@ +// ehstack.c +// NUMERRORS 1 +// build a small exception-handling stack, verify field annotation works + +#ifndef CCURED + #define __MAYPOINTTOSTACK +#endif + +struct Entry { + struct Entry *next __MAYPOINTTOSTACK; + int *otherPointer; // not allowed to point at stack + int x; +}; + +int *somePtr; + +//matth: making e1 global so ERROR(1) below fails. +struct Entry e1; + +int function(int argc, char **argv) +{ + //matth: if e1 is local, there's nothing wrong with storing &e2.x in it. + struct Entry /*e1,*/ e2; + int *wildGuy; + + // make everybody wild + wildGuy = (int*)&somePtr; + wildGuy = (int*)&e1; + wildGuy = (int*)&e2; + + // I want to allow this + e1.next = &e2; + + // but not this + e1.otherPointer = &e2.x; // ERROR(1): Storing stack address + + return 0; +} + + +int main(int argc, char **argv) { + function(argc, argv); +} diff --git a/cil/test/small2/enumattr.c b/cil/test/small2/enumattr.c new file mode 100644 index 0000000..1aa3eb4 --- /dev/null +++ b/cil/test/small2/enumattr.c @@ -0,0 +1,13 @@ +// enumattr.c +// enums with attributes + +typedef enum { + x = 256 +} __attribute__((__packed__)) large_enum; + +large_enum enum_l = x; + +int main() +{ + return 0; +} diff --git a/cil/test/small2/enumerator_sizeof.c b/cil/test/small2/enumerator_sizeof.c new file mode 100644 index 0000000..00298e6 --- /dev/null +++ b/cil/test/small2/enumerator_sizeof.c @@ -0,0 +1,31 @@ +// enumerator_sizeof.c +// an example from the CIL docs, this is an enumeration +// where one of the enumerators is a sizeof expression + +#include // assert + +enum { + FIVE = 5, + SIX, SEVEN, + FOUR = FIVE - 1, + EIGHT = sizeof(double) +}; + +int main() +{ + // store the enumerator values in an array, so the + // optimizer won't get too clever + int n[10], i; + n[4] = FOUR; + n[5] = FIVE; + n[6] = SIX; + n[7] = SEVEN; + n[8] = EIGHT; + + for (i=4; i<=8; i++) { + assert(i == n[i]); + } + + return 0; +} + diff --git a/cil/test/small2/enuminit.c b/cil/test/small2/enuminit.c new file mode 100644 index 0000000..5580d4b --- /dev/null +++ b/cil/test/small2/enuminit.c @@ -0,0 +1,27 @@ +// enums where one tag is init'd with another + +int printf(char const *fmt, ...); + +// this was messing up the parser +enum __rlimit_resource { + _RLIMIT_CPU = 0, + RLIMIT_CPU = _RLIMIT_CPU, + _RLIMIT_FSIZE = 1, + RLIMIT_FSIZE = _RLIMIT_FSIZE, + _RLIMIT_DATA = 2, + RLIMIT_DATA = _RLIMIT_DATA, +}; + +#define PVAL(val) printf(#val " = %d\n", val) + +int main() +{ + printf("whazzup?!\n"); + PVAL(_RLIMIT_CPU); + PVAL(RLIMIT_CPU); + PVAL(_RLIMIT_FSIZE); + PVAL(RLIMIT_FSIZE); + PVAL(_RLIMIT_DATA); + PVAL(RLIMIT_DATA); + return 0; +} diff --git a/cil/test/small2/enuminit2.c b/cil/test/small2/enuminit2.c new file mode 100644 index 0000000..6f1a0a5 --- /dev/null +++ b/cil/test/small2/enuminit2.c @@ -0,0 +1,18 @@ +// enuminit2.c +// from sac at stevechamberlain dot com + +// some weird expression kinds for enums + +// NUMERRORS 1 + +// should fail +enum {x = 3.0 }; // ERROR(1) + +// should pass +struct a { int j:' ';} p; + + +int main() +{ + return 0; +} diff --git a/cil/test/small2/errorinfn.c b/cil/test/small2/errorinfn.c new file mode 100644 index 0000000..76dc1e7 --- /dev/null +++ b/cil/test/small2/errorinfn.c @@ -0,0 +1,5 @@ + +int main () { + char c[8] = "an error!"; + return c[0] - 'a' + c[7] - 'r'; +} diff --git a/cil/test/small2/extinline.c b/cil/test/small2/extinline.c new file mode 100755 index 0000000..ff716f2 --- /dev/null +++ b/cil/test/small2/extinline.c @@ -0,0 +1,36 @@ +//Here is code that might be generated by CIL. Test that +//when reading it back in, the suffix __extinline doesn't cause problems. + +//This bug comes up when merging Apache. + +//Make sure the test runs without changes: +//KEEP baseline: success + +__inline static int identity__extinline(int x) { + return x; +} + +int foo(int x) { + return identity__extinline(x); +} + +//But what if there's another extern inline function called identity, +// that we want to rename to identity__extinline? +//Make sure we report an error in this case +inline extern int identity(int x) { //KEEP bad: error = Trying to rename + return 10; //KEEP bad +} //KEEP bad +int bar(x) { return identity(x); } //KEEP bad + +int identity(int x); +int identity(int x) { + return x+2; +} + + +int main(int *p, char** argv) +{ + return identity(-2) + foo(0); +} + + diff --git a/cil/test/small2/fig1.c b/cil/test/small2/fig1.c new file mode 100644 index 0000000..568d2ca --- /dev/null +++ b/cil/test/small2/fig1.c @@ -0,0 +1,40 @@ +// fig1.c +// program in our paper, figure 1 + +#include // printf +#include // malloc + +int **getArray() +{ + int **a = (int**)malloc(100 * sizeof(*a)); + int i; + + for (i=0; i<100; i++) { + a[i] = (int*) (((i+1) << 1) | 1); // for the moment, no boxing + } + + return a; +} + + +int main() +{ + int **a = getArray(); + int i; + int acc; + int **p; + int *e; + + acc = 0; + for (i=0; i<100; i++) { + p = a + i; + e = *p; + while ((int)e % 2 == 0) { + e = *(int**)e; + } + acc += ((int)e >> 1); + } + + printf("acc is %d\n", acc); // should be 5050 + return 0; +} diff --git a/cil/test/small2/fmtstr.c b/cil/test/small2/fmtstr.c new file mode 100644 index 0000000..82be013 --- /dev/null +++ b/cil/test/small2/fmtstr.c @@ -0,0 +1,11 @@ +// fmtstr.c +// demonstrate a format-string bug + +#include + +int main() +{ + char *s = "%d -- bad!\n"; + printf(s); + return 0; +} diff --git a/cil/test/small2/fseq1fail.c b/cil/test/small2/fseq1fail.c new file mode 100644 index 0000000..84bb6b4 --- /dev/null +++ b/cil/test/small2/fseq1fail.c @@ -0,0 +1,59 @@ +#include "../small1/testharness.h" + +// NUMERRORS 4 + +int one; // Just to hide the arithemtic from CCured + +typedef struct { int i1, i2; } two_int; + +two_int g; + +// Tests for FSEQ and FSEQN +#ifdef ERROR == 0 + #define P_KIND __FSEQ +#elif ERROR == 1 + #define P_KIND __FSEQ +#elif ERROR == 2 + #define P_KIND __FSEQN +#elif ERROR == 3 + #define P_KIND __SEQ +#else + #define P_KIND __SEQN +#endif + +// Converts without seeing in +int * P_KIND safeToSeq(two_int * __SAFE in) { + // Will convert to { in, in + 8bytes }, if the bug is present + // It should check first that in is non ZERO + return (int*)in; +} + + +int test_fseq() { + int *f = safeToSeq(&g); + int dummy = f[one]; // Make sure f is FSEQ +#if ERROR >= 3 + int dummy2 = *(f + one); // Make it SEQ +#endif + // Now use the same function to convert the number 0 + // The bug is that we return the pointer {0, 8} + // Bad cannot be SAFE of else we'll fail the Non-pointer test + int * P_KIND bad = safeToSeq(0); + // We can increment bad and read + // ERROR(1):Non-pointer + // ERROR(2):Non-pointer + // ERROR(3):Non-pointer + // ERROR(4):Non-pointer +#if ERROR > 0 + int res = bad[1]; +#endif + return 0; +} + + +int main() { + one = 1; + test_fseq(); + SUCCESS; +} + diff --git a/cil/test/small2/funcname.c b/cil/test/small2/funcname.c new file mode 100644 index 0000000..13e24ad --- /dev/null +++ b/cil/test/small2/funcname.c @@ -0,0 +1,18 @@ +extern void exit(int); +extern int strcmp(const char*, const char*); +extern int printf(const char*, ...); + +//Note that the concatenation in the strcmp arguments doesn't work on gcc4. +//Maybe __FUNCTION__ is no longer considered a literal?? + +int main(void) { + + printf("__FUNCTION__ = %s\n", __FUNCTION__); + printf("__PRETTY_FUNCTION__ = %s\n", __PRETTY_FUNCTION__); + + if(strcmp("This is " __FUNCTION__, "This is main") || + strcmp("This is " __PRETTY_FUNCTION__, "This is main")) { + exit(1); + } + exit(0); +} diff --git a/cil/test/small2/funcptr.c b/cil/test/small2/funcptr.c new file mode 100644 index 0000000..cec7012 --- /dev/null +++ b/cil/test/small2/funcptr.c @@ -0,0 +1,66 @@ +// testing function ptrs etc + +#include // malloc/free +#include // printf + +struct S { + int ix; + int *py; +}; + +// gratuitously incompatible with S +struct T { + int *px; + int iy; +}; + +typedef int (*acceptsS)(struct S *ps, int a); + +int multXbyY(struct S *ps, int a) +{ + printf("in multXbyY, a is %d\n", a); + return ps->ix * (* (ps->py) ) + a; +} + +int zero = 0; // hide a literal from CCured + +int doSomethingToS(struct S *ps, acceptsS func) +{ + struct S *wildptr = ps; + + printf("in doSomethingToS\n"); + + // make wildptr be wild + if (zero) { + struct T *pt = (struct T*)malloc(sizeof(*pt)); + pt->px = (int*)malloc(sizeof(* (pt->px) )); + *(pt->px) = 3; + pt->iy = 13; + + wildptr = (struct S*)pt; + } + + // wildptr is wild, and func's type has been changed to appear + // to accept a wild pointer, but it still points to 'multXbyY', + // which has been inferred to accept a safe ptr; therefore, instead + // of '9' being passed as the 2nd arg, 'multXbyY' sees wildptr's _b + // field as its 'a' arg + printf("calling func with a=%d\n", 9); + return func(wildptr, 9); +} + +int main() +{ + struct S *ps = (struct S*)malloc(sizeof(*ps)); + int ret; + + ps->ix = 8; + ps->py = (int*)malloc(sizeof(* (ps->py) )); + *(ps->py) = 9; + ret = doSomethingToS(ps, multXbyY) - 81; + + free(ps); + + printf("returning %d from main\n", ret); + return ret; +} diff --git a/cil/test/small2/funcptr2.c b/cil/test/small2/funcptr2.c new file mode 100644 index 0000000..072e8f7 --- /dev/null +++ b/cil/test/small2/funcptr2.c @@ -0,0 +1,67 @@ +// testing function ptrs etc + +#include // malloc/free +#include // printf + +struct S { + int ix; + int *py; +}; + +// gratuitously incompatible with S +struct T { + int *px; + int iy; +}; + +struct Func { + struct S* (*returnsS)(int a); +}; + +struct Func *makeFunc(struct S* (*func)()) +{ + struct Func *f = (struct Func*)malloc(sizeof(*f)); + f->returnsS = func; + return f; +} + +struct S* makeAnS(int a) +{ + struct S *ret = (struct S*)malloc(sizeof(*ret)); + ret->ix = a; + ret->py = NULL; + printf("returning %p\n", ret); + return ret; +} + +int zero = 0; + +int doSomethingToS(struct Func *func, int a) +{ + struct S *wildptr; + + wildptr = (*(func->returnsS))(a); + + printf("got back %p\n", wildptr); + + // make wildptr be wild + if (zero) { + struct T *pt = (struct T*)malloc(sizeof(*pt)); + pt->px = (int*)malloc(sizeof(* (pt->px) )); + *(pt->px) = 3; + pt->iy = 13; + + wildptr = (struct S*)pt; + } + + return 0; +} + +struct Func f; + +int main() +{ + return doSomethingToS(makeFunc(makeAnS), 4); + // ^^^^^^^ + // this argument is the wrong type, but silently accepted! +} diff --git a/cil/test/small2/funptr1.c b/cil/test/small2/funptr1.c new file mode 100644 index 0000000..ff73aa1 --- /dev/null +++ b/cil/test/small2/funptr1.c @@ -0,0 +1,18 @@ +/* This exhibits a bug with the types of tagged functions whose arguments + * appear tagged */ +int foo(int x); + +struct S { + void (*fptr)(); +} g = { &foo }; + +int main() { + // Make g (and thus foo) TAGGED + int *pg = (int*)&g; +} + +int foo(int arg) { + // Now take the address of x and make it tagged + int **px = &arg; + return arg; +} diff --git a/cil/test/small2/gimpdouble.c b/cil/test/small2/gimpdouble.c new file mode 100644 index 0000000..25ed040 --- /dev/null +++ b/cil/test/small2/gimpdouble.c @@ -0,0 +1,19 @@ +// gimpdouble.c +// examples of gimp's usage of doubles and enums + +typedef enum { + ZERO, + ONE +} Something; + +int main() +{ + double d; + Something s; + + d = ZERO; + s = d; + + return s; +} + diff --git a/cil/test/small2/globalprob.c b/cil/test/small2/globalprob.c new file mode 100644 index 0000000..4fbd8e7 --- /dev/null +++ b/cil/test/small2/globalprob.c @@ -0,0 +1,12 @@ + +typedef struct { + volatile unsigned int lock; +} spinlock_t; + +spinlock_t runqueue_lock __attribute__((__aligned__(32 ), + __section__(".data.cacheline_aligned"))) = (spinlock_t) { 1 } ; + + +int main () { + return 0; +} diff --git a/cil/test/small2/globinit.c b/cil/test/small2/globinit.c new file mode 100644 index 0000000..3c472b6 --- /dev/null +++ b/cil/test/small2/globinit.c @@ -0,0 +1,97 @@ +#include "../small1/testharness.h" +#include "../small1/testkinds.h" + +#ifndef __SEQ +#define __SEQ +#define __WILD +#define __INDEX +#endif +// Test the global initializer + +// NUMERRORS 14 + +struct S { + struct { + int *p1; + int i2; + int * p3[4]; + } a[4]; + char *f2; + struct B { + int *p4; + int nested [8]; /* Use a large number because CIL does not use long + * initializers if they are 0 */ + } b[4]; +}; + +int i1 = 1, i2 = 2, i3 = 3, i4 = 4, i5 = 5; +int ia[8] = { 0, 1, 2, 3, 4, 5, 6, 7}; + +struct S g = { .a[0].p1 = &i1, .a[0].i2 = 5, .a[0].p3[0] = &i2, + .a[1].p3[0] = ia, .f2 = "test" }; + + +#if 12 <= ERROR +// Define a long SIZED array of arrays +int matrix[64][4] = { 1, 2, 3 }; +#endif + +int main() { + + // Test with wildness +#if 1 <= ERROR && ERROR <= 3 + //ERROR(1):Error 1 + { + struct S * __WILD wg = &g; // Make g WILD + + // Test that the address is right + if(HAS_KIND(&i1, WILD_KIND) && // ERROR(1) + g.a[0].p1 == &i1 && * g.a[0].p1 == 1) E(1);//ERROR(1) + if(* g.f2 == 't') E(2);//ERROR(2):Error 2 + // Now check a bit that the tag bits are right + { int *p = * (int **)(& g.a[0].i2); } //ERROR(3):tampered + } +#endif + + // Now make sure that we can write SEQ pointers +#if 4 <= ERROR && ERROR <= 6 + { + int * __SEQ x = g.a[2].p3[1]; // Just to propagate the constraint + // Make sure that we can read + if(g.a[1].p3[0] [5] == 5) E(4); // ERROR(4):Error 4 + // Make sure the bounds are right + { int x = *(g.a[1].p3[0] - 1); } //ERROR(5):Lbound + { int x = *(g.a[1].p3[0] + 8); } //ERROR(6):Ubound + } +#endif + + // Now try the sized arrays +#if 7 <= ERROR && ERROR <= 11 + // Make both the b and the nested array SIZED + { + int * __INDEX pnested = g.b[3].nested; + struct B * __INDEX pb = g.b; + // Now try to read + if(! *(pnested + 7)) E(7); //ERROR(7):Error 7 + // Now try to read from outside + { int x = * (g.b[2].nested - 1); } //ERROR(8):Lbound + { int x = * (g.b[3].nested + 8); } //ERROR(9):Ubound + { int x = (g.b - 1)->p4; } //ERROR(10):Lbound + { int x = (g.b + 4)->p4; } //ERROR(11):Ubound + } +#endif + +#if 12 <= ERROR && ERROR <= 14 + { + int * __INDEX x = matrix[4]; + // Now try to read + if(! *(x + 3)) E(12);//ERROR(12):Error 12 + // Now try to read outside of bounds + { int y = * (x - 1); } //ERROR(13):Lbound + { int y = * (x + 4); } //ERROR(14):Ubound + } +#endif + + SUCCESS; +} + diff --git a/cil/test/small2/globtable.c b/cil/test/small2/globtable.c new file mode 100644 index 0000000..6da8a11 --- /dev/null +++ b/cil/test/small2/globtable.c @@ -0,0 +1,14 @@ +// a global table + +int nums[] = { 1,2,3 }; + +struct Foo { + int a,b; +}; +struct Foo foos[] = { {4,5}, {6,7} }; + +int main() +{ + return nums[1] - 2 + + foos[0].b - 5; +} diff --git a/cil/test/small2/handler1.handlers b/cil/test/small2/handler1.handlers new file mode 100644 index 0000000..269c8ea --- /dev/null +++ b/cil/test/small2/handler1.handlers @@ -0,0 +1,7 @@ + + +ignore UBOUND +stop * at handler1.c:10 : main() + +ignore LBOUND at *:20 + \ No newline at end of file diff --git a/cil/test/small2/hashtest.c b/cil/test/small2/hashtest.c new file mode 100644 index 0000000..974d17c --- /dev/null +++ b/cil/test/small2/hashtest.c @@ -0,0 +1,74 @@ + + +/* A special purpose main */ +#include "main.h" +#include "hash.h" +#include "alloc.h" + +/* Some globals that PCC needs */ +int error_level, anerror; +void myexit(int n) { + exit(n); +} +#ifdef _MSVC +#define random rand +#else +/* extern int random(void); -- Weimer: not needed! */ +#endif +int __mmId; +int debugMM; +int debug; + + +#pragma interceptCasts(on) + +#ifndef ITERS + #define ITERS 500000 +#endif // ITERS + +int main() { + /* Test hash tables */ + PHASH h = NewHash(); + int i; + double clk; + int count = 0; + int sz; + // int *foo, *foo1; + + /* Add and delete random numbers from the hash table */ + printf("inserting...\n"); + TIMESTART(clk); + for(i=0;i // printf +#include // malloc + +#if 1 +// this is a pointer in the global area +int *globalPtr; + +// here is a global integer to point at +int globalInt = 5; + + +// something so I can tell one section from another +void separator() {} + + +// explicitly declare the entry to the gc +void GC_gcollect(void); + + +// wtf? +int LibTkn; +int LibTkn010; + + +int main() +{ + // here's a local int to point at + int localInt; + + // point at them + globalPtr = &globalInt; + + separator(); + + // this simply isn't allowed! + //globalPtr = &localInt; + + separator(); + + globalPtr = (int*)malloc(sizeof(int)); + + + // allocate lots of memory which will all be unreachable, + // in hopes of triggering the GC + { + int i; + void **p, ***q; + for (i=0; i<1000; i++) { + p = (void**)malloc(sizeof(*p)); + *p = (void*)5; + // **((int**)p) = 7; + } + } + + // now will the gc be called? + // (requires BOX=1 so we get safec{debug,}lib.a ...) + //GC_gcollect(); + + printf("hola finished successfully\n"); + return 0; + + + #if 0 + int x,y; + x = printf("hola senior.\n"); + x += printf("what is ascii for accented o and tilde n?\n"); + x++; + printf("x = %d\n", x); + y = printf("hmm\n"); + return x?0:x; + #endif // 0 +} +#endif // 0 diff --git a/cil/test/small2/hufftable.c b/cil/test/small2/hufftable.c new file mode 100644 index 0000000..bf4342a --- /dev/null +++ b/cil/test/small2/hufftable.c @@ -0,0 +1,116 @@ +// hufftable.c +// problem with sizes of huffmann tables in jcparam.c + +#include // printf +#include // memcpy + +//char seventeen[17]; +char twofivesix[256]; + +typedef unsigned char UINT8; + +void +add_huff_table (/*const UINT8 *bits,*/ const UINT8 *val, int valLen) +/* Define a Huffman table */ +{ + //MEMCOPY((*htblptr)->bits, bits, SIZEOF((*htblptr)->bits)); + //memcpy(seventeen, bits, sizeof(seventeen)); + + // sm: bugfix code + { + int bytesToCopy = sizeof(twofivesix); // original size + if (valLen < bytesToCopy) { + printf("caught buffer underrun (reading %d bytes from %d byte array)\n", + bytesToCopy, valLen); + memset(twofivesix, 0, bytesToCopy); // zero entire dest + bytesToCopy = valLen; + } + memcpy(twofivesix, val, bytesToCopy); + //MEMCOPY((*htblptr)->huffval, val, bytesToCopy); + } +} + + +void std_huff_tables() +/* Set up the standard Huffman tables (cf. JPEG standard section K.3) */ +/* IMPORTANT: these are only valid for 8-bit data precision! */ +{ + //static const UINT8 bits_dc_luminance[17] = + // { /* 0-base */ 0, 0, 1, 5, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0 }; + static const UINT8 val_dc_luminance[] = + { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 }; + + #if 0 + static const UINT8 bits_dc_chrominance[17] = + { /* 0-base */ 0, 0, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0 }; + static const UINT8 val_dc_chrominance[] = + { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11 }; + + static const UINT8 bits_ac_luminance[17] = + { /* 0-base */ 0, 0, 2, 1, 3, 3, 2, 4, 3, 5, 5, 4, 4, 0, 0, 1, 0x7d }; + static const UINT8 val_ac_luminance[] = + { 0x01, 0x02, 0x03, 0x00, 0x04, 0x11, 0x05, 0x12, + 0x21, 0x31, 0x41, 0x06, 0x13, 0x51, 0x61, 0x07, + 0x22, 0x71, 0x14, 0x32, 0x81, 0x91, 0xa1, 0x08, + 0x23, 0x42, 0xb1, 0xc1, 0x15, 0x52, 0xd1, 0xf0, + 0x24, 0x33, 0x62, 0x72, 0x82, 0x09, 0x0a, 0x16, + 0x17, 0x18, 0x19, 0x1a, 0x25, 0x26, 0x27, 0x28, + 0x29, 0x2a, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, + 0x3a, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, + 0x4a, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, + 0x5a, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, + 0x6a, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, + 0x7a, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, + 0x8a, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, + 0x99, 0x9a, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7, + 0xa8, 0xa9, 0xaa, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, + 0xb7, 0xb8, 0xb9, 0xba, 0xc2, 0xc3, 0xc4, 0xc5, + 0xc6, 0xc7, 0xc8, 0xc9, 0xca, 0xd2, 0xd3, 0xd4, + 0xd5, 0xd6, 0xd7, 0xd8, 0xd9, 0xda, 0xe1, 0xe2, + 0xe3, 0xe4, 0xe5, 0xe6, 0xe7, 0xe8, 0xe9, 0xea, + 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7, 0xf8, + 0xf9, 0xfa }; + + static const UINT8 bits_ac_chrominance[17] = + { /* 0-base */ 0, 0, 2, 1, 2, 4, 4, 3, 4, 7, 5, 4, 4, 0, 1, 2, 0x77 }; + static const UINT8 val_ac_chrominance[] = + { 0x00, 0x01, 0x02, 0x03, 0x11, 0x04, 0x05, 0x21, + 0x31, 0x06, 0x12, 0x41, 0x51, 0x07, 0x61, 0x71, + 0x13, 0x22, 0x32, 0x81, 0x08, 0x14, 0x42, 0x91, + 0xa1, 0xb1, 0xc1, 0x09, 0x23, 0x33, 0x52, 0xf0, + 0x15, 0x62, 0x72, 0xd1, 0x0a, 0x16, 0x24, 0x34, + 0xe1, 0x25, 0xf1, 0x17, 0x18, 0x19, 0x1a, 0x26, + 0x27, 0x28, 0x29, 0x2a, 0x35, 0x36, 0x37, 0x38, + 0x39, 0x3a, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, + 0x49, 0x4a, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, + 0x59, 0x5a, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, + 0x69, 0x6a, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, + 0x79, 0x7a, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, + 0x88, 0x89, 0x8a, 0x92, 0x93, 0x94, 0x95, 0x96, + 0x97, 0x98, 0x99, 0x9a, 0xa2, 0xa3, 0xa4, 0xa5, + 0xa6, 0xa7, 0xa8, 0xa9, 0xaa, 0xb2, 0xb3, 0xb4, + 0xb5, 0xb6, 0xb7, 0xb8, 0xb9, 0xba, 0xc2, 0xc3, + 0xc4, 0xc5, 0xc6, 0xc7, 0xc8, 0xc9, 0xca, 0xd2, + 0xd3, 0xd4, 0xd5, 0xd6, 0xd7, 0xd8, 0xd9, 0xda, + 0xe2, 0xe3, 0xe4, 0xe5, 0xe6, 0xe7, 0xe8, 0xe9, + 0xea, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7, 0xf8, + 0xf9, 0xfa }; + #endif // 0 + + add_huff_table(/*bits_dc_luminance,*/ val_dc_luminance, sizeof(val_dc_luminance)); + //add_huff_table(bits_ac_luminance, val_ac_luminance, sizeof(val_ac_luminance)); + //add_huff_table(bits_dc_chrominance, val_dc_chrominance, sizeof(val_dc_chrominance)); + //add_huff_table(bits_ac_chrominance, val_ac_chrominance, sizeof(val_ac_chrominance)); +} + + +int main() +{ + // make sure twofivesix becomes wild + int **x = twofivesix; // interpret first 4 bytes as pointer + int *y = *x; // read that pointer + // (don't use it though) + + std_huff_tables(); + return 0; +} diff --git a/cil/test/small2/hufftest.c b/cil/test/small2/hufftest.c new file mode 100644 index 0000000..15aa055 --- /dev/null +++ b/cil/test/small2/hufftest.c @@ -0,0 +1,136 @@ + + +/* A special purpose main */ +#include "main.h" +#include "hash.h" +#include "alloc.h" +#include "pccio.h" +#include "huffman.h" + +/* Some globals that PCC needs */ +int error_level, anerror; +void myexit(int n) { + exit(n); +} +#ifdef _MSVC +#define random rand +#else +/* extern int random(void); -- Weimer: not needed! */ +#endif +int __mmId; +int debugMM; +int debug = 0; // Make this 1 to debug the compressor + + +/* Callback for writing to the compressed file */ +int compressfid; +#define BUFFSIZE 1024 +U8 outbuff[BUFFSIZE]; +int outPoint = 0; +int written = 0; +static int flushOut(void) { + int many; + if(outPoint <= 0) return 0; + many = write(compressfid, outbuff, outPoint); + if(many != outPoint) { + ERROR0(-1, "Error writing to the compressed file"); + } + written += outPoint; + outPoint = 0; + return 0; +} +static int writeByte(U8 b) { + outbuff[outPoint ++] = b; + if(outPoint == BUFFSIZE) { + flushOut(); + } + return 0; +} + +#define TIMES 10 +int main(int argc, char **argv) { + PHASH freq = NewHash(); + int freqfid, codefid; + int nrSource, delta; + double clk; + int count = 0; + + INDATA srcFile, compFile; + + /* Must be passed the name of a file to compress */ + if(argc < 2) { + printf("Must give a file to compress\n"); + exit(1); + } + TIMESTART(clk); + + initLFIOFile(&srcFile, argv[1]); + + /* Read the file, 2 bytes at a time and create the frequency table */ + nrSource = 0; + while(canFetch(&srcFile, 2)) { + U16 wrd = fetchWordLE(&srcFile); + nrSource += 2; + bumpFrequency(freq, wrd); + } + finishIOFile(&srcFile); + printf("Read %d bytes\n", nrSource); + /* Open the code and frequency files */ + freqfid = CREAT("huffman.freq"); + codefid = CREAT("huffman.code"); + compressfid = CREAT("huffman.compressed"); + if(freqfid < 0 || codefid < 0 || compressfid < 0) { + ERROR0(1, "Cannot create frequency and code files\n"); + } + createCompressTables(freq, freqfid, codefid); + close(freqfid); close(codefid); + FreeHash(freq); + + /* Now read again and compress */ + initCompressor("huffman.code"); + initLFIOFile(&srcFile, argv[1]); + outPoint = 0; written = 0; + startCompress(&writeByte); + /* Read the file, 2 bytes at a time and compress */ + while(canFetch(&srcFile, 2)) { + U16 wrd = fetchWordLE(&srcFile); + writeCompressedSymbol(wrd); + } + endCompress(); + flushOut(); + close(compressfid); + finishIOFile(&srcFile); + + /* Now decompress and compare */ + for(count=0;count<30;count++) { + initLFIOFile(&compFile, "huffman.compressed"); + initLFIOFile(&srcFile, argv[1]); + startDecompress(); + delta = nrSource; + while(delta > 0) { + int comp = fetchCompressedSymbol(&compFile); + int src = fetchWordLE(&srcFile); + if(src != comp) { + ERROR3(-1, "Src(%04x) != Comp(%04x) (at offset %d)\n", + src, comp, nrSource - delta); + } + delta -= 2; + } + endDecompress(&compFile); + finishIOFile(&srcFile); finishIOFile(&compFile); + } + finalizeCompressor(); + + + TIMESTOP(clk); + + // sm: according to my man pages, the 'l' flag doesn't apply + // to the 'f' format, which is always a double argument + printf("Source %d bytes. Compressed %d bytes. Ratio: %5.2f\n", + nrSource, written, (double)nrSource / (double)written); + printf("Run hufftest in %8.3fms\n", clk / 1000.0); + exit (0); + return 0; +} + + diff --git a/cil/test/small2/index1.c b/cil/test/small2/index1.c new file mode 100644 index 0000000..458b053 --- /dev/null +++ b/cil/test/small2/index1.c @@ -0,0 +1,56 @@ +#include "../small1/testharness.h" +#include "../small1/testkinds.h" + +// NUMERRORS 3 + +struct foo { + int a[8]; + int *b; +} gfoo; + +struct bar { + int a[8]; + int *b; +}; + +#if ERROR == 2 +struct s1 { + int a[8]; + int *b; +} * s1; +struct s2 { + int *c; + int d[8]; +} * s2; +#endif + +#if ERROR == 3 +struct s_with_index { + int __INDEX arr[8] __INDEX; +} * s1; + +struct s_with_non_array { + int a,b,c,d,e,f,g,h; +} * s2; +#endif + +int main() { + int * __INDEX p = & gfoo.a[2]; // Force gfoo.a to have a length + + // This should be Ok, but pbar->b is gfoo.a[7] + struct bar *pbar = (struct bar*)&gfoo; + + pbar->b = 0; + gfoo.a[7] = 5; + + printf("Pointer is %lx\n", (unsigned long)pbar->b); + *(pbar->b) = 0; //ERROR(1): Null + + s1 = s2; if (HAS_KIND(s1, WILD_KIND)) E(2); // ERROR(2):Error + +#if ERROR == 3 + s1 = s2; // ERROR(3): compared with a non-array +#endif + + SUCCESS; +} diff --git a/cil/test/small2/initedextern.c b/cil/test/small2/initedextern.c new file mode 100644 index 0000000..772b0b0 --- /dev/null +++ b/cil/test/small2/initedextern.c @@ -0,0 +1,11 @@ +// initedextern.c +// from sac at stevechamberlain dot com + +// claim is that this is common enough that we should support it + +extern int foo = 3; + +int main() +{ + return 0; +} diff --git a/cil/test/small2/invalredef.c b/cil/test/small2/invalredef.c new file mode 100644 index 0000000..0fe4aba --- /dev/null +++ b/cil/test/small2/invalredef.c @@ -0,0 +1,12 @@ + + +extern int wchgat(const void *); + +int wchgat(const void *opts __attribute__((unused)) ) +{ + return 1; +} + +int main () { + return 0; +} diff --git a/cil/test/small2/invalredef2.c b/cil/test/small2/invalredef2.c new file mode 100644 index 0000000..2561b30 --- /dev/null +++ b/cil/test/small2/invalredef2.c @@ -0,0 +1,16 @@ + +enum token { + TERM = - 1 +} ; /*onlytypedef*/ + + +static int parse(int * ) ; + +static int parse(enum token * tok ) +{ + return 0; +} + +int main () { + return 0; +} diff --git a/cil/test/small2/jpeg_compress_struct.c b/cil/test/small2/jpeg_compress_struct.c new file mode 100644 index 0000000..7f857b3 --- /dev/null +++ b/cil/test/small2/jpeg_compress_struct.c @@ -0,0 +1,37 @@ +#include // printf + +typedef unsigned int size_t ; +extern void * memset(void * __s , int __c , size_t __n ) ; + +typedef struct jpeg_compress_struct * j_compress_ptr ; + +struct jpeg_compress_struct { + struct jpeg_error_mgr * err ; +}; + +struct jpeg_error_mgr { +}; + +void foo(int x) +{ + printf("sizeof is %d\n", x); +} + +void jpeg_create_compress(j_compress_ptr cinfo ) +{ + struct jpeg_error_mgr * err = cinfo->err; + + foo(sizeof(struct jpeg_compress_struct )); + + memset((void * )cinfo, 0, (size_t )((size_t + )sizeof(struct jpeg_compress_struct ))); + + cinfo->err = err; +} + +int main() +{ + struct jpeg_compress_struct cinfo; + jpeg_create_compress(&cinfo); + return 0; +} diff --git a/cil/test/small2/kernel1.c b/cil/test/small2/kernel1.c new file mode 100644 index 0000000..46c2673 --- /dev/null +++ b/cil/test/small2/kernel1.c @@ -0,0 +1,10 @@ + +DECLARE_WAIT_QUEUE_HEAD(log_wait); + + + +int main () { + return 0; +} + + diff --git a/cil/test/small2/kernel2.c b/cil/test/small2/kernel2.c new file mode 100644 index 0000000..4f6fb53 --- /dev/null +++ b/cil/test/small2/kernel2.c @@ -0,0 +1,16 @@ +struct module +{ + unsigned long size_of_struct; + const char *name; +}; + + +static struct module kernel_module = +{ + size_of_struct: sizeof(struct module), + name: "", +}; + +int main () { + return 0; +} diff --git a/cil/test/small2/lexnum.c b/cil/test/small2/lexnum.c new file mode 100644 index 0000000..3a584c0 --- /dev/null +++ b/cil/test/small2/lexnum.c @@ -0,0 +1,37 @@ +// testing proper lexical interpretation of integer literals + +#include // printf +#include // exit + +//Make sure that $ is allowed in identifiers: +void print$Int(char *label, int i, int shouldBe) +{ + printf("%s: decimal %d, octal 0%o, hex 0x%X, shouldBe %d (decimal)\n", + label, i, i, i, shouldBe); + if (i != shouldBe) { + printf("this is wrong\n"); + exit(2); + } +} + +#define PVAL(val, should) print$Int(#val, val, should) + +int main() +{ + PVAL(0, 0); + PVAL(1, 1); + PVAL(10, 10); // decimal + PVAL(010, 8); // octal (leading "0") + PVAL(0x10, 16); // hexadecimal (leading "0x") + PVAL(100, 100); + PVAL(0100, 64); + PVAL(0101, 65); + PVAL(0x0101, 257); + PVAL(1 | 64 | 512, 577); + PVAL(01 | 0100, 65); + PVAL(01 | 0100 | 01000, 577); + // Now check for some overflow + PVAL(0xFFFFFFFF, -1); + PVAL(0x80000000 | 0x7FFFFFFFU, -1); + return 0; +} diff --git a/cil/test/small2/litstruct.c b/cil/test/small2/litstruct.c new file mode 100644 index 0000000..873b6f3 --- /dev/null +++ b/cil/test/small2/litstruct.c @@ -0,0 +1,24 @@ +extern void exit(int); + +struct Foo { + int a; + int b; +} structure; + +int main() +{ + char **foo; + + structure = ((struct Foo) {3, 4}); + if(structure.a + structure.b != 7) exit(1); + + + foo = (char *[]) { "x", "y", "z"}; + if(* foo[1] != 'y') exit(2); + + + if( ((int[]) { 1, 2, 3})[1] != 2) exit(3); + + exit(0); +} + diff --git a/cil/test/small2/main.c b/cil/test/small2/main.c new file mode 100644 index 0000000..ea7efc9 --- /dev/null +++ b/cil/test/small2/main.c @@ -0,0 +1,15 @@ + +#pragma pack(1) + +#pragma pack() + +struct udf_sb_info +{ + struct buffer_head *s_block_bitmap[8 ]; + + struct inode *s_vat; +}; + +int main () { + return 0; +} diff --git a/cil/test/small2/malloc1.c b/cil/test/small2/malloc1.c new file mode 100644 index 0000000..fdac1d1 --- /dev/null +++ b/cil/test/small2/malloc1.c @@ -0,0 +1,38 @@ +#include "../small1/testharness.h" + +// This test checks malloc on compatible pointers. +// NUMERRORS 3 + +#include + +int main(void) +{ + int *p1 = malloc(sizeof(*p1)); + int * __FSEQ * __COMPAT p2 = malloc(10 * sizeof(*p2)); + int i; + + // Check initialization. + *p1 = *p2[9]; // ERROR(1) + + *p1 = 42; + + for (i = 0; i < 10; i++) + { + p2[i] = p1; + } + + // Check alloc bounds. + p2[10] = &x; // ERROR(2) + + // Check bounds of pointer in array. + *(p2[5] + 1) = 4242; // ERROR(3) + + // Check contents of pointers. + if (**p2 != 42) E(3); + + // Check aliasing of pointers. + **p2 = 4242; + if (*p2[9] != 4242) E(4); + + SUCCESS; +} diff --git a/cil/test/small2/memberofptr.c b/cil/test/small2/memberofptr.c new file mode 100644 index 0000000..aeceebd --- /dev/null +++ b/cil/test/small2/memberofptr.c @@ -0,0 +1,33 @@ +struct posix_header { + char name[100] ; + char typeflag ; + char prefix[155] ; +} ; /*onlytypedef*/ +union block { + struct posix_header header ; +} ; /*onlytypedef*/ + + +enum read_header { + HEADER_FAILURE, + HEADER_SUCCESS, + +} ; /*onlytypedef*/ + + +int read_header(void ) +{ + union block * header ; /*decdef*/ + static char * next; /*decdef*/ + struct posix_header * h; /*decdef*/ + char namebuf[sizeof(h->prefix) + 1] ; /*decdef*/ + return sizeof(namebuf); +} + +#include "../small1/testharness.h" + +int main () { + if(read_header() != 156) E(1); + SUCCESS; + +} diff --git a/cil/test/small2/memset_sizeof.c b/cil/test/small2/memset_sizeof.c new file mode 100644 index 0000000..2b87282 --- /dev/null +++ b/cil/test/small2/memset_sizeof.c @@ -0,0 +1,16 @@ +// boxing sizeof? + +#include // printf +#include // memset + +struct S { + int *x; +}; + +int main() +{ + //printf("sizeof is %d\n", sizeof(struct S)); + memset(NULL, 0, sizeof(struct S)); + //return sizeof(struct S); + return 0; +} diff --git a/cil/test/small2/merge-ar.c b/cil/test/small2/merge-ar.c new file mode 100644 index 0000000..574fd00 --- /dev/null +++ b/cil/test/small2/merge-ar.c @@ -0,0 +1,26 @@ + +//There's a problem with the merger when a parameter overlaps with a static local. + + +int fun1(int n) +{ + return n; +} + +int qux() +{ + static int n = 3; + return n; +} + +int fun2() +{ + int n; //This local doesn't seem to cause any problems. + return n; +} + + + +int main() { + return 0; +} diff --git a/cil/test/small2/merge-twice-1.c b/cil/test/small2/merge-twice-1.c new file mode 100644 index 0000000..01f8bb9 --- /dev/null +++ b/cil/test/small2/merge-twice-1.c @@ -0,0 +1,6 @@ +// merge-twice: testcase of merging merged results + +int foo() +{ + return 3; +} diff --git a/cil/test/small2/merge-twice-2.c b/cil/test/small2/merge-twice-2.c new file mode 100644 index 0000000..87d1ea1 --- /dev/null +++ b/cil/test/small2/merge-twice-2.c @@ -0,0 +1,6 @@ + + +int bar() +{ + return 4; +} diff --git a/cil/test/small2/merge-twice-3.c b/cil/test/small2/merge-twice-3.c new file mode 100644 index 0000000..bc28baf --- /dev/null +++ b/cil/test/small2/merge-twice-3.c @@ -0,0 +1,6 @@ + + +int baz() +{ + return 7; +} diff --git a/cil/test/small2/mergeinline1.c b/cil/test/small2/mergeinline1.c new file mode 100644 index 0000000..ec71b3a --- /dev/null +++ b/cil/test/small2/mergeinline1.c @@ -0,0 +1,24 @@ +// mergeinline1.c +// hypothesis about fill_n_... problem + +// prototype +static long *fill(); + +// call +int foo() +{ + long *w = fill(); + return (int)(*w); +} + +// inline definition +// (remove "__inline" to work around the bug) +__inline static long *fill() +{ + return 0; +} + +int main() +{ + return 0; +} diff --git a/cil/test/small2/mergeinline2.c b/cil/test/small2/mergeinline2.c new file mode 100644 index 0000000..e9b3e52 --- /dev/null +++ b/cil/test/small2/mergeinline2.c @@ -0,0 +1,20 @@ +// mergeinline2.c +// counterpart to mergeinline1.c + +// prototype +static long *fill(); + +// call +int bar() +{ + long *w = fill(); + return (int)(*w); +} + +// inline definition +// (remove "__inline" to work around the bug) +__inline static long *fill() +{ + return 0; +} + diff --git a/cil/test/small2/mergestruct1.c b/cil/test/small2/mergestruct1.c new file mode 100644 index 0000000..7e40bf3 --- /dev/null +++ b/cil/test/small2/mergestruct1.c @@ -0,0 +1,26 @@ +// mergestruct1.c +// test merging of structures whose field names differ + +struct A { + int x; +}; + +// make A's type part of the interface +extern struct A *connection; + +// decl of foo() +int foo(); + +// refer to A::x +int foo() +{ + if (connection) { + return connection->x; + } + else { + return 3; + } +} + +// unrelated: test merging of 'unsigned char' and 'signed char' +unsigned char sharedChar; diff --git a/cil/test/small2/mergestruct2.c b/cil/test/small2/mergestruct2.c new file mode 100644 index 0000000..dc492d0 --- /dev/null +++ b/cil/test/small2/mergestruct2.c @@ -0,0 +1,26 @@ +// mergestruct2.c +// other half of mergestruct1.c + +struct B { + int y; +}; + +// connect A and B +struct B *connection; + +// refer to B::y +int main() +{ + int whatever; + + if (connection) { + whatever = connection->y; + } + whatever += foo(); // for the heck of it + + return whatever-whatever; +} + +// unrelated: test merging of 'unsigned char' and 'signed char' +// (I edit this to introduce inconsistency..) +unsigned char sharedChar; diff --git a/cil/test/small2/metabug3.c b/cil/test/small2/metabug3.c new file mode 100644 index 0000000..c34feda --- /dev/null +++ b/cil/test/small2/metabug3.c @@ -0,0 +1,24 @@ +#include "../small1/testharness.h" +#include "../small1/testkinds.h" + +#ifndef ERROR +#define __WILD +#endif + +// NUMERRORS 1 +typedef struct foo Foo; +struct bar +{ + Foo * __WILD next; +}; +struct foo +{ + int *base; + unsigned int length; + struct bar link; +}; +int main() +{ + struct foo s, *sptr = &s; + if(HAS_KIND(sptr->base, WILD_KIND)) E(1); //ERROR(1):Error 1 +} diff --git a/cil/test/small2/mode_sizes.c b/cil/test/small2/mode_sizes.c new file mode 100644 index 0000000..5cafb69 --- /dev/null +++ b/cil/test/small2/mode_sizes.c @@ -0,0 +1,43 @@ +// mode_sizes.c +// demonstrate a problem with 'ping' + +// /usr/include/sys/types.h, around line 177, after macro expansion +typedef int int8_t __attribute__ ((__mode__ ( __QI__ ))) ; +typedef int int16_t __attribute__ ((__mode__ ( __HI__ ))) ; +typedef int int32_t __attribute__ ((__mode__ ( __SI__ ))) ; +typedef int int64_t __attribute__ ((__mode__ ( __DI__ ))) ; + +typedef unsigned int u_int8_t __attribute__ ((__mode__ ( __QI__ ))) ; +typedef unsigned int u_int16_t __attribute__ ((__mode__ ( __HI__ ))) ; +typedef unsigned int u_int32_t __attribute__ ((__mode__ ( __SI__ ))) ; +typedef unsigned int u_int64_t __attribute__ ((__mode__ ( __DI__ ))) ; + +typedef int someInt; // something I don't want to mess with + +typedef short x8_t __attribute__ ((__mode__ ( byte ))) ; + +// avoid pulling in conflicting definitions +someInt printf(char const *fmt, ...); + +int main() +{ + int ok = 1; + + #define PRSIZE(type, should) \ + printf("size of " #type " is: %d (should be %d)\n", \ + sizeof(type), should); ok = ok && (sizeof(type) == should) + PRSIZE(int8_t, 1); + PRSIZE(int16_t, 2); + PRSIZE(int32_t, 4); + PRSIZE(int64_t, 8); + + PRSIZE(u_int8_t, 1); + PRSIZE(u_int16_t, 2); + PRSIZE(u_int32_t, 4); + PRSIZE(u_int64_t, 8); + + PRSIZE(x8_t, 1); + #undef PRSIZE + + return ok? 0 : 1; +} diff --git a/cil/test/small2/multiplestatics.c b/cil/test/small2/multiplestatics.c new file mode 100644 index 0000000..3b1c51e --- /dev/null +++ b/cil/test/small2/multiplestatics.c @@ -0,0 +1,20 @@ +// two static variables with the same name + +int foo() +{ + static int x = 0; + return x; +} + +int bar() +{ + static int x = 5; + return x; +} + +int main() +{ + return !( foo() + bar() == 5 ); + return 0; +} + diff --git a/cil/test/small2/neg64.c b/cil/test/small2/neg64.c new file mode 100644 index 0000000..dc82e4e --- /dev/null +++ b/cil/test/small2/neg64.c @@ -0,0 +1,18 @@ +// neg64.c +// testcase for -2^63 problem +// from sac at stevechamberlain dot com + +float +sll2f(s) + long long int s; +{ + return s; +} + +main() +{ + if (sll2f((long long int)(~((~0ULL) >> 1))) != (float)(long long int)~((~0ULL) >> 1)) /* 0x80000000 */ + abort(); + + exit(0); +} diff --git a/cil/test/small2/nested.c b/cil/test/small2/nested.c new file mode 100644 index 0000000..a686c77 --- /dev/null +++ b/cil/test/small2/nested.c @@ -0,0 +1,30 @@ +// example of a situation where nested areas are registered + +#include // printf + +struct Foo { + int a; + int b[8]; +} foo [16]; + +int main() +{ + struct Foo *f = foo; + int i; + int acc = 0; + + printf("start of nested\n"); + + for (i=0; i<16; i++) { + int *b = f[i].b; + b += 2; + b[0] = 3; + b[1] = 4; + acc += b[1] - b[0]; + } + + printf("end of nested\n"); + + return acc - 16; +} + diff --git a/cil/test/small2/nonwilderror.c b/cil/test/small2/nonwilderror.c new file mode 100644 index 0000000..c937096 --- /dev/null +++ b/cil/test/small2/nonwilderror.c @@ -0,0 +1,13 @@ +extern void error(int status , int errnum , const char * format , ...) + __attribute__((__format__(__printf__, 3, 4))) ; + + +static void parse_group(const char * name) { + if(0) error(1, 0, gettext("invalid group name %s"), quote(name)); +} + + +int main(int argc , char * * argv ) { + return 0; +} + diff --git a/cil/test/small2/oldstyle.c b/cil/test/small2/oldstyle.c new file mode 100644 index 0000000..8c54ad8 --- /dev/null +++ b/cil/test/small2/oldstyle.c @@ -0,0 +1,14 @@ +// oldstyle decls are problematic in themselves? + +static int foo(int x); // right now, 'static' is the problem + +int foo(x) + int x; +{ + return x; +} + +int main() +{ + return foo(0); +} diff --git a/cil/test/small2/open.c b/cil/test/small2/open.c new file mode 100644 index 0000000..926db60 --- /dev/null +++ b/cil/test/small2/open.c @@ -0,0 +1,52 @@ +// testing problem with args to open... + +#include +#include +#include +#include // read, close +#include // perror + + +int main() +{ +// int fd = open("/dev/zero", O_RDONLY, 0); // must pass 3rd arg (matth: why?) + + int fd = open("./open_test", O_CREAT | O_WRONLY, S_IRUSR); + char buf = 'a'; + if (fd < 0){ + perror("open(./open_test, O_CREAT | O_WRONLY, S_IRUSR) < 0"); + return 1; + } + + if (write(fd, &buf, 1) != 1) { + perror("write(fd, &buf, 1) != 1"); + return 2; + } + close(fd); + buf = 0; + + fd = open("./open_test", O_RDONLY); + if (fd < 0){ + perror("open(./open_test, O_RDONLY) < 0"); + return 3; + } + + if (read(fd, &buf, 1) != 1) { + perror("read(fd, &buf, 1) != 1"); + return 4; + } + close(fd); + if (buf != 'a'){ + perror("read wrong value"); + return 5; + } + + if (unlink("./open_test") != 0) + { + perror("unlink(./open_test) != 0"); + return 6; + } + + printf("Open Succeeded!\n"); + return 0; +} diff --git a/cil/test/small2/override.c b/cil/test/small2/override.c new file mode 100644 index 0000000..4e4ae85 --- /dev/null +++ b/cil/test/small2/override.c @@ -0,0 +1,40 @@ +#include "../small1/testharness.h" +#include "../small1/testkinds.h" + +// NUMERRORS 5 + +int * __SAFE global_variable_1; + +typedef struct { + int * __SAFE field_1; + int *field_2; + int *field_3; +} my_struct; + +my_struct *global_variable_2; + +int main() { + int * __SAFE local_variable_1; + +#if ERROR == 1 + local_variable_1 = 55; + if(!(HAS_KIND(local_variable_1, SAFE_KIND))) E(1); //ERROR(1):Error 1 +#endif +#if ERROR == 2 + global_variable_1 = 55; + if(!(HAS_KIND(global_variable_1, SAFE_KIND))) E(2); //ERROR(2):Error 2 +#endif +#if ERROR == 3 + global_variable_2 = global_variable_1; + if((HAS_KIND(global_variable_1, WILD_KIND))) E(3); //ERROR(3):Error 3 +#endif +#if ERROR == 4 + global_variable_2 = global_variable_1; + if((HAS_KIND(global_variable_2, WILD_KIND))) E(4); //ERROR(4):Error 4 +#endif +#if ERROR == 5 + global_variable_2 = &global_variable_1; + if((HAS_KIND(global_variable_2->field_1, WILD_KIND))) E(5); //ERROR(5):Error 5 +#endif + SUCCESS; +} diff --git a/cil/test/small2/partialbracket.c b/cil/test/small2/partialbracket.c new file mode 100644 index 0000000..0323114 --- /dev/null +++ b/cil/test/small2/partialbracket.c @@ -0,0 +1,20 @@ +// partially-bracketed initializers cause problems + +struct S { + int x, y; +}; + +struct S array[] = { + 1,2, + 3,4 +}; + +struct S array_ok[] = { + {1,2}, + {3,4} +}; + +int main() +{ + return array[0].x - 1; // should be 0 +} diff --git a/cil/test/small2/pset.c b/cil/test/small2/pset.c new file mode 100644 index 0000000..7b80c35 --- /dev/null +++ b/cil/test/small2/pset.c @@ -0,0 +1,8 @@ + + +int main() +{ + int someVariable, restrict; + + return 0; +} diff --git a/cil/test/small2/ptrinint.c b/cil/test/small2/ptrinint.c new file mode 100644 index 0000000..c863751 --- /dev/null +++ b/cil/test/small2/ptrinint.c @@ -0,0 +1,22 @@ +// test storing ints in pointers + + +int main() +{ + // local variable + int local = 7; + + // pointer to this variable + int *ptr = &local; + *ptr = 9; // modify via pointer + + // now store an int in the ptr + ptr = (int*)23; + local = (int)ptr; // read the int out of the ptr + + // point the ptr back at the local + ptr = &local; + + // and verify everything is 23 + return *ptr + local*10 - (23 + 23*10); +} diff --git a/cil/test/small2/putc.c b/cil/test/small2/putc.c new file mode 100644 index 0000000..3922f15 --- /dev/null +++ b/cil/test/small2/putc.c @@ -0,0 +1,31 @@ +// test simple character functions, which give us +// troubles because they are macros + +#include // putc +#include // unlink + +int main() +{ + FILE *tmp; + int ch; + + putc('c', stdout); + putc('\n', stdout); + + tmp = fopen("putc.tmp", "w"); + fputc('a', tmp); + fclose(tmp); + + tmp = fopen("putc.tmp", "r"); + ch = fgetc(tmp); + fclose(tmp); + if (ch != 'a') { + return 4; + } + + unlink("putc.tmp"); + + puts("putc seems to work"); // puts outputs a trailing newline + + return 0; +} diff --git a/cil/test/small2/rbtest.c b/cil/test/small2/rbtest.c new file mode 100644 index 0000000..44305e0 --- /dev/null +++ b/cil/test/small2/rbtest.c @@ -0,0 +1,126 @@ + + +/* A special purpose main */ +#include "main.h" +#include "redblack.h" +#include "alloc.h" + +/* Some globals that PCC needs */ +int error_level, anerror; +void myexit(int n) { + exit(n); +} +#ifdef _MSVC +#define random rand +#else +/* weimer: not needed: extern int random(void); */ +#endif +int __mmId; +int debugMM; +int debug; + +// allow explicit call into gc +//int explicit_gc(); + + +#define DATASIZE 16 // This is the size of the data that is reserved in + // each node + +#ifndef ITERS + #define ITERS 500000 +#endif // ITERS + +// had to make these global since spreading the functionality +// across several functions +int count = 0; +int sz; + +void innerDoTreeStuff(int letGcFree) +{ + RBNode *t = NULL; + int i; + + /* Add and delete random numbers from the hash table */ + printf("inserting...\n"); + for(i=0;i // printf + +void innerDoTreeStuff(int letGcFree) +{ + int i; + + /* Add and delete random numbers from the hash table */ + printf("inserting...\n"); +} + +int main() +{ + innerDoTreeStuff(0); + return 0; +} diff --git a/cil/test/small2/regparm0.c b/cil/test/small2/regparm0.c new file mode 100644 index 0000000..83a9728 --- /dev/null +++ b/cil/test/small2/regparm0.c @@ -0,0 +1,25 @@ +// regparm0.c +// test of the regparm(0) problem in linux/arch/i386/kernel/signal.c + +// first, problematic prototype; basically, the regparm(0) is +// parsed as associated with the return type (int), and hence a +// no-op; the regparm(3) should be what's attached to do_signal +__attribute__((regparm(0))) int do_signal(int *regs, int *oldset) + __attribute__((regparm(2))) __attribute__((regparm(3))); + +// call this function +int main() +{ + int r=6, o=5; + return do_signal(&o, &r) - 11; +} + +// now an implementation which will die if its args are mis-passed +int do_signal(int *regs, int *oldset) +{ + return *regs + *oldset; +} + + + + diff --git a/cil/test/small2/regthenprintf.c b/cil/test/small2/regthenprintf.c new file mode 100644 index 0000000..2b74a56 --- /dev/null +++ b/cil/test/small2/regthenprintf.c @@ -0,0 +1,32 @@ +// register an area, then clobber by calling fn + +#include // printf +#include // malloc + +void clobber() +{ + printf("clobbering\n"); + + // at the end we unregisterbelow, which will kill global/heap + // areas since at the moment I fail to distinguish +} + + +int main() +{ + // make and register an area + int *p = (int*)malloc(sizeof(*p)); + + printf("printf result: %p\n", p); + + // clobber registration + clobber(); + + // try to use *p + *p = 9; + + printf("worked ok!\n"); + + return 0; +} + diff --git a/cil/test/small2/runall_misc.c b/cil/test/small2/runall_misc.c new file mode 100644 index 0000000..c912e4c --- /dev/null +++ b/cil/test/small2/runall_misc.c @@ -0,0 +1,9 @@ + + +int main (int argc, char **argv) +{ + return 0; +} +//Our parser was allowing trailing right braces +} //KEEP rbrace: error = syntax error + diff --git a/cil/test/small2/rusage.c b/cil/test/small2/rusage.c new file mode 100644 index 0000000..4cc16fb --- /dev/null +++ b/cil/test/small2/rusage.c @@ -0,0 +1,13 @@ +struct rusage ; + +struct foobar_not_used; + +int w3(struct rusage *__usage ) { return 0; } + +int main() +{ + struct rusage *r; + w3(r); + return 0; +} + diff --git a/cil/test/small2/s59.c b/cil/test/small2/s59.c new file mode 100644 index 0000000..21f835d --- /dev/null +++ b/cil/test/small2/s59.c @@ -0,0 +1,25 @@ +typedef unsigned char hashtyp; +typedef unsigned short strindx; + + +typedef struct S59 * idptr; +typedef struct S59 { + idptr inext; + unsigned char inref; + hashtyp ihash; + strindx istr; +} idnode; + +void printtok(strindx istr){} + + void +printid(ip) + idptr ip; +{ + printtok(ip->istr); +} + +int main() +{ + return 0; +} diff --git a/cil/test/small2/scary.c b/cil/test/small2/scary.c new file mode 100644 index 0000000..78be1c4 --- /dev/null +++ b/cil/test/small2/scary.c @@ -0,0 +1,96 @@ +// scary.c +// seeing what gcc is afraid of + +#include // printf +#include // atoi +#include // struct timeval, gettimeofday + +// return the # of milliseconds since some unspecified, but +// constant for the life of the program, event +long getMilliseconds() +{ +# ifdef __WIN32__ + // # of milliseconds since program started + return GetTickCount(); + +# else + // some unspecified millisecond count (unspecified + // because tv.tv_sec * 1000 will overflow a 32-bit + // long, for typical values) + struct timeval tv; + gettimeofday(&tv, NULL); + // according to HPUX man page, this always returns 0 and does + // not have any errors defined + + //printf("tv.tv_sec = %d, tv.tv_usec = %d\n", + // tv.tv_sec, tv.tv_usec); + return tv.tv_sec * 1000 + tv.tv_usec / 1000; +# endif +} + +int loop1(int m) +{ + int i=0; + while (i\n", argv[0]); + return 0; + } + + m = atoi(argv[1]); + + #define LOOP(n) \ + start = getMilliseconds(); \ + printf("loop%d: ", n); \ + loop##n(m); \ + printf("%ld ms\n", getMilliseconds() - start) /* user ; */ + + LOOP(1); + LOOP(2); + LOOP(3); + LOOP(4); + + printf("done\n"); + + return 0; +} + + diff --git a/cil/test/small2/segfault.c b/cil/test/small2/segfault.c new file mode 100644 index 0000000..34ca887 --- /dev/null +++ b/cil/test/small2/segfault.c @@ -0,0 +1,30 @@ +#include // malloc + +#define N 100000 + +struct S1 { struct T1* b; }; +struct S2 { struct T2* b; }; + +struct T1 { int x; }; +struct T2 { int x, y[N]; }; + +int main() { + + struct S1 *s1p; + struct S2 *s2p; + + s2p = (struct S2*)malloc(sizeof(struct S2)); + + s1p = (struct S1*) s2p; + + s1p->b = (struct T1*)malloc(sizeof(struct T1)); + //s2p->b = (struct T2*)(s1p->b); + + s2p->b->x = 1; + + /* if N is large enough, this should segfault */ + s2p->b->y[N-1] = 3; + + return 0; + +} diff --git a/cil/test/small2/seq_align_malloc.c b/cil/test/small2/seq_align_malloc.c new file mode 100644 index 0000000..04419f6 --- /dev/null +++ b/cil/test/small2/seq_align_malloc.c @@ -0,0 +1,45 @@ +// attempt to reproduce this error: +// Failure at ./Config_Test.mergedcured.c:open__112ACE_Malloc_T__tm__92_21ACE_Local_Memory_Pool29ACE_Local_Memory_Pool_Options16ACE_Thread_Mutex17ACE_Control_BlockFv_i:161967: Creating an unaligned sequence + +#include + +/* This code is from a custom allocator that allocates a header before the + * actual memory block */ +int main() { + struct header { + int one; + int *two; + int three; + } *h; + char *p; + // We allocate 3 chars but with a header + char* v = (char*)malloc(sizeof(struct header) + 4); + +#ifndef CCURED + h = (struct header*)v; // Will check here that there is enough space in p + h->one = 5; // Write something to the header + p = (char*)(h + 1); // Skip the header, but this makes h SEQ +#else + // In the CCURED version we have to play some tricks + // Make sure h is not SEQ, so, don't do h + 1 + + // We want h to be SAFE. If header did not contain pointers we could do: + // h = (struct header*)v; + // But since header contains pointers, it is not SAFE to cast from a + // char-ptr to a header-ptr. trusted_cast wants its both ends to have + // the same kind, which would make h SEQ. We use __ptrof instead. + // But be careful how you use h in the future, because if you make it + // SEQ, you will need __ptrof_qq, which does not exist! + h = (struct header*)__ptrof(v); + h->one = 5; + // Use v to compute p, not h. This way h can stay SAFE. + p = v + sizeof(struct header); +#endif + + // And we need the result to be SEQ + p ++; + p --; + + + return 0; +} diff --git a/cil/test/small2/seq_align_malloc2.c b/cil/test/small2/seq_align_malloc2.c new file mode 100644 index 0000000..e5eb326 --- /dev/null +++ b/cil/test/small2/seq_align_malloc2.c @@ -0,0 +1,54 @@ +// attempt to reproduce this error: +// Failure at ./Config_Test.mergedcured.c:open__112ACE_Malloc_T__tm__92_21ACE_Local_Memory_Pool29ACE_Local_Memory_Pool_Options16ACE_Thread_Mutex17ACE_Control_BlockFv_i:161967: Creating an unaligned sequence + +#include +#include + +struct a_struct { + int one; + int *two; + int three; +}; + +#ifdef CCURED + #define IFCCURED(cc,noncc) cc +#else + #define IFCCURED(cc,noncc) noncc +#endif + +#define CCURED_TRUSTED_CAST(t, what) \ + IFCCURED(((t)__trusted_cast((void*)(what))), ((t)(what))) + +// imitate an allocator +void *make_a_struct(int num, size_t size) { + // We allocate num things plus some extra. Ccured hates this. + return (struct a_struct *) malloc (num*size + 1); +} + +int main() { + const int array_size = 3; + struct a_struct *p; + + char *temp = make_a_struct(array_size, sizeof *p); + +#ifdef CCURED + // Whack down the home area. + temp = __align_seq(temp, sizeof *p); +#endif + p = CCURED_TRUSTED_CAST(struct a_struct*, temp); + // access it + { + int i; + for(i=0; i FSEQ +#if ERROR == 3 + { + long along; + long * pl = &along; + fc = (char*)pl; + pl = (long*)(fc + 1); //ERROR(3):unaligned + } +#endif + + // Now from SEQ -> FSEQ + fl = (long*)(sc + 3); /* should succeed */ E(4);//ERROR(4):Error 4 + fl = (long*)sc; //ERROR(5):unaligned + + // Now through polymorphism + { + void * v1 = sc; + void * v2 = sc + 3; + if(HAS_KIND(v1, WILD_KIND)) E(16); + // A good one + fl = (long*)v2; /* Should be Ok */ E(6);//ERROR(6):Error 6 + fl = (long*)v1;//ERROR(7):unaligned + } + + // Now test the __align_seq + fl = (long*)__align_seq(sc, sizeof(*fl)); E(9);//ERROR(9):Error 9 + + SUCCESS; +} + +#if ERROR == 8 +// Try a global trick +long * __FSEQ glob = &carray[1]; //ERROR(8):unaligned +#endif diff --git a/cil/test/small2/sizeof3.c b/cil/test/small2/sizeof3.c new file mode 100755 index 0000000..0c4bfc7 --- /dev/null +++ b/cil/test/small2/sizeof3.c @@ -0,0 +1,22 @@ +//Bug caused by overflow in bitsSizeOf (SourceForge #1641570) + +//Partial workaround: define "bytesSizeOf", not bitsSizeOf, to give us 8x more +//breathing room. +//Better workaround: make bitsSizeOf return an int64 +//Current solution: a warning + +char tab[300000000]; // three hundred million times 8 bits = -947483648 mod 2**31 + +//TODO: give somthing better than a warning here ... +extern char foo[sizeof(tab)]; //KEEP folding: error = Int constant too large + +char foo[300000000]; + +int main () { + int i; + + tab[999999999] = foo[5]; + i = sizeof (tab); + + return 0; +} diff --git a/cil/test/small2/sizeofchar.c b/cil/test/small2/sizeofchar.c new file mode 100644 index 0000000..9b0aeba --- /dev/null +++ b/cil/test/small2/sizeofchar.c @@ -0,0 +1,32 @@ +// sizeofchar.c +// from sac at stevechamberlain dot com + +// problems with sizeof and chars + +#include // assert + +int main() +{ + int sz1, sz2; + int i; + + sz1 = sizeof('a'); // 'a' is actually an int constant, so this is 4 + assert(sz1 == sizeof(int)); + + sz2 = sizeof((char)'a'); // now it's 1! + assert(sz2 == sizeof(char)); + + //character constants are ints, so this should be sign-extended to 0xFFFFFFFF + i = '\xff'; + assert((int)i == (int)-1); + + { + //Test CIL's understanding of '\xff' by forcing it to do constant folding: + char array[(unsigned int)'\xff' - (unsigned int)0xfffff000]; + assert (sizeof(array) == 0xfff); + } + + + return 0; +} + diff --git a/cil/test/small2/sockaddr.c b/cil/test/small2/sockaddr.c new file mode 100644 index 0000000..b21cd11 --- /dev/null +++ b/cil/test/small2/sockaddr.c @@ -0,0 +1,97 @@ +typedef unsigned short int sa_family_t; + +typedef signed short int __int16_t; + +typedef unsigned char uint8_t; +typedef unsigned short int uint16_t; +typedef unsigned int uint32_t; + +typedef unsigned int socklen_t; + +struct sockaddr + { + sa_family_t sa_family ; + char sa_data[14]; + }; + + +struct in_addr + { + uint32_t s_addr; + }; + +struct sockaddr_in + { + sa_family_t sin_family ; + uint16_t sin_port; + struct in_addr sin_addr; + + + unsigned char sin_zero[sizeof (struct sockaddr) - + (sizeof (unsigned short int)) - + sizeof (uint16_t) - + sizeof (struct in_addr)]; + }; + +struct in6_addr + { + union + { + uint8_t u6_addr8[16]; + uint16_t u6_addr16[8]; + uint32_t u6_addr32[4]; + } in6_u; + }; + +struct sockaddr_in6 + { + sa_family_t sin6_family ; + uint16_t sin6_port; + uint32_t sin6_flowinfo; + struct in6_addr sin6_addr; + }; + + +union sockunion { + struct sockinet { + sa_family_t si_family ; + uint16_t si_port; + } su_si; + struct sockaddr_in su_sin; + struct sockaddr_in6 su_sin6; +}; + +union sockunion server_addr; + +typedef union { + __const struct sockaddr *__sockaddr__; + //__const struct sockaddr_at *__sockaddr_at__; + //__const struct sockaddr_ax25 *__sockaddr_ax25__; + //__const struct sockaddr_dl *__sockaddr_dl__; + //__const struct sockaddr_eon *__sockaddr_eon__; + __const struct sockaddr_in *__sockaddr_in__; + __const struct sockaddr_in6 *__sockaddr_in6__; + //__const struct sockaddr_inarp *__sockaddr_inarp__; + //__const struct sockaddr_ipx *__sockaddr_ipx__; + //__const struct sockaddr_iso *__sockaddr_iso__; + //__const struct sockaddr_ns *__sockaddr_ns__; + //__const struct sockaddr_un *__sockaddr_un__; + //__const struct sockaddr_x25 *__sockaddr_x25__; +} __CONST_SOCKADDR_ARG __attribute__ ((__transparent_union__)); + +extern int bind (int __fd, __CONST_SOCKADDR_ARG __addr, socklen_t __len) ; + +//extern int __libc_sa_len (sa_family_t __af) ; + +int main() +{ + int ctl_sock=0; + struct sockaddr *addrptr; + + addrptr = (struct sockaddr *)&server_addr; + bind(ctl_sock, addrptr, 3); + //__libc_sa_len(( (struct sockaddr *)&server_addr )->sa_family) ); + + return ctl_sock; +} + diff --git a/cil/test/small2/stackptr.c b/cil/test/small2/stackptr.c new file mode 100644 index 0000000..f503be4 --- /dev/null +++ b/cil/test/small2/stackptr.c @@ -0,0 +1,25 @@ +#include "../small1/testharness.h" + +#define NUMERRORS 2 + +char * global; + +int notmain() { + char loc; + // We check that the __checkStackBottom is not too lenient + global = &loc; //ERROR(2):STORE_SP +} + +int main(int argv, char **argv, char **envp) { + char mainloc; + // We should be able to store mainloc + global = & mainloc; E(1); // ERROR(1):Error 1 + + // We should be able to store argv + global = *argv; E(2); // ERROR(2):Error 2 + + // And envp + global = *envp; E(3); // ERROR(3):Error 3 + + SUCCESS; +} diff --git a/cil/test/small2/stackptrptr.c b/cil/test/small2/stackptrptr.c new file mode 100644 index 0000000..73ab2a0 --- /dev/null +++ b/cil/test/small2/stackptrptr.c @@ -0,0 +1,27 @@ +// stackptrptr.c +// NUMERRORS(1) +// demonstrate problem with stack ptr to stack ptr + +#define MESS_UP // ERROR(1) + +#ifndef MESS_UP + int main() + { + int x = 0; + int *px = &x; + int **ppx = &px; // allowed + + return **ppx; + } + +#else + int main() + { + int x = 0; + int *px = &x; + int *ppx[1]; + + ppx[0] = &px; // not allowed + return *(ppx[0]); + } +#endif // 0/1 diff --git a/cil/test/small2/struct_cs.c b/cil/test/small2/struct_cs.c new file mode 100644 index 0000000..87064f7 --- /dev/null +++ b/cil/test/small2/struct_cs.c @@ -0,0 +1,33 @@ +// struct_cs.c +// reproduce a problem from gimp and an internally-declared struct +// from plug-ins/gfig/gfig.c + +typedef double gdouble; +typedef int gint; + +static void +reverse_pairs_list (gdouble *list, + gint size) +{ + gint i; + + struct cs + { + gdouble i1; + gdouble i2; + } copyit, *orglist; + + orglist = (struct cs *) list; + + + for (i = 0; i < size / 2; i++) + { + copyit = orglist[i]; + orglist[i] = orglist[size - 1 - i]; + orglist[size - 1 - i] = copyit; + } +} + +int main() { + return 0; +} diff --git a/cil/test/small2/structattr.c b/cil/test/small2/structattr.c new file mode 100644 index 0000000..6dd1483 --- /dev/null +++ b/cil/test/small2/structattr.c @@ -0,0 +1,55 @@ +// structattr.c +// testing some placement of 'attribute' w.r.t. 'struct' etc. + +struct A { + int x; +} __attribute__((packed)); +struct A a; + +struct B { + int x; +} __attribute__((packed)) b; + +#if 1 +// this is allowed by gcc, but I don't want to implement it because +// it means somehow merging all the attributes across all the +// forward decls and the defn ... +//struct __attribute__((packed)) C; + +struct __attribute__((packed)) C { + int x; +}; +struct C c; + +struct __attribute__((packed)) D { + int x; +} d; +#endif // 0/1 + +// not allowed +// struct E __attribute__((packed)) { +// int x; +// }; + +// 8/31/03: also need it to work with anonymous structs +struct __attribute__((__packed__)) { + int i; + char c; +} e; + + +typedef unsigned long ULONG; +typedef int WCHAR; +typedef struct __attribute__((packed, aligned(4))) _INFORMATION { + ULONG FileAttributes; + ULONG FileNameLength; + WCHAR FileName[1]; +} INFORMATION, *PINFORMATION; + +INFORMATION i; +PINFORMATION pi; + +int main() +{ + return 0; +} diff --git a/cil/test/small2/structattr2.c b/cil/test/small2/structattr2.c new file mode 100644 index 0000000..e1e5937 --- /dev/null +++ b/cil/test/small2/structattr2.c @@ -0,0 +1,62 @@ +// structattr2.c +// another structure/attribute example +// from sac at stevechamberlain dot com + +#include "../small1/testharness.h" + +// should associate 'const' with 'b' and 'e', but not 'c' +const struct c { int a; } b, e; + +// so that now, 'd' is *not* const +struct c d; + + +// Same here +struct c2 { int a; } const b2, e2; + +struct c2 d2; + + +// this const has no effect +struct c3 { int a; } const; +struct c3 b3, e3; + +// nor does this one +const struct c4 { int a; }; +struct c4 b4, e4; + +struct __attribute__((packed)) c5 { char c; int a; } b5, e5; +struct c5 d5; + +struct c6 { char c; int a; } __attribute__((packed)) b6, e6; +struct c6 d6; + +struct c7 { char c; int a; } __attribute__((packed)); +struct c7 b7; + +struct c8 { char c; int a; }; +struct c8 b8; + +TESTDEF baseline: success + +TESTDEF archspecific: success + +int main() { + e.a++; //KEEP const1: error + d.a++; + e2.a++; //KEEP const2: error + d2.a++; + e3.a++; + e4.a++; +IFTEST archspecific + //These tests work on a 32-bit machine: + if (sizeof(e5) != 5) E(5); + if (sizeof(d5) != 5) E(15); + if (sizeof(e6) != 5) E(6); + if (sizeof(d6) != 5) E(16); + if (sizeof(b7) != 5) E(7); + if (sizeof(b8) != 8) E(8); +ENDIF + return 0; + } + diff --git a/cil/test/small2/structattr3.c b/cil/test/small2/structattr3.c new file mode 100644 index 0000000..d20769f --- /dev/null +++ b/cil/test/small2/structattr3.c @@ -0,0 +1,10 @@ +// structattr3.c +// yet more experiments + + +struct S { char a; } __attribute__((aligned(8))) const x = {1}; + +struct S y[10] = {1,2,3}; +int z = 5; + +int main() { return 0; } diff --git a/cil/test/small2/switch.c b/cil/test/small2/switch.c new file mode 100644 index 0000000..e57c453 --- /dev/null +++ b/cil/test/small2/switch.c @@ -0,0 +1,64 @@ +#include "../small1/testharness.h" + +//the file should compile without changes. +TESTDEF baseline: success + +// Testing some ugly switch cases +int foo(int x, int y) { + switch(x) { + y = "who runs this?"[3]; + exit(1); + default: + default: //KEEP dupDefault1: error = duplicate default + y ++; + goto L1; + case 1: + L2: + case 20: + y ++; + break; + y ++; + L1: + if(y > 5) { + case 7: + x ++; + } else { + while(x < 33) { + default: //KEEP dupDefault2: error = duplicate default + case 9: + x ++; + break; + } + break; + } + + goto L2; + } + if(x < 30) + goto L1; + return x + y; +} + +//braces aren't required. +// (the two cases and the return are in the same statement.) +int bar(int i) { + switch (i) + case 0: + case 1: + return i; + return 0; +} + +int main() { + int one = bar(1) + bar(2); + int res = + one + + foo(1, 2) + + 17 * foo(9, 5) + + 126 * foo(7, 2) + + 3037 * foo(15, 9); + printf("Result is: %d\n", res); + if(res != 171822) + exit(1); + return 0; +} diff --git a/cil/test/small2/tagfile.txt b/cil/test/small2/tagfile.txt new file mode 100644 index 0000000..0977956 --- /dev/null +++ b/cil/test/small2/tagfile.txt @@ -0,0 +1,11 @@ +# tagfile.txt +# lists all the functions to tag +# (hash isn't really a comment, but any line with a leading hash +# is sure not to match any function name) + +# blank lines should be ok too + +foo + +# end of tagfile.txt + diff --git a/cil/test/small2/tagfile1.c b/cil/test/small2/tagfile1.c new file mode 100644 index 0000000..08cae97 --- /dev/null +++ b/cil/test/small2/tagfile1.c @@ -0,0 +1,21 @@ +// tagfile1.c +// first half of a tagfile tester + +// perfectly ordinary definition +int foo(int x) +{ + return x+7; +} + +#ifdef STATIC_FUNC +// wrong function type +typedef void (*VoidFn)(); + +// static function definition that will provoke a descriptor +static int bar(int *p) +{ + VoidFn vf; + vf = (VoidFn)bar; + return *p; +} +#endif // STATIC_FUNC diff --git a/cil/test/small2/tagfile2.c b/cil/test/small2/tagfile2.c new file mode 100644 index 0000000..1d075e1 --- /dev/null +++ b/cil/test/small2/tagfile2.c @@ -0,0 +1,29 @@ +// tagfile2.c +// second half of a tagfile tester + +// external decl of function in tagfile1.c +int foo(int x); + +typedef void (*VoidFn)(); + +int main() +{ + VoidFn tagMaker; + int x; + + tagMaker = (VoidFn)&foo; // make CCured tag 'foo' + x = foo(3); // but call it normally + + return x-10; // should be 0 +} + + +#ifdef STATIC_FUNC +// static function definition that will provoke a descriptor +static int bar(int *p) +{ + VoidFn vf; + vf = (VoidFn)bar; + return *p; +} +#endif // STATIC_FUNC diff --git a/cil/test/small2/testbtree.c b/cil/test/small2/testbtree.c new file mode 100644 index 0000000..3e9c042 --- /dev/null +++ b/cil/test/small2/testbtree.c @@ -0,0 +1,60 @@ +/***********************************************************************\ +| | +| B+tree function tests | +| | +| | +| Jan Jannink created 12/22/94 revised 1/30/95 | +| | +\***********************************************************************/ + +#include +#include +#include "btree.h" + + +#ifdef _MSVC + #define CLOCKS_PER_SEC 1000 + typedef long clock_t; + clock_t __cdecl clock(void); +#else + int clock(void); +#endif + +#define TIMESTART(clk) {clk=(double)clock();} +#define TIMESTOP(clk) {clk=1000000.0 * \ + ((double)clock()-(clk))/CLOCKS_PER_SEC;} + + +int main(void) +{ + Tree *Bplus; + Nptr keyNode; + int i, j; + double clk; + + TIMESTART(clk); + + Bplus = initBtree(ARRAY_SIZE, MAX_FAN_OUT, compareKeys); + for (i = 0; i < 20000; i++) { + j = rand(); + if (search(Bplus, j) == NONODE) { + insert(Bplus, j); + //fprintf(stderr, "XXX %d, insert %d XXX\n", i, j); + } + else { + delete(Bplus, j); + //fprintf(stderr, "XXX %d, delete %d XXX\n", i, j); + } + // if (i > 2000) { listAllBtreeValues(Bplus); } + } + for (i = 0; i < 1505600; i++) + (void) search(Bplus, i); + // listAllBtreeValues(Bplus); + freeBtree(Bplus); + + TIMESTOP(clk); + printf("Run btreetest in %8.3lfms\n", clk / 1000.0); + + return 0; +} + diff --git a/cil/test/small2/thing.c b/cil/test/small2/thing.c new file mode 100644 index 0000000..2a2ac0b --- /dev/null +++ b/cil/test/small2/thing.c @@ -0,0 +1,15 @@ +// thing.c +// strange casts to 'void' on pointer comparisons?? + +struct Thing *thing; + +int test() +{ + return thing == 0; +} + +int main() +{ + test(); + return 0; +} diff --git a/cil/test/small2/transpunion.c b/cil/test/small2/transpunion.c new file mode 100644 index 0000000..8b3c1d4 --- /dev/null +++ b/cil/test/small2/transpunion.c @@ -0,0 +1,37 @@ +// transparent unions? + +struct BoxedInt { + int x; +}; + +typedef union { + int *intPtr; + struct BoxedInt *boxedPtr; +} CompatArgUnion __attribute__((__transparent_union__)); + +extern int compatFunc(int, CompatArgUnion); + +int compatFunc(int firstArg, CompatArgUnion secondArg) +{ + return firstArg + *(secondArg.intPtr); +} + + +int main() +{ + int i = 6; + struct BoxedInt b; + int ret = 0; + + b.x = 7; + + // today I pass an int ptr + ret += compatFunc(-6, &i); + + // tomorrow I pass a ptr to a struct with an embedded int + ret += compatFunc(-7, &b); + + return ret; +} + + diff --git a/cil/test/small2/trivial-tb.c b/cil/test/small2/trivial-tb.c new file mode 100644 index 0000000..3a09265 --- /dev/null +++ b/cil/test/small2/trivial-tb.c @@ -0,0 +1,25 @@ +// trivial-tb.c +// NUMERRORS 4 +// test the test-bad target and lib/test-bad script + +#include // printf +#include // exit + +void fail(int val) +{ + printf("fail(%d)\n", val); + exit(val); +} + +int main() +{ + fail(1); // ERROR(1) + fail(2); // ERROR(2) + fail(3); // ERROR(3) + fail(4); // ERROR(4) + + printf("no failure\n"); + return 0; +} + + diff --git a/cil/test/small2/try1.c b/cil/test/small2/try1.c new file mode 100755 index 0000000..2576a56 --- /dev/null +++ b/cil/test/small2/try1.c @@ -0,0 +1,64 @@ +#include "../small1/testharness.h" + +#include + +// NUMERRORS 3 + +// This is for MSVC +#ifndef _MSVC +error This test works only for MSVC +#endif + +int throw() { + // Simulate a segfault + { __NOCUREBLOCK + // We do not want CCured to notice this one + *((int*)0) = 5; + } +} + +void incr(int *px) { + *px = 1 + *px; +} + +int main() { + + int i = 0; + + __try { + i ++; + } __finally { + i --; + } + +#if ERROR >= 1 && ERROR <= 2 + __try { + i ++; + throw (); // ERROR2 + } __except(i +=5, EXCEPTION_EXECUTE_HANDLER) { + i --; + } + if(i == 1) E(1); // ERROR1:Error 1 + if(i == 5) E(2); // ERROR2:Error 2 +#endif + +#if ERROR >= 3 + __try { + __try { + i ++; + throw (); + } __except(i ++, EXCEPTION_CONTINUE_SEARCH) { + E(3); // Should not get here + } + } __except(incr(&i), incr(&i), EXCEPTION_EXECUTE_HANDLER) { + if(i == 4) E(32); // ERROR3:Error 32 + } + E(31); +#endif + + if(i != 0) E(100); // ERROR0 + + SUCCESS; +} + + diff --git a/cil/test/small2/twoprintfs.c b/cil/test/small2/twoprintfs.c new file mode 100644 index 0000000..1dd8be9 --- /dev/null +++ b/cil/test/small2/twoprintfs.c @@ -0,0 +1,15 @@ +// call a function twice, which does printf of a literal string + +#include // printf + +void pr() +{ + printf("hi there\n"); +} + +int main() +{ + pr(); + pr(); + return 0; +} diff --git a/cil/test/small2/typeof.c b/cil/test/small2/typeof.c new file mode 100644 index 0000000..b51ec03 --- /dev/null +++ b/cil/test/small2/typeof.c @@ -0,0 +1,21 @@ +// simple use of typeof + +int globalInt; + +void y() { + exit(-2); //make sure y() is not invoked! +} + +void typeofVoid() { + (typeof(y()))0; +} + + +int main() +{ + __typeof(globalInt) localInt; + typeofVoid(); + localInt = 6 * 2 - 12; + return localInt; +} + diff --git a/cil/test/small2/undef_func.c b/cil/test/small2/undef_func.c new file mode 100644 index 0000000..5dadf1a --- /dev/null +++ b/cil/test/small2/undef_func.c @@ -0,0 +1,8 @@ +// Demonstrate what happens when you call a function that is not +// defined. + +int main() { + int a = 3; + gronkwaerawerawerwae(a); + return 0; +} diff --git a/cil/test/small2/uninit_tmp.c b/cil/test/small2/uninit_tmp.c new file mode 100644 index 0000000..a41bf0d --- /dev/null +++ b/cil/test/small2/uninit_tmp.c @@ -0,0 +1,39 @@ +// uninit_tmp.c +// demonstrate a CIL bug with commas and function calls + +void * function_of_interest(int x, int y) +{ + return (void*)5; +} + +struct struct_one *bad_function(struct struct_one *os, long x) +{ + auto const struct struct_two *other_variable; + + auto const struct struct_of_interest *variable_of_interest; + + variable_of_interest = + ( + other_variable = 0, + + (const struct struct_of_interest *) function_of_interest(0, 0) + ); + + return (struct struct_one*)variable_of_interest; +} + +int main() +{ + struct struct_one *p; + + p = bad_function(0,0); + + if (p != (struct struct_one*)5) { + printf("cil bug is still present\n"); + return 2; + } + else { + printf("bug has been fixed!\n"); + return 0; + } +} diff --git a/cil/test/small2/union2.c b/cil/test/small2/union2.c new file mode 100644 index 0000000..90f4eb1 --- /dev/null +++ b/cil/test/small2/union2.c @@ -0,0 +1,98 @@ +#include "../small1/testharness.h" +#include "../small1/testkinds.h" + +// NUMERRORS 12 + +union unsafeu1 { + int *f1; + int *f2[2]; + struct { int *a1, a2, *a3; } f3; + /* unsafe union: a2 and f2[1] */ +} * x; + +union unsafeu2 { + int *g1; + struct { int *b1, b2; } g2; + struct { int *c1, *c2, *c3; } g3; + /* unsafe union: c2 and b2 */ +} * y; + +union safeu { + int a[2]; + char b[8]; + // safe union: all scalars +} * z; + +union safeu2 { + struct { int a; int *b; } s1; + struct { int c; int *d; } s2; +} same, *sptr; + + +int main() { + if(HAS_KIND(x->f1, WILD_KIND)) E(1); //ERROR(1):Error 1 + // x will be SAFE because it is not used at all to access the fields + if(HAS_KIND(x, SAFE_KIND)) E(12); //ERROR(12):Error 12 + if(HAS_KIND(y->g1, WILD_KIND)) E(2); //ERROR(2):Error 2 + if(HAS_KIND(z, SAFE_KIND)) E(3); //ERROR(3):Error 3 +#if ERROR == 4 + sptr = &same; + sptr->s1.b++; + if(HAS_KIND(sptr->s2.d, FSEQ_KIND)) E(4); //ERROR(4):Error 4 +#endif +#if ERROR == 5 + sptr = &same; + sptr->s2.d--; + if(HAS_KIND(sptr->s1.b, SEQ_KIND)) E(5); //ERROR(5):Error 5 +#endif +#if ERROR == 6 + sptr = &same; + y = sptr->s2.d; // makes things WILD + if(HAS_KIND(sptr->s1.b, WILD_KIND)) E(6); //ERROR(6):Error 6 +#endif +#if ERROR == 7 + sptr = &same; + y = sptr->s1.b; // makes things WILD + if(HAS_KIND(sptr, SAFE_KIND)) E(7); //ERROR(7):Error 7 +#endif + { + // These two unions should be fine + union { + struct { int a; int b; int c; } one; + struct { int p; int q; int r; int *s; } two; + } *aa; + union { + struct { int a; int b; } one; + struct { int p; int q; int *s; } two; + } *bb; +#if ERROR == 8 + aa = bb; + if(HAS_KIND(aa, WILD_KIND)) E(8); //ERROR(8):Error 8 +#endif +#if ERROR == 9 + bb = aa; + if(HAS_KIND(aa, WILD_KIND)) E(9); //ERROR(9):Error 9 +#endif + } + { + // These two unions should be fine + union ulong { + struct { int a; int b; int c; } one; + struct { int p; int q; int r; int s; } two; + } adata, *aa = &adata; + union ushort { + struct { int a; int b; } one; + struct { int p; int q; int s; } two; + } bdata, *bb = &bdata; +#if ERROR == 10 + // Since aa is longer, the bb will have to be FSEQ to be able to check the + // length + aa = bb; //ERROR(10):Failure UBOUND +#endif +#if ERROR == 11 + bb = aa; + if(HAS_KIND(aa, SAFE_KIND)) E(11); //ERROR(11):Error 11 +#endif + } + SUCCESS; +} diff --git a/cil/test/small2/union4.c b/cil/test/small2/union4.c new file mode 100644 index 0000000..53feb96 --- /dev/null +++ b/cil/test/small2/union4.c @@ -0,0 +1,91 @@ +#include "../small1/testharness.h" + +#define NUMERRORS 3 + +/* A test case with tagged unions */ +#ifndef __TAGGED + #define __TAGGED +#endif + +union u { + int f1; + int* f2; + struct { + int *f3_1; + int *f3_2; + } f3; + int* (*f4)(int*); + char f5; +} __TAGGED; + +int* foo(int *x) { return x;} + +int main() { + int i, i1; + union u x; + union u *px = &x; +#if ERROR == 0 + //x is uninitialized: + if (CCURED_HASUNIONTAG(x.f1)) E(11); + if (CCURED_HASUNIONTAG(x.f2)) E(12); + if (CCURED_HASUNIONTAG(x.f3)) E(13); + if (CCURED_HASUNIONTAG(x.f4)) E(14); + if (CCURED_HASUNIONTAG(x.f5)) E(15); + + x.f1 = 5; + if(x.f1 != 5) E(1); + if (!CCURED_HASUNIONTAG(x.f1)) E(16); + + x.f5 = 20; + if(x.f5 != 20) E(1); + if (!CCURED_HASUNIONTAG(x.f5)) E(17); + + x.f2 = &i; + if(px->f2 != &i) E(2); + if (CCURED_HASUNIONTAG(x.f4)) E(18); + if (!CCURED_HASUNIONTAG(x.f2)) E(19); + + //writing to f3.f3_2 should clear f3.f3_1 + x.f3.f3_2 = &i1; + if (x.f3.f3_1 != 0) E(3); + //but writing to f3 again should not clear f3_2! + x.f3.f3_1 = &i; + if(x.f3.f3_2 != &i1) E(4); + + // And some trick with the thing appearing both on left and right-side + x.f2 = x.f3.f3_1; + if(px->f2 != &i) E(5); + + // Same for a function call + x.f3.f3_1 = &i; + x.f2 = x.f3.f3_1; // Make sure we check the read before the write + if (x.f2 != &i) E(6); + + x.f4 = foo; + x.f2 = x.f4(&i); // make sure that we check the read before the write +#endif + + // Try to provoke some errors +#if ERROR == 1 + x.f1 = 5; + i = * x.f2; // ERROR(1): wrong union field +#endif + +#if ERROR == 2 + // We should not be allowed to take the address of a tagged field + i1 = & px->f1; // ERROR(2): cannot take the address +#endif + +#if ERROR == 3 + { + struct s { + union u u1; + } x; + i = & x.u1.f1; // ERROR(3): cannot take the address + } +#endif + + if(! HAS_KIND(px, SAFE_KIND)) E(10); + + SUCCESS; +} diff --git a/cil/test/small2/union5.c b/cil/test/small2/union5.c new file mode 100644 index 0000000..bf3c692 --- /dev/null +++ b/cil/test/small2/union5.c @@ -0,0 +1,35 @@ +#include "../small1/testharness.h" + +#ifndef HAS_KIND +#define HAS_KIND(x, y) 1 +#endif + +typedef unsigned char MzU8; +typedef unsigned short MzU16; +typedef unsigned int MzU32; +typedef MzU32 MzEventSupp; +struct key_pressed { + MzU8 repeatCount ; +}; +struct char_char { + MzU8 repeatCount ; +}; +struct pointer_moved { + unsigned int lButton : 1 ; + unsigned int mButton : 1 ; + unsigned int rButton : 1 ; +}; +union supp { + MzEventSupp supp ; + struct key_pressed key_pressed ; + struct char_char char_char ; + struct pointer_moved pointer_moved ; +}; + + +int main() { + union supp *p; + if(! HAS_KIND(p, SAFE_KIND)) E(1); + + SUCCESS; +} diff --git a/cil/test/small2/union6.c b/cil/test/small2/union6.c new file mode 100644 index 0000000..f8fa304 --- /dev/null +++ b/cil/test/small2/union6.c @@ -0,0 +1,54 @@ +#include "../small1/testharness.h" + +// NUMERRORS 3 + +union { //size = 12 + struct { + int *a, *b; + } f1; + int f2; + + // An ugly, unrealistic case + struct { //size = 12 + union { //size = 8 + int x; + struct { //size = 8 + int* s1; + int* s2; + } s; + } __TAGGED f3_u; + int f3_int; + } f3; + +} __TAGGED u; + +int i; + +int main() { + + u.f2 = 5; // now u.f1.a = 5 + u.f1.b = &i; // now the tag says that u.f1 is active + + i = * u.f1.a; //ERROR(1): Null pointer + + u.f2 = 5; // now u.f3.f3_u.s.s1 = 5 + + //Union in a union. This will clear the f3 struct and (redundantly) the + // f3.f3_u.s struct. + + u.f3.f3_u.s.s2 = &i; +#if ERROR == 0 + if (u.f3.f3_u.s.s2 != &i) E(1); + if (u.f3.f3_u.s.s1 != 0) E(2); + if (u.f3.f3_int != 0) E(3); + if (! CCURED_HASUNIONTAG(u.f3.f3_u.s.s1)) E(4); + if (CCURED_HASUNIONTAG(u.f3.f3_u.x)) E(5); + if (CCURED_HASUNIONTAG(u.f1.a)) E(6); + +#else + i = * u.f3.f3_u.s.s1; //ERROR(2): Null pointer + i = * u.f1.b; //ERROR(3): WRONGFIELD +#endif + + SUCCESS; +} diff --git a/cil/test/small2/union7.c b/cil/test/small2/union7.c new file mode 100755 index 0000000..154cf68 --- /dev/null +++ b/cil/test/small2/union7.c @@ -0,0 +1,133 @@ +#include "../small1/testharness.h" + +// NUMERRORS 19 + +enum tags { + TAG_ZERO = 0, +}; + +struct host { + int tag; // 0 for integer, 1 for int*, 2 for structure, 3 if tag2 choses + char tag2; //If tag is 3, then 0 for int, 1 for int* + + union bar { + int anint __SELECTEDWHEN(tag == TAG_ZERO); + int * ptrint __SELECTEDWHEN(tag == 1); + struct str { + int * * ptrptr; + } ptrptr + __SELECTEDWHEN(tag == 5) // ERROR(0) + /* missing selected when */ // ERROR(1):Error 1 + __SELECTEDWHEN(tag == foo) // ERROR(2):Cannot compile the discriminator + __SELECTEDWHEN(tag_bad == 5) // ERROR(3):Cannot compile the discriminator + __SELECTEDWHEN(tag == 5) __SELECTEDWHEN(tag == 6) // ERROR(4):more than one SELECTEDWHEN clause + __SELECTEDWHEN(somethingelse == 5) // ERROR(5):does not have an integer type +#if ERROR >= 6 + __SELECTEDWHEN(tag == 5) +#endif + ; + int *disj __SELECTEDWHEN(tag == 10 || tag == 11); + int *conj __SELECTEDWHEN(tag >= 15 && tag <= 17); + + int int2 __SELECTEDWHEN(tag == 3 && tag2 == 0); + int * ptr2 __SELECTEDWHEN(tag == 3 && tag2 == 1); + } data; + + //A second union that uses the same tags. + union foo { + int fooint __SELECTEDWHEN(tag == TAG_ZERO); + int * fooptrint __SELECTEDWHEN(tag == 1); + } data2; + + struct { + int x; + } somethingelse; +} g; + + +int x; +int * px = &x; + +int one() { return 1; } + +int main() { + + g.tag = 0; + + // This is good behavior + +#if ERROR == 0 + g.data.anint = 5; + x = g.data.anint; + + + g.tag = 1; + g.data2.fooptrint = px; + px = g.data2.fooptrint; + + g.tag = 5; + g.data.ptrptr.ptrptr = &px; + x = * * g.data.ptrptr.ptrptr; + + g.tag = 3; g.tag2 = 1; + g.data.ptr2 = px; + px = g.data.ptr2; + + // This is allowed because we are not reading a pointer + // matth: this is no longer allowed. We enforce all discriminators + //g.tag = 1; x = g.data.anint; + +#endif + + if(KIND_OF(g.data.ptrint) != SAFE_KIND) E(1);// ERROR(1) + + + // We cannot access pointers when the tag is wrong + g.tag = 0; x = g.data.ptrint; // ERROR(19):Failure WRONGFIELD + g.tag = 0; * g.data.ptrptr.ptrptr = x; // ERROR(6):Failure WRONGFIELD + g.tag = 0; { struct str s = g.data.ptrptr; } // ERROR(7):Failure WRONGFIELD + +#if ERROR == 8 + { + union { + int * ptr __SELECTEDWHEN(tag); + } a; + // We should not be able to acces this one + // ERROR(8):outside a host structure + px = a.ptr; + } +#endif + + // We cannot take the address of fields in discriminated unions + px = & g.data.anint; // ERROR(9):cannot take the address of a field + // We cannot take the address of a field in a subfield + { int * * * a = & g.data.ptrptr.ptrptr; } // ERROR(10):cannot take the address of a field + + // We can take the address of a non-discriminated field + px = & g.somethingelse.x; E(11); // ERROR(11):Error 11 + +#if ERROR >= 12 && ERROR <= 14 + g.tag = 10;px = g.data.disj; E(12); // ERROR(12):Error 12 + g.tag = 11;px = g.data.disj; E(13); // ERROR(13):Error 13 + g.tag = 12;px = g.data.disj; // ERROR(14):Failure WRONGFIELD +#endif + +#if ERROR >= 15 && ERROR <= 18 + g.tag = 10;px = g.data.conj; // ERROR(15):Failure WRONGFIELD + g.tag = 15;px = g.data.conj; E(16); // ERROR(16):Error 16 + g.tag = 16;px = g.data.conj; E(17); // ERROR(17):Error 17 + g.tag = 18;px = g.data.conj; // ERROR(18):Failure WRONGFIELD +#endif + + // When we switch tags we clear the pointers. + g.tag = 1; + g.data.ptrint = &x; + g.tag = one(); //This doesn't change the tag, so no need to clear g.data + if (g.data.ptrint != &x) E(98); + + g.tag = 5; //should clear g.data + if(g.data.ptrptr.ptrptr != 0) E(99); + + SUCCESS; +} + diff --git a/cil/test/small2/union8.c b/cil/test/small2/union8.c new file mode 100755 index 0000000..b240f10 --- /dev/null +++ b/cil/test/small2/union8.c @@ -0,0 +1,98 @@ +//Make sure everything runs as is +//KEEP baseline: success + +#include "../small1/testharness.h" + + +typedef struct parent { + void * __RTTI * vtbl; + int *fseq; + int *f1; +} Parent; + +#pragma ccured_extends("Schild", "Sparent") + +typedef struct child { + void * __RTTI * vtbl; + int * __FSEQ fseq; + int *f1; + int f2; +} Child; + + +//OpenSSL does casts between union fields like this. +union { + int i; + void* vp; + int* ip; + char* str; + double d; + Parent * __RTTI pp; + Child * cp; + int** ptrptr; +} __TAGGED u; + +int global[11]; + +int* foo(int* x) { return x; } + +int main() { + Child carray[5]; + Parent parray[2]; + + u.ip = foo(&global[0]); + unsigned long x = u.vp; + x += u.i; + u.ip++; //KEEP fseq: success + x += *u.ip; + + u.i = x; //KEEP wrongfield: error = wrong union field + void* __RTTI v = u.vp; + + u.str = "literal"; //KEEP str: success + v = u.vp; //KEEP str + printf((char*)v); //KEEP str + + u.cp = &carray[2]; + Parent * __RTTI p= u.pp; + if (__endof(p) != (unsigned long)(carray + 5)) E(2); //KEEP fseq + Child * c = p; + c++; //KEEP fseq + x += c->f2; + + u.vp = p; //make sure we preserve the RTTI. + x += u.cp->f2; + + u.d = 1.0 / 10; //DROP double: error = wrong union field + double dd = u.d; + + //Use a union to cast an int* __FSEQ * to void* __RTTI, and back to int**. + //Make sure the right compatibility edges are added. + int * z2 = &global[0]; + int* __FSEQ z = global; //KEEP ptrptr: success + u.ptrptr = &z; //KEEP ptrptr + void * __RTTI r = u.vp; //KEEP ptrptr + *((int**)r) = z2; // z2 should be FSEQ! //KEEP ptrptr + if (KIND_OF(z) != FSEQ_KIND) E(3); //KEEP ptrptr + if (KIND_OF(z2) != FSEQ_KIND) E(4); //KEEP ptrptr + + if (KIND_OF(z2) != SAFE_KIND) E(5); //DROP ptrptr + + //The dual of the above test: RTTI first, then the union. + int * z3 = &global[0]; + void * __RTTI r = &z3; //KEEP ptrptr2: success + u.vp = r; //KEEP ptrptr2 + int* __FSEQ z = global; //KEEP ptrptr2 + (*(u.ptrptr))++; //KEEP ptrptr2 + // u.ptrptr (and therefore z3) should be FSEQ! + if (KIND_OF(z) != FSEQ_KIND) E(6); //KEEP ptrptr2 + if (KIND_OF(z3) != FSEQ_KIND) E(7); //KEEP ptrptr2 + + if (KIND_OF(z3) != SAFE_KIND) E(8); //DROP ptrptr2 + + int* __FSEQ z = global; + void* __RTTI r = &z; + + + SUCCESS; +} diff --git a/cil/test/small2/unionassign.c b/cil/test/small2/unionassign.c new file mode 100644 index 0000000..2dc0b19 --- /dev/null +++ b/cil/test/small2/unionassign.c @@ -0,0 +1,88 @@ +// unionassign.c +// assign a union variable to another union variable + + +// ------------------ this part works ----------------------- +struct S1 { + int x; +}; + +struct S2 { + char p; +}; + +struct S3 { + int x1; + int y1; +}; + +union U { + struct S1 s1; + struct S2 s2; + struct S3 s3; +}; + +int main() +{ + union U x,y; + x.s1.x = 5; + y = x; + return y.s1.x - 5; +} + + + +// ------------------- this part fails ------------------- +typedef unsigned short int sa_family_t ; +typedef unsigned char uint8_t ; +typedef unsigned short int uint16_t ; +typedef unsigned int uint32_t ; + +struct in_addr { + uint32_t s_addr ; +} ; + +struct sockaddr { + sa_family_t sa_family ; + char sa_data[14] ; +} ; + +struct sockaddr_in { + sa_family_t sin_family ; + uint16_t sin_port ; + struct in_addr sin_addr ; + unsigned char sin_zero[sizeof(struct sockaddr ) - + sizeof(unsigned short int ) - sizeof(uint16_t ) - + sizeof(struct in_addr )] ; +} ; + +struct in6_addr { + union { + uint8_t u6_addr8[16] ; + uint16_t u6_addr16[8] ; + uint32_t u6_addr32[4] ; + } in6_u ; +} ; + +struct sockaddr_in6 { + sa_family_t sin6_family ; + uint16_t sin6_port ; + uint32_t sin6_flowinfo ; + struct in6_addr sin6_addr ; +} ; + +union sockunion { + struct sockinet { + sa_family_t si_family ; + uint16_t si_port ; + } su_si ; + struct sockaddr_in su_sin ; + struct sockaddr_in6 su_sin6 ; +} ; + +int foo() +{ + union sockunion x,y; + x = y; + return 3; +} diff --git a/cil/test/small2/unionext.c b/cil/test/small2/unionext.c new file mode 100644 index 0000000..1ca6786 --- /dev/null +++ b/cil/test/small2/unionext.c @@ -0,0 +1,21 @@ +// union decl in a compound statement expression + +int main() +{ + int status; + + return + ( + (__extension__ + ({ + union { + __typeof( status ) __in; + int __i; + } __u; + + __u.__in = status; + __u.__i; + }) + ) & 0xff00 + ) >> 8 ; +} diff --git a/cil/test/small2/unscomp.c b/cil/test/small2/unscomp.c new file mode 100644 index 0000000..553012e --- /dev/null +++ b/cil/test/small2/unscomp.c @@ -0,0 +1,28 @@ +// unscomp.c +// show problem with linux/fs/buffer.c and unsigned comparisons + +#include // printf +int main() +{ + unsigned long size; + long offset; + + size = 1024; + offset = 50; + + if ((offset -= size) >= 0) { + // 50 - 1024 is negative + printf("no -- this is wrong\n"); + return 2; + } + + // Now a similar thing. The result of the subtraction is unsigned + // and so is the comparison + offset = 50; + if(offset - size < 0) { + printf("This is also wrong\n"); return 3; + } + + printf("yes this is right\n"); + return 0; +} diff --git a/cil/test/small2/visit_col.c b/cil/test/small2/visit_col.c new file mode 100644 index 0000000..ea7f436 --- /dev/null +++ b/cil/test/small2/visit_col.c @@ -0,0 +1,131 @@ + +typedef struct sm_element_struct sm_element; +typedef struct sm_row_struct sm_row; +typedef struct sm_col_struct sm_col; +typedef struct sm_matrix_struct sm_matrix; + + + + +struct sm_element_struct { + int row_num; + int col_num; + sm_element *next_row; + sm_element *prev_row; + sm_element *next_col; + sm_element *prev_col; + char *user_word; +}; + + + + + +struct sm_row_struct { + int row_num; + int length; + int flag; + sm_element *first_col; + sm_element *last_col; + sm_row *next_row; + sm_row *prev_row; + char *user_word; +}; + + + + + +struct sm_col_struct { + int col_num; + int length; + int flag; + sm_element *first_row; + sm_element *last_row; + sm_col *next_col; + sm_col *prev_col; + char *user_word; +}; + + + + + +struct sm_matrix_struct { + sm_row **rows; + int rows_size; + sm_col **cols; + int cols_size; + sm_row *first_row; + sm_row *last_row; + int nrows; + sm_col *first_col; + sm_col *last_col; + int ncols; + char *user_word; +}; + + + + + + + + + +static int +visit_row(A, prow, rows_visited, cols_visited) +sm_matrix *A; +sm_row *prow; +int *rows_visited; +int *cols_visited; +{ + sm_element *p; + sm_col *pcol; + + if (! prow->flag) { + prow->flag = 1; + (*rows_visited)++; + if (*rows_visited == A->nrows) { + return 1; + } + for(p = prow->first_col; p != 0; p = p->next_col) { + pcol = ((( p->col_num ) >= 0 && ( p->col_num ) < ( A )->cols_size) ? ( A )->cols[ p->col_num ] : (sm_col *) 0) ; + if (! pcol->flag) { + if (visit_col(A, pcol, rows_visited, cols_visited)) { + return 1; + } + } + } + } + return 0; +} + + +int +visit_col(A, pcol, rows_visited, cols_visited) +sm_matrix *A; +sm_col *pcol; +int *rows_visited; +int *cols_visited; +{ + sm_element *p; + sm_row *prow; + + if (! pcol->flag) { + pcol->flag = 1; + (*cols_visited)++; + if (*cols_visited == A->ncols) { + return 1; + } + for(p = pcol->first_row; p != 0; p = p->next_row) { + prow = ((( p->row_num ) >= 0 && ( p->row_num ) < ( A )->rows_size) ? ( A )->rows[ p->row_num ] : (sm_row *) 0) ; + if (! prow->flag) { + if (visit_row(A, prow, rows_visited, cols_visited)) { + return 1; + } + } + } + } + return 0; +} diff --git a/cil/test/small2/voidstarint.c b/cil/test/small2/voidstarint.c new file mode 100644 index 0000000..feea926 --- /dev/null +++ b/cil/test/small2/voidstarint.c @@ -0,0 +1,121 @@ +#include "../small1/testharness.h" +#include "../small1/testkinds.h" +#include + +/* weimer + * Mon Aug 5 13:28:25 PDT 2002 + * + * This represents my best efforts to somehow sneak an integer into a + * pointer via a void*. + * + * Note that derefing such a pointer sometimes gives "ubound" and sometimes + * gives "reading a pointer that has been tampered with". + * + * GN: adjusted to expect Non-pointer error messages. + */ + +// NUMERRORS 8 + +int function() { +#if ERROR == 1 + { + int i1 = 5; + void **vi5 = &i1; + void *vi6 = vi5; + int * * pi2 = vi5; + return * * pi2; //ERROR(1):Non-pointer + } +#endif +#if ERROR == 2 + { + struct { int a; int b; } c; + void **v1 = &c; + void *v2 = v1; + int **p = v2; + c.a = 5; + return **p; //ERROR(2):Reading + } +#endif +#if ERROR == 3 + { + struct { int a; int b; } c; + void **v1 = &c.b; + void *v2 = v1; + int **p = v2; + c.b = 5; + return **p; //ERROR(3):Non-pointer + } +#endif +#if ERROR == 4 + { + struct { struct { int a; int b; } c ; int d; } e; + void **v1 = &e.c.b; + void *v2 = v1; + int **p = v2; + e.c.b = 5; + return **p; //ERROR(4):Reading + } +#endif +#if ERROR == 5 + { + int i = 5; + void ****v1; + void *v2; + int ****v3; + v1 = malloc(sizeof(*v1)); + *v1 = malloc(sizeof(**v1)); + **v1 = malloc(sizeof(***v1)); + ***v1 = &i; //ERROR(5):Storing stack address + v2 = v1; + v3 = v2; + return ****v3; + } +#endif +#if ERROR == 6 + { + int i __HEAPIFY = 5; + void ****v1; + void *v2; + int ****v3; + v1 = malloc(sizeof(*v1)); + *v1 = malloc(sizeof(**v1)); + **v1 = malloc(sizeof(***v1)); + **v1 = &i; + v2 = v1; + v3 = v2; + return ****v3; //ERROR(6):Non-pointer + } +#endif +#if ERROR == 7 + { + int i __HEAPIFY = 5; + void ****v1; + void *v2; + int *****v3; + v1 = malloc(sizeof(*v1)); + *v1 = malloc(sizeof(**v1)); + **v1 = malloc(sizeof(***v1)); + ***v1 = &i; + v2 = v1; + v3 = v2; + return *****v3; //ERROR(7):Non-pointer + } +#endif +#if ERROR == 8 + { + extern int deref(void *); + int (*fptr)(void *) = deref; + int x ; + x = fptr(5); + } +#endif +} + +int deref(void *a) { + int *b = a; + return *b; //ERROR(8):Non-pointer +} + +int main() { + function(); +} diff --git a/cil/test/small2/volatilestruct.c b/cil/test/small2/volatilestruct.c new file mode 100644 index 0000000..a565855 --- /dev/null +++ b/cil/test/small2/volatilestruct.c @@ -0,0 +1,23 @@ +// volatilestruct.c +// from sac at stevechamberlain dot com + +// problem with associating attributes with structs instead +// of the declared instances + +struct foo +{ + int AAAAAAAAAAAAAAAAAAA:7; +} xxx; + +int main () +{ + struct foo + { + double BBBBBBBBBBBBBBBBBBB; + } volatile bar; + + static struct foo baz; + bar = baz; + + return 0; +} diff --git a/cil/test/small2/wes-hashtest.c b/cil/test/small2/wes-hashtest.c new file mode 100644 index 0000000..42a3e3b --- /dev/null +++ b/cil/test/small2/wes-hashtest.c @@ -0,0 +1,534 @@ +#include +#include + +#ifdef _GNUCC +#include // dup, close +#endif +#ifdef _MSVC +#include +#endif + +//#include "main.h" +/****** Data sizes ******* +* U8 must be an unsigned of 8 bits +* U16 must be an unsigned of 16 bits * +* U32 must be an unsigned of 32 bits * +* U64 must be an unsigned on 64 bits * +* UPOINT must be an unsigned of the size of a pointer +* ALIGN must be the number of bytes the data accesses must be aligned to - 1 +* i.e. it must be 3 for the data to be aligned on a 32-bit boundary. It +* must be at least 1 (16-bit alignment). It must be <= UPOINT +* ALSHIFT is log2(ALIGN + 1) +* UALIGN is the integer whose size if ALIGN + 1. +*************************/ + +typedef unsigned long UL; +typedef unsigned char UC; +typedef int BOOL; +#define TRUE 1 +#define FALSE 0 + +#define MASK(bitlen) ((1 << (bitlen)) - 1) + +#ifdef alpha_UNIX /* Both GCC and DEC cc seem to have the same */ +#define ALSHIFT 3 +#define ALIGN MASK(ALSHIFT) +#define UALIGN U64 + +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned int +#define S32 int +#define U64 unsigned long +#define S64 long +#define UPOINT U64 +#define SPOINT S64 +#define DIRLISTSEP ':' +#endif /* alpha_UNIX */ + +#ifdef x86_WIN32 +#define ALSHIFT 2 +#define ALIGN MASK(ALSHIFT) +#define UALIGN U32 + +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned long +#define S32 long +#define UPOINT U32 +#define SPOINT S32 + +#define DIRLISTSEP ';' + +#ifdef _MSVC /* MSVC on x86 */ +#define U64 unsigned __int64 +#define S64 __int64 +#endif /* _MSVC */ + +#ifdef _GNUCC /* GNU CC on x86 */ +#define U64 unsigned long long +#define S64 long long +#endif /* _GNUCC */ + +#endif /* x86_WIN32 */ + +#ifdef x86_LINUX +#define ALSHIFT 2 +#define ALIGN MASK(ALSHIFT) +#define UALIGN U32 +#define __cdecl + +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned long +#define S32 long +#define UPOINT U32 +#define SPOINT S32 +#define U64 unsigned long long +#define S64 long long +#define DIRLISTSEP ':' +#endif /* x86_WIN32 */ + +#define _ASSERT(be) {if(!(be)){fprintf(stderr,"Assertion failed on line %d in file %s\n", __LINE__, __FILE__);exit(2);}} + +#define ERR_SET +#define ERR_CHECK(v,stop,prg) +#define EXIT(v, n) exit(n) + +#define ERRLINE {fprintf(stderr, "Error at %s(%d):",__FILE__,__LINE__);\ + ERR_SET;} +#define WARNLINE {fprintf(stderr, "Warning at %s(%d):",__FILE__,__LINE__);} + +#define ERROR0(v, txt) {ERRLINE;\ + fprintf(stderr,txt);EXIT(v,1);} +#define ERROR1(v, txt, d1) {ERRLINE;\ + fprintf(stderr,txt, d1);EXIT(v,1);} + +typedef long clock_t; + clock_t __cdecl clock(void); + int __cdecl rand(void); +#ifdef _MSVC +# define CLOCKS_PER_SEC 1000 +#else +# define CLOCKS_PER_SEC 1000000 +#endif + + +#define TIMESTART(clk) {clk=(double)clock();} +#define TIMESTOP(clk) {clk=1000000.0 * ((double)clock()-(clk))/CLOCKS_PER_SEC;} + + +extern int debugMM; + +#define SETDBGOUT int _stdout; fflush(stdout);_stdout=dup(1);dup2(2,1); +#define RESTOREOUT fflush(stdout); dup2(_stdout, 1); close(_stdout); + + +extern char* __stackInit; +extern int __mmId; +#define STACK_CHECK(category) { char __probe;\ + long _pDepth = __stackInit - & __probe;\ + __MM_REPORT("stack", &__probe, _pDepth, category);} + +#define STACK_INIT { char __probe;\ + __stackInit = & __probe; __mmId = 0; } + +#define MALLOC(mallocfun, res, err, sz, type, category) {\ + long _sz = (sz);\ + (res) = (type)mallocfun(_sz);\ + if(! (res)) {\ + ERROR0(err, "Cannot malloc\n"); \ + }\ + __MM_REPORT("malloc", (res), _sz, category);} + +#define FREE(freefun, res, category) {\ + if(res) {\ + __MM_REPORT("free", (res), 0, category);\ + freefun(res); }} + +#define CALLOC(callocfun, res, err, nrelem, sz, type, category) {\ + int _nrelem = (nrelem);\ + long _sz = (sz);\ + (res) = (type)callocfun(_nrelem, _sz);\ + if(! (res)) {\ + ERROR0(err, "Cannot calloc\n"); \ + }\ + __MM_REPORT("malloc", (res), _sz * _nrelem, category);} + +#define REALLOC(res, err, sz, type, category) {\ + long _sz = (sz);\ + if((res)) { __MM_REPORT("free", (res), 0, category); }\ + (res) = (type)realloc((res), _sz);\ + if(! (res)) {\ + ERROR0(err, "Cannot realloc\n"); \ + }\ + __MM_REPORT("malloc", (res), _sz, category);} + +#define STRDUP(res, err, what, category) {\ + char* _what = what;\ + long _sz = strlen(_what) + 1;\ + (res) = strdup(_what);\ + if(! (res)) {\ + ERROR0(err, "Cannot strdup\n"); \ + }\ + __MM_REPORT("malloc", (res), _sz, category);} + +#if defined(_DEBUG) || defined(_DEBUGMM) +#define __MM_REPORT(what, where, size, category) {\ + if(debugMM) {\ + SETDBGOUT; \ + printf("*MM%d: %-6s 0x%08lx %08ld %-20s %s:%d\n", \ + __mmId ++, \ + (what), (where), (long)(size), (category),__FILE__,__LINE__);\ + RESTOREOUT; } \ + } +#else +#define __MM_REPORT(what, where, size, category) { } +#endif + +//#include "hash.h" +typedef int HASH_KEY; + + + + + +#ifdef SMALLMEM +#define BUCKETS_SHIFT 5 +#define BUCKET_SIZE 4 +#else +#define BUCKETS_SHIFT 8 +#define BUCKET_SIZE 8 +#endif + +#define NR_HASH_BUCKETS (1 << (BUCKETS_SHIFT)) /* These must be 2^k */ + + + /* A Hash entry holds a particular pair (key, + * data) */ +#define EMPTY_ENTRY 0x54854A33 + +typedef struct HashEntry { + int key; /* The key EMPTY_ENTRY is reserved for empty + * entries */ + void * data; +} HASH_ENTRY; + + /* A bucket is a list of clusters of + * HASH_ENTRIES. It behaves like a list of + * entries but it is optimized by allocating + * a cluster of entries at a time */ +typedef struct BucketData { + struct BucketData * next; + HASH_ENTRY entries[BUCKET_SIZE]; +} BUCKET_DATA; + + +typedef struct { + int size; + BUCKET_DATA * data; +} HASH_BUCKET; + + +typedef HASH_BUCKET * PHASH; + + +PHASH NewHash(void); +void FreeHash(PHASH); + + /* The following functions return TRUE if the + * particular data was already in the hash */ +int HashLookup(PHASH, HASH_KEY, void * * data); + /* If data already exists, then replace it */ +int AddToHash(PHASH, HASH_KEY, void * ); + + /* Nothing happens if the key does not exits */ +int DeleteFromHash(PHASH, HASH_KEY); + + /* Maps a function to a hash table. The last + * element is a closure. The data is + * overwritten but not placed into another + * bucket ! */ +int MapHash(PHASH, void * (* )(HASH_KEY, void * , UPOINT), + UPOINT); + + /* Returns the number of elements in the table */ +unsigned int SizeHash(PHASH); + /* Preallocates some hashes */ +int preallocateHashes(void); + /* And release them */ +int releaseHashes(void); +// End hash.h + + +unsigned SizeHash(PHASH hash) { + int i; + HASH_BUCKET * pBucket = (HASH_BUCKET * )hash; + unsigned res = 0; + for(i=0;isize; + } + return res; +} + /* A hash table is actually an array of + * NR_HASH_BUCKETS * HASH_BUCKET */ + + /* Converts a hash key to a bucket index */ +#define HashKeyToBucket(k, res) { unsigned int _t = (unsigned int)k;\ + res = 0;\ + for(res = 0;_t;_t >>= BUCKETS_SHIFT) {\ + res ^= (_t & (NR_HASH_BUCKETS - 1));\ + }} + + + /* Keep a list of pre-allocated buckets */ +#define BUCKET_CACHE_SIZE (2 * NR_HASH_BUCKETS) + +#ifdef SMALLMEM +#define BUCKET_CACHE_PREALLOC (BUCKET_CACHE_SIZE >> 2) +#else +#define BUCKET_CACHE_PREALLOC BUCKET_CACHE_SIZE +#endif + +static BUCKET_DATA * bucketCache[BUCKET_CACHE_SIZE]; +static int nextFreeBucket = 0; + + +static BUCKET_DATA * acquireHashBucket(void) { + if(nextFreeBucket == 0) { + BUCKET_DATA * buck; + MALLOC(malloc, buck, NULL, sizeof(BUCKET_DATA), BUCKET_DATA*, + "hash_bucket_data"); + return buck; + } else { + return bucketCache[-- nextFreeBucket]; + } +} + +static int releaseHashBucket(BUCKET_DATA * buck) { + if(nextFreeBucket < BUCKET_CACHE_SIZE) { + bucketCache[nextFreeBucket ++] = buck; + } else { + FREE(free, buck, "hash_bucket_data"); + } + return 0; +} + +int preallocateHashes(void) { + int i; + nextFreeBucket = 0; /* So that acquire does not steal our buckets */ + _ASSERT(BUCKET_CACHE_PREALLOC <= BUCKET_CACHE_SIZE); + for(i=0;idata; + while(bdata != NULL) { + BUCKET_DATA * t_bdata = bdata; + bdata = bdata->next; + releaseHashBucket(t_bdata); + } + } + FREE(free, h, "hash_table"); +} + +typedef enum {SET, LOOKUP, DELETE} HashOper; + +static void * ProcessHash(PHASH hin, HASH_KEY key, void * data, + int * found, HashOper oper) { + int bucket_no, i, k; + BUCKET_DATA * buck = NULL; + BUCKET_DATA * * next = NULL; + HASH_ENTRY *target = NULL; + HASH_BUCKET * h = (HASH_BUCKET * )hin; + + if(key == EMPTY_ENTRY) { key ++; } + + _ASSERT(h); + + HashKeyToBucket(key, bucket_no); /* Get the bucket number */ + next = & h[bucket_no].data; + + i = BUCKET_SIZE; + for(k=h[bucket_no].size;k > 0;) { /* Look for the data */ + HASH_ENTRY * e; + buck = *next; /* Get the next cluster */ + next = &(buck->next); /* Move one to next cluster */ + e = buck->entries; /* This is the current entry */ + for(i=0;i < BUCKET_SIZE && k > 0; k--, i++, e++) { + if(!target && e->key == EMPTY_ENTRY) target = e; + if(e->key == key) { + *found = 1; + switch(oper) { + case SET: e->data = data; return e->data; + case LOOKUP: return e->data; + case DELETE: e->data = NULL; e->key = EMPTY_ENTRY; return NULL; + } + } + } + if(k == 0) /* Not in the bucket, hence not in table */ + break; + _ASSERT(i == BUCKET_SIZE); + } + _ASSERT(k == 0); + *found = 0; /* Here if not found */ + if(oper != SET) { + return NULL; + } + if(! target) { + /* Must create a new entry */ + if(i == BUCKET_SIZE) { + if(! next) { + next = &(h[bucket_no].data); + } + _ASSERT(*next == NULL); + buck = acquireHashBucket(); + *next = buck; + buck->next = NULL; + i = 0; + } + target = &buck->entries[i]; + h[bucket_no].size ++; + } + target->key = key; + target->data = data; + return NULL; +} + + /* Lookup a hash key. Put the result in *data */ +int HashLookup(PHASH h, HASH_KEY key, void * * data) { + int found; + *data = ProcessHash(h, key, NULL, &found, LOOKUP); + return found; +} + + /* Extend the hash. If the data already exists + * then replace it*/ +int AddToHash(PHASH h, HASH_KEY key, void* data) { + int found; + ProcessHash(h, key, data, &found, SET); + return found; +} + +int DeleteFromHash(PHASH h, HASH_KEY key) { + int found; + ProcessHash(h, key, NULL, &found, DELETE); + return 0; +} + +int MapHash(PHASH h, void* (* f)(HASH_KEY, void* , UPOINT), + UPOINT closure) { + int i; + HASH_BUCKET * pBucket = (HASH_BUCKET* )h; + + for(i=0;isize; + BUCKET_DATA * pData = pBucket->data; + HASH_ENTRY * pEntry = pData->entries; + int k = 0; + for(;sz > 0;sz --, k++, pEntry++) { + if(k == BUCKET_SIZE) { + k = 0; + pData = pData->next; + pEntry = pData->entries; + } + if(pEntry->key == EMPTY_ENTRY) + continue; + pEntry->data = (*f)(pEntry->key, pEntry->data, closure); + } + } + return 0; +} + + + + + + + + +/* Some globals that PCC needs */ +int error_level, anerror; +void myexit(int n) { + exit(n); +} +#ifdef _MSVC +#define random rand +#else +/* extern int random(void); -- Weimer: not needed! */ +#endif +int __mmId; +int debugMM; +int debug; + + +#ifndef ITERS + #define ITERS 50000 +#endif + + + +int main() { + /* Test hash tables */ + PHASH h = NewHash(); + int i; + double clk; + int count = 0; + int sz; + + /* Add and delete random numbers from the hash table */ + TIMESTART(clk); + for(i=0;i +#include +#ifdef _GNUCC +#include // dup, close +#endif +#ifdef _MSVC +#include +#endif + +/* A special purpose main */ +//#include "main.h" +/****** Data sizes ******* +* U8 must be an unsigned of 8 bits +* U16 must be an unsigned of 16 bits * +* U32 must be an unsigned of 32 bits * +* U64 must be an unsigned on 64 bits * +* UPOINT must be an unsigned of the size of a pointer +* ALIGN must be the number of bytes the data accesses must be aligned to - 1 +* i.e. it must be 3 for the data to be aligned on a 32-bit boundary. It +* must be at least 1 (16-bit alignment). It must be <= UPOINT +* ALSHIFT is log2(ALIGN + 1) +* UALIGN is the integer whose size if ALIGN + 1. +*************************/ +typedef unsigned long UL; +typedef unsigned char UC; +typedef int BOOL; +#define TRUE 1 +#define FALSE 0 + +#define MASK(bitlen) ((1 << (bitlen)) - 1) + +#ifdef alpha_UNIX /* Both GCC and DEC cc seem to have the same */ +#define ALSHIFT 3 +#define ALIGN MASK(ALSHIFT) +#define UALIGN U64 + +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned int +#define S32 int +#define U64 unsigned long +#define S64 long +#define UPOINT U64 +#define SPOINT S64 +#define DIRLISTSEP ':' +#endif /* alpha_UNIX */ + +#ifdef x86_WIN32 +#define ALSHIFT 2 +#define ALIGN MASK(ALSHIFT) +#define UALIGN U32 + +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned long +#define S32 long +#define UPOINT U32 +#define SPOINT S32 + +#define DIRLISTSEP ';' + +#ifdef _MSVC /* MSVC on x86 */ +#define U64 unsigned __int64 +#define S64 __int64 +#endif /* _MSVC */ + +#ifdef _GNUCC /* GNU CC on x86 */ +#define U64 unsigned long long +#define S64 long long +#endif /* _GNUCC */ + +#endif /* x86_WIN32 */ + +#ifdef x86_LINUX +#define ALSHIFT 2 +#define ALIGN MASK(ALSHIFT) +#define UALIGN U32 + +#define U8 unsigned char +#define S8 char +#define U16 unsigned short +#define S16 short +#define U32 unsigned long +#define S32 long +#define UPOINT U32 +#define SPOINT S32 +#define U64 unsigned long long +#define S64 long long +#define DIRLISTSEP ':' +#endif /* x86_WIN32 */ + +extern void exit(int); + +#ifdef _DEBUG +#define _ASSERT(be) {if(!(be)){fprintf(stderr,"Assertion failed on line %d in file %s\n", __LINE__, __FILE__);exit(2);}} +#else +#define _ASSERT(be) +#endif + +#define ERR_SET +#define ERR_CHECK(v,stop,prg) +#define EXIT(v, n) exit(n) + +#define ERRLINE {fprintf(stderr, "Error at %s(%d):",__FILE__,__LINE__);\ + ERR_SET;} +#define WARNLINE {fprintf(stderr, "Warning at %s(%d):",__FILE__,__LINE__);} + +#define ERROR0(v, txt) {ERRLINE;\ + fprintf(stderr,txt);EXIT(v,1);} +#define ERROR1(v, txt, d1) {ERRLINE;\ + fprintf(stderr,txt, d1);EXIT(v,1);} + +typedef long clock_t; + clock_t __cdecl clock(void); + int __cdecl rand(void); +#ifdef _MSVC +# define CLOCKS_PER_SEC 1000 +#else +# define CLOCKS_PER_SEC 1000000 +#endif + +#define TIMESTART(clk) {clk=(double)clock();} +#define TIMESTOP(clk) {clk=1000000.0 * ((double)clock()-(clk))/CLOCKS_PER_SEC;} + + +extern int debugMM; + +#define SETDBGOUT int _stdout; fflush(stdout);_stdout=dup(1);dup2(2,1); +#define RESTOREOUT fflush(stdout); dup2(_stdout, 1); close(_stdout); +#ifdef _DEBUG +#define IFDEBUG(txt) {if(debug) {SETDBGOUT; txt; RESTOREOUT;}} +#else /* _DEBUG */ +#define IFDEBUG(txt) {;} +#endif /* _DEBUG */ + + +extern char* __stackInit; +extern int __mmId; +#define STACK_CHECK(category) { char __probe;\ + long _pDepth = __stackInit - & __probe;\ + __MM_REPORT("stack", &__probe, _pDepth, category);} + +#define STACK_INIT { char __probe;\ + __stackInit = & __probe; __mmId = 0; } + + + +#if defined(_DEBUG) || defined(_DEBUGMM) +#define __MM_REPORT(what, where, size, category) {\ + if(debugMM) {\ + SETDBGOUT; \ + printf("*MM%d: %-6s 0x%08lx %08ld %-20s %s:%d\n", \ + __mmId ++, \ + (what), (where), (long)(size), (category),__FILE__,__LINE__);\ + RESTOREOUT; } \ + } +#else +#define __MM_REPORT(what, where, size, category) { } +#endif + + + + +//#include "redblack.h" +typedef struct rbNode { + struct rbNode * __SAFE left, * __SAFE right, * __SAFE parent; + U32 key; + U32 color; // To make the data aligned + char data[0] __SIZED; +} RBNode; + +extern void * __SAFE calloc_rbnode(unsigned int nrelem, unsigned int size); + +/*** KEYS are compared using unsigned comparisons ****/ + +/* Creates a new RB node. The node has room for some data but nothing is put + * in there. The pointer to the data is returned. Start with NULL as an + * empty tree */ +char * __FSEQ insertRB(RBNode * * tree, U32 key, int datalen); + + +/* Finds a node. Returns a pointer to the data */ +char * __FSEQ findRB(RBNode * tree, U32 key); + +/* Pass freeData=NULL if the data does not contain pointers that need to be + * deallocated */ +int freeRB(RBNode * tree, int (* freeData)(U32 key, char * __FSEQ data)); + +// A non-recursive scanner for RB trees +#define FORALLRBNODES(tree, donode) {\ + if(tree) {\ + DoLeftChildren:\ + while(tree->left) {\ + tree = tree->left;\ + }\ + DoNode:\ + /* No left child, or have done all the left descendants*/\ + donode;\ + if(tree->right) {\ + tree = tree->right;\ + goto DoLeftChildren;\ + }\ + /* No right child and we have done all the left descendants*/\ + while(tree->parent && tree->parent->right == tree)\ + tree = tree->parent;\ + if(tree->parent) {\ + tree = tree->parent;\ + goto DoNode;\ + }\ + }\ +} + +/* Some globals that PCC needs */ +int error_level, anerror; +void myexit(int n) { + exit(n); +} +#ifdef _MSVC +#define random rand +#else +/* weimer: not needed: extern int random(void); */ +#endif +int __mmId; +int debugMM; +int debug; + + +#define DATASIZE 16 // This is the size of the data that is reserved in + // each node + +#ifndef ITERS + #define ITERS 100000 +#endif + +int main() { + /* Test hash tables */ + RBNode *t = NULL; + int i; + double clk; + int count = 0; + int sz; + + /* Add and delete random numbers from the hash table */ + TIMESTART(clk); + for(i=0;iright); + t = r->right; + r->right = t->left; if(t->left) {t->left->parent = r; } + + if(r->parent) { + if(r->parent->left == r) { + r->parent->left = t; + } else { + r->parent->right = t; + } + } + t->parent = r->parent; + t->left = r; r->parent = t; + return t; // like r = t +} + +static RBNode *rightRotate(RBNode *r) { + RBNode *t; + _ASSERT(r->left); + t = r->left; + r->left = t->right; if(t->right) { t->right->parent = r; } + + if(r->parent) { + if(r->parent->left == r) { + r->parent->left = t; + } else { + r->parent->right = t; + } + } + t->parent = r->parent; + t->right = r; r->parent = t; + return t; +} + +static RBNode * fixupRB(RBNode *x); +#ifdef _DEBUG +/* Check the tree and return the black height */ +static int checkRBTreeRec(RBNode *tree, U32 minKey, U32 maxKey) { + int bhl, bhr; + if(! tree) return 1; + _ASSERT((! tree->left || tree->left->parent == tree) && + (! tree->right || tree->right->parent == tree)); + _ASSERT(tree->key >= minKey && tree->key <= maxKey); + _ASSERT(tree->color == Red || tree->color == Black); + _ASSERT(tree->color == Black || + ((!tree->left || tree->left->color == Black) && + (!tree->right || tree->right->color == Black))); + bhl = checkRBTreeRec(tree->left, minKey, tree->key); + bhr = checkRBTreeRec(tree->right, tree->key + 1, maxKey); + _ASSERT(bhl == bhr); + return tree->color == Black ? bhl + 1 : bhl; +} + +static int checkRBTree(RBNode *tree) { + _ASSERT(tree->color == Black); + checkRBTreeRec(tree, 0, (U32)(-1)); + return 1; +} + +static int printRBIndent(U32 address) { + if(address) { + printf(" "); + printRBIndent(address >> 1); + printf("%d", address & 1); + } + return 1; +} + +static int printRBTree(RBNode *tree, U32 address) { + printRBIndent(address); + if(tree) { + printf(":%s - 0x%08lx\n", + tree->color == Red ? "Red " : "Black", tree->key); + printRBTree(tree->left, address << 1); + printRBTree(tree->right, (address << 1) + 1); + } else { + printf(":NIL\n"); + } + return 1; +} +#endif + +char * __FSEQ insertRB(RBNode **tree, U32 key, int datalen) { + RBNode *x, *t; + x = (RBNode*)malloc(sizeof(RBNode) + datalen); + x->left = NULL; + x->right = NULL; + x->parent = NULL; + x->color = Red; + x->key = key; + + // Now insert as if it were a simple binary search tree + { + RBNode **p = tree; + RBNode *parent = NULL; + while(*p) { /* We have not reached a NIL */ + parent = *p; + if(key <= (*p)->key) { + p = & (*p)->left; + } else { + p = & (*p)->right; + } + } + // Now *p = NIL + *p = x; x->parent = parent; + } + t = fixupRB(x); + if(t->parent == NULL) { + *tree = t; + } + _ASSERT(*tree); + (*tree)->color = Black; + // IFDEBUG(printf("Tree after insert of key=0x%08lx is\n", key); + // printRBTree(*tree, 1);); + IFDEBUG(checkRBTree(*tree)); + return & x->data[0]; /* Return the allocated node */ +} + + +static RBNode * fixupRB(RBNode *x) { + // Now fixup. We know that x is always RED. The root is always Black + while(x->parent && x->parent->color == Red) { + RBNode *par = x->parent; + RBNode *gpar = par->parent; + RBNode *uncle; + _ASSERT(x->color == Red); + _ASSERT(gpar); // the root is always black, so we must have a grand par + _ASSERT(gpar->color == Black); + if(par == gpar->left) { + uncle = gpar->right; + if(uncle && uncle->color == Red) { + Case1: + par->color = Black; + uncle->color = Black; + gpar->color = Red; + x = gpar; + continue; + } else { + _ASSERT(!uncle || uncle->color == Black); + if(x == par->right) { + uncle = x; + leftRotate(par); + x = par; + par = uncle; + } + _ASSERT(x == par->left); + rightRotate(gpar); + par->color = Black; + gpar->color = Red; + return par; + } + } else { + uncle = gpar->left; + _ASSERT(par == gpar->right); + if(uncle && uncle->color == Red) { + goto Case1; + } else { + _ASSERT(! uncle || uncle->color == Black); + if(x == par->left) { + uncle = x; + rightRotate(par); + x = par; + par = uncle; + } + _ASSERT(x == par->right); + leftRotate(gpar); + par->color = Black; + gpar->color = Red; + return par; + } + } + } + return x; +} + +char* __FSEQ findRB(RBNode *tree, U32 key) { + while(tree) { + if(tree->key == key) + return & tree->data[0]; + if(key < tree->key) + tree = tree->left; + else + tree = tree->right; + } + return NULL; +} + +int freeRB(RBNode *tree, int (*freeData)(U32 key, char * __FSEQ data)) { + if(! tree) return 1; + freeRB(tree->left, freeData); + freeRB(tree->right, freeData); + // Now free the node + if(freeData) { + (*freeData)(tree->key, & tree->data[0]); + } + free(tree); + return 1; +} diff --git a/cil/test/small2/writev.c b/cil/test/small2/writev.c new file mode 100644 index 0000000..049d330 --- /dev/null +++ b/cil/test/small2/writev.c @@ -0,0 +1,113 @@ +// DO NOT CHANGE THIS LINE +// Test that read and readv work. + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include + +#define myassert(I) do { \ + if(!(I)) { \ + printf("%s:%d **************** assertion failure\n", __FILE__, __LINE__); \ + abort(); \ + } \ +} while(0) + +# define MSG0 "HI THERE" +# define MSG1 "BYE NOW!" +# define TESTFILE "writev_test.tmp" + +void delete_file(char *name) { + if(!(unlink(TESTFILE)==0)) { + if (errno!=ENOENT) perror("error unlinking"); + } + errno = 0; + { + struct stat s; + int statval = stat(TESTFILE, &s); + myassert(statval == -1); + myassert(errno == ENOENT); + } +} + +void test_writev() { + int in; + int out; + int num_written; + int num_left; + char *buf; + const int size = 8; + struct iovec iov[2]; + char *dummy; + iov[0].iov_base = "HI THERE"; + iov[0].iov_len = strlen(iov[0].iov_base); + myassert(iov[0].iov_len == size); + dummy = "asdfasdf"; // attempt to break string contiguity + iov[1].iov_base = "BYE NOW!"; + iov[1].iov_len = strlen(iov[1].iov_base); + myassert(iov[1].iov_len == size); + + // Get rid of the testfile. + delete_file(TESTFILE); + + out = open(TESTFILE, O_WRONLY | O_TRUNC | O_CREAT, S_IRUSR | S_IWUSR); + if (out==-1) { + perror("**** error opening file for writing"); + abort(); + } + + // NOTE: we assume that it maximally flushes the buffers. + { + num_written = writev(out, iov, 2); + myassert(num_written = 2 * size); + myassert(close(out)==0); + } + printf("wrote file\n"); + + // check it is what we expect. + { + buf = malloc((2*size+1) * sizeof buf[0]); + in = open(TESTFILE, O_RDONLY); + myassert(buf!=0); + if (in==-1) { + perror("**** error opening file for reading"); + abort(); + } + + // read + printf("trying to read file\n"); + { + num_left = 2*size; + while(num_left) { + int num_read = read(in, buf+(2*size)-num_left, num_left); + num_left -= num_read; + } + buf[2*size] = '\0'; + myassert(num_left==0); + myassert(close(in)==0); + } + + // check it is what we expect. + // NOTE: strings literals concatenate at compile time + printf("read:%s:\n", buf); + myassert(strcmp(buf, MSG0 MSG1)==0); + printf("success\n"); + + // Get rid of the testfile. + delete_file(TESTFILE); +} +} + +int main() { + printf("test writev\n"); + test_writev(); + return 0; +} diff --git a/cil/test/small2/xcheckers.c b/cil/test/small2/xcheckers.c new file mode 100644 index 0000000..93a41d4 --- /dev/null +++ b/cil/test/small2/xcheckers.c @@ -0,0 +1,28 @@ + +typedef struct { + unsigned long cmap ; +} Screen ; /*typedef*/ + +typedef struct _XDisplay Display ; /*typedef*/ +typedef struct { + Screen * screens ; +} * _XPrivDisplay ; /*typedef*/ + +Display * dpy ; +unsigned long paper ; +static int getColor(unsigned long cmap , char * color_name ) +{ + return 1; +} + +static void loadImage(void ) +{ + char * thisScene ; + paper = getColor((& (((_XPrivDisplay )dpy)->screens)[1])->cmap, thisScene); + /*(colorTable[1]).c_color);*/ + +} + +int main () { + return 0; +} diff --git a/cil/test/testcil b/cil/test/testcil new file mode 100755 index 0000000..a92132a --- /dev/null +++ b/cil/test/testcil @@ -0,0 +1,3 @@ +#!/bin/sh +eval 'exec perl -S ./testcil.pl ${1+"$@"}' + if 0; diff --git a/cil/test/testcil.bat b/cil/test/testcil.bat new file mode 100755 index 0000000..abcfc71 --- /dev/null +++ b/cil/test/testcil.bat @@ -0,0 +1 @@ +perl -S testcil.pl %* diff --git a/cil/test/testcil.h b/cil/test/testcil.h new file mode 100644 index 0000000..f6b2331 --- /dev/null +++ b/cil/test/testcil.h @@ -0,0 +1,84 @@ +// #define PRINT_ALL + +extern int retval; +extern int printf(char*, ...); + +void checkOffset(unsigned char * start, unsigned int size, + unsigned int expected_start, + unsigned int expected_width, + char *name) { + int bits = 0; + unsigned char *p = (unsigned char*)start; + unsigned char c; + + // Advance past 0 bytes + for(bits = 0; (! *p) && bits < 8 * size; bits += 8) + p ++; + + c = *p ++; + + if(bits >= 8 * size) { + printf("Cannot find 1 bits in %s\n", name); + retval = 1; + return; + } + + // Find the first bit = 1 + while(! (c & 1)) { + c >>= 1; bits ++; + } + if(expected_start != bits) { + printf("Error: Offset of %s is %d and I thought it was %d\n", name, bits, + expected_start); + retval = 1; + } +#ifdef PRINT_ALL + else { + printf("Offset of %s is %d\n", name, expected_start); + } +#endif + expected_start = bits; + + // Now find the end + while(1) { + while(c & 1) { c >>= 1; bits ++; } + if((bits & 7) == 0) { + if(bits == 8 * size) break; + c = * p ++; + if(! (c & 1)) break; + } else + break; + } + if(bits - expected_start != expected_width) { + int i; + printf("Error: Width of %s is %d and I thought it was %d.\n", name, + bits - expected_start, expected_width); + retval = 1; + for(i=0;inew(AvailParams => { 'RUN' => 1, + 'SUCCESS' => 0}, + LogFile => "cil.log", + CommandName => "testcil"); + +# sm: I want a global name for this $TEST thing, since I find it is merely +# excess verbiage when adding tests.. +$main::globalTEST = $TEST; + +my $inferbox="none"; + +# am I on win32? +my $win32 = ($^O eq 'MSWin32' || $^O eq 'cygwin'); +my $unix = !$win32; +my $solaris = $^O eq 'solaris'; + + +# operating modes +my $gcc = "_GNUCC=1"; # sm: not sure where/why this is needed + + +# am I using egcs? +my $egcs = $unix && system("gcc -v 2>&1 | grep egcs >/dev/null")==0; + +# am I on manju? +my $manju = $unix && system("hostname | grep manju >/dev/null")==0; + +my $make; +if ($solaris) { + $make = "gmake"; +} else { + $make = "make"; +} + +# We watch the log and we remember in what stage we are (so that we can +# interpret the error) + +# Stages: +# 1000 - Start (scripts, preprocessors, etc.) +# 1001 - Parsing +# 1002 - cabs2cil +# 1003 - Compilation +# 1004 - Running + + +my %commonerrors = + ("^Parsing " => sub { $_[1]->{instage} = 1001; }, + + "^Converting CABS" => sub { $_[1]->{instage} = 1002; }, + + "^Linked the cured program" => sub { $_[1]->{instage} = 1008; }, + +# We are seeing an error from make. Try to classify it based on the stage +# in which we are + "^make: \\*\\*\\*" => + sub { + if($_[1]->{ErrorCode} == 0) { + $_[1]->{ErrorCode} = $_[1]->{instage}; + }}, + + #"[sS]yntax error" => sub { $_[1]->{ErrorCode} = 1000; }, + + # Collect some more parameters + # Now error messages + "^((Error|Bug|Unimplemented): .+)\$" + => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+ : error .+)\$" => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+:\\d+: (Error|Unimplemented|Bug):.+)\$" + => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+: fatal error.+)\$" => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^stackdump: Dumping stack trace" => + sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + + + "^user\\s+(\\d+)m([\\d.]+)s" + => sub { $_[1]->{RUN} = 60 * $_[2] + $_[3]; }, + + "^TOTAL\\s+([\\d.]+) s" => sub { $_[1]->{CURE} = $_[2]; }, + ); + + +# Add a test. +# command is the base name of the tests + space separated arguments +# extrargs are passed on the command line for each test +# fields must be fields to be added to the newly created tests +sub addTest { + my($command, %extrafields) = @_; + + my $self = $main::globalTEST; + my ($name, $extraargs) = + ($command =~ /^(\S+) ?(.*)$/); # name is first word + + my $theargs = $self->testCommandExtras($extraargs); + + my %patterns = %commonerrors; + my $kind; + + my $tst = + $self->newTest(Name => $name, + Dir => ".", + Cmd => "$make " . $name . $theargs, + Group => [ ], + Patterns => \%patterns); + # Add the extra fields + my $key; + foreach $key (keys %extrafields) { + $tst->{$key} = $extrafields{$key}; + } + return $tst; +} +sub addTestFail { + my($command, $failpattern) = @_; + addTest($command, MustFail => $failpattern); +} + + + + +sub addBadComment { + my($name, $comm) = @_; + my $self = $main::globalTEST; + $self->addComment($name, $comm); + $self->addGroups($name, "bad"); +} + + + + +sub addToGroup { + my ($name, @groups) = @_; + my $self = $main::globalTEST; + $self->addGroups($name, @groups); +} + + +# Start with a few tests that must be run first +$TEST->newTest( + Name => "!inittests0", + Dir => "..", + Cmd => "$make setup", + Group => ['ALWAYS']); +$TEST->newTest( + Name => "!inittests2", + Dir => "..", + Cmd => "$make setup _GNUCC=1", + Group => ['ALWAYS']); + + +# build the documentation, to make sure that it still builds +$TEST->newTest( + Name => "doc", + Dir => "..", + Cmd => "$make doc", + Group => ["doc"]); + +# Now add tests +addTest("testrun/const-array-init WARNINGS_ARE_ERRORS=1"); +addTest("testrun/const-struct-init WARNINGS_ARE_ERRORS=1"); +addTest("test/const-struct-init WARNINGS_ARE_ERRORS=1"); +addTest("testrun/warnings-noreturn WARNINGS_ARE_ERRORS=1"); +addTest("testrun/warnings-unused-label WARNINGS_ARE_ERRORS=1"); +addTest("test/warnings-cast WARNINGS_ARE_ERRORS=1"); +addTest("testrun/castincr WARNINGS_ARE_ERRORS=1"); + +addTest("test/apachebits"); +addTest("testrun/apachebuf"); + +addTest("testrun/apachefptr"); +addTest("testrun/asm1 _GNUCC=1"); +addTest("test/asm2 _GNUCC=1"); +addTest("test/asm3 _GNUCC=1"); +addTest("test/asm4 _GNUCC=1"); +addTest("testobj/asm5 _GNUCC=1"); + +addTest("testrun/offsetof"); +addTest("testrun/offsetof1"); +addTest("testrun/offsetof2"); +addTest("testrun/offsetof3"); +addTest("testrun/question"); +addTest("testrun/question2"); +addTest("test/argcast"); +addBadComment("test/argcast", + "Fails --check because of mismatched prototypes."); +addTest("test/array1"); +addTest("test/array2"); +addTest("testrun/array_varsize"); +addTest("testrun/array_formal"); +addTest("testrun/formalscope"); +addTest("test/matrix"); +addTest("runall/switch"); +addTest("testrun/strloop"); +addTest("testrun/strloop3"); +addTest("testrun/percentm"); +addTest("testrun/percent400"); +addTest("testrun/caserange _GNUCC=1"); +addTest("test/attr"); +addTest("test/attr2 _GNUCC=1"); +addTest("test/attr3 _GNUCC=1"); +addTest("testrun/attr4 _GNUCC=1"); +addTest("testrun/attr5_GNUCC=1"); +addTest("test/attr6 _GNUCC=1"); +addTest("test/attr7 _GNUCC=1"); +addTest("test/attr8 _GNUCC=1"); +addTest("test/attr9 _GNUCC=1 WARNINGS_ARE_ERRORS=1"); +addTest("test/attr10 _GNUCC=1"); +addTest("test/attr11 _GNUCC=1"); +addTest("test/attr12 _GNUCC=1"); +addTest("test/attr13 _GNUCC=1"); +addTest("testrun/packed _GNUCC=1 WARNINGS_ARE_ERRORS=1"); +addTest("test/packed2 _GNUCC=1"); +addTest("test/bitfield"); +addTest("testrun/bitfield3"); + +addTest("testrun/bitfield2"); +addTest("testrun/call2 "); +addTest("test/cast1"); +addTest("test/cast2"); +addTest("test/cast4 _GNUCC=1"); +addTest("testrun/cast8 "); +addTest("test/constprop"); +addTest("testrun/const1 _GNUCC=1"); +addTest("testrun/const2 "); +addTest("testrun/const3 "); +addTest("testrun/const4 _GNUCC=1"); +addTest("testrun/const5 _GNUCC=1"); +addTest("testrun/const6 "); +addTest("test/const7 "); +addTest("testrun/const8 "); +addTest("test/const9 "); +addTest("testrun/const10 "); +addTest("testrun/const11 "); +addTest("test/deref _GNUCC=1"); +addTest("test_i/empty"); +addTest("test/enum"); +addTest("testrun/enum2"); +addTest("test/func"); +addTest("test/funcarg "); +addBadComment("test/funcarg", + "Bug in parser (argument of function type)"); + +addTest("testrun/func2"); +addTest("testrun/func3"); +addTest("testrun/func4"); +addTest("test/func10 "); +addBadComment("test/func10", + "Cil bug: Cannot parse some strange K&R function definition"); +addTest("test/globals"); +addTest("test/globals2 "); +addBadComment("test/globals2", "CIL bug: we print array size expressions that refer to variables that haven't been defined yet."); +addTest("testrun/float"); +addTest("testrun/float2 "); +addTest("test/huff1"); +addTest("testrun/init"); +addTest("testrun/init1"); +addTest("testrun/init2 _GNUCC=1"); +addTest("testrun/init3 _GNUCC=1"); +addTest("testrun/init4 _GNUCC=1"); +addTest("testrun/init5 _GNUCC=1"); +addTest("testrun/init6 "); +addTest("test/init8 _GNUCC=1"); +addTest("testrun/init9 _GNUCC=1"); +addTest("testrun/init9 _GNUCC=1"); +addTest("testrun/init10 _GNUCC=1"); +addTest("testrun/init11 _GNUCC=1"); +addTest("testrun/init12 _GNUCC=1"); +addTest("testrun/init13 _GNUCC=1"); +addTest("testrun/init14 _GNUCC=1"); +addTest("testrun/init15 _GNUCC=1"); +addTest("testrun/init16 "); +addTest("testrun/init17 "); +addTest("testrun/init18 "); +addTest("testrun/init19 WARNINGS_ARE_ERRORS=1"); +addTest("testrun/init20 _GNUCC=1"); +addTest("testrun/init21 _GNUCC=1"); +addTest("testrun/init22 "); +addTest("test/array-size-trick "); +addTest("testrun/logical "); +addTest("testrun/cond1 _GNUCC=1"); +addTest("testrun/cond2 _GNUCC=1"); +addTest("testrun/initial _GNUCC=1"); +addTest("testrun/inline1 _GNUCC=1"); +addTest("testrun/inline2 _GNUCC=1"); +addTest("test/inline3 _GNUCC=1"); +addTest("test/decl2 _GNUCC=1"); +addBadComment("test/decl2", + "Fails --check because of mismatched prototypes."); +addTest("test/jmp_buf"); +addTest("test/linux_atomic _GNUCC=1"); +addTest("testrun/linux_signal _GNUCC=1"); +addTest("test/li"); +addTest("test_i/lineno"); +addTest("test/list"); +addTest("testrun/localinit "); + +addTest('testrun/longBlock', ''); +addTest("testrun/perror"); +addTest("testrun/perror1"); +addTest("test/pure"); +addTest("testrun/post-assign "); +addBadComment("testrun/post-assign", + "CIL does not have the same evaluation order for ++ as gcc"); +addTest("test/printf "); +addTest("test/printf_const "); +addTest("testrun/printf2"); +addTest("test/unimplemented"); +addTest("testrun/vararg1"); +addTest("testrun/vararg2"); +addTest("testrun/vararg3"); +addTest("testrun/vararg4"); +if($win32) { + addTest("testrun/vararg11 _MSVC=1"); +} +addTest("testrun/varargauto1"); +addTest("testrun/vararg5 _GNUCC=1"); +addTest("testrun/vararg6"); +addTest("test/vararg7 _GNUCC=1"); +addTest("testrun/va-arg-1 _GNUCC=1"); +addTest("testrun/va-arg-2 _GNUCC=1"); +addTest("testrun/va-arg-7 _GNUCC=1"); +addTest("test-bad/arrsize "); +addTest("testrun/comma1 _GNUCC=1"); +addTest("test/retval"); +addTest("testrun/static "); +addTest("test/static1"); +addTest("testrun/static2 "); +addTest("test/strcpy"); +addTest("test/struct_init"); +addTest("test/structassign"); +addTest("testrun/align1 _GNUCC=1"); +addTest("testrun/align2 _GNUCC=1 EXTRAARGS=-O2"); +addTest("test/align3 _GNUCC=1"); +addTest("test/tags"); +addTest("test/task _GNUCC=1"); +addTest("test/power1"); +addTest("testrun/scope1"); +addTest("test/scope2"); +addTest("test/scope3"); +addTest("test/scope4"); +addTest("testrun/scope5 _GNUCC=1"); +addTest("testrun/scope6"); +addTest("testrun/scope8"); +addTest("testrun/scope9 "); +addTest("testrun/scope10 "); +addTest("testrun/scope11 "); +addTest("test/voidstar"); +addTest("testrun/memcpy1"); + +addTest("test/noreturn "); + + +addTest("testrun/label1"); +addTest("testrun/label2"); +addTest("testrun/label3"); +addTest("testrun/label4 _GNUCC=1"); +addTest("test/label5"); +addTest("testrun/wchar1"); +addTest("testrun/wchar2"); +addTest("testrun/wchar3"); +addTest("testrun/wchar4"); +addTest("testrun/wchar5 "); +addTest("testrun/wchar6"); +addTest("testrun/wchar7"); +addTest("testrun/escapes"); +addTest("test-bad1/wchar-bad "); +addTest("testrun/addrof3 _GNUCC=1"); +addTest("testrun/lval1 _GNUCC=1"); +addTest("test/bind2 EXTRAARGS=--allowInlineAssembly"); +addToGroup("test/bind2", "slow"); +addTest("testrun/decl1 _GNUCC=1"); +addTest("testrun/addr-array"); +addTest("combine1 "); +addTest("combine2 "); +addTest("combine3 "); +addTest("combine5 "); +addTest("combine6 "); +addTest("combine8 "); +addTestFail("combine9 ", "Incompatible declaration for g"); +addTest("combine10 "); +addTest("combine11 "); +addTest("combine12 "); +addTest("combine13 "); +addTest("combine14 "); +addTest("combine15 "); +addTest("combine16 "); +addTest("combine17 "); +addTest("combine18 "); +addTest("combine20 "); +addTest("combine21 "); +addTest("combine22 "); +addTest("combinealias "); +addTest("combinelibrik "); +addTest("combineenum1 "); +addTest("combineenum2 "); +addTest("combineenum3 "); +addTest("combine_init "); +addTest("combineinline1 "); +addTest("combineinline2 "); +addTest("combineinline3 "); +addTest("combineinline4 "); +addTest("combineinline6 "); +addTest("combinestruct1 "); +addTest("mixedcomb "); +addTest("testrun/math1 "); +addTest("test/linuxcombine1_1 "); + +addTest("arcombine _GNUCC=1"); +addTest("testrun/funptr1"); +addTest("testrun/typespec1 _GNUCC=1"); +addBadComment("testrun/typespec1", + "Must emulate bug in GCC?"); +addTest("testrun/returnvoid "); +addTest("testrun/returnvoid1 "); +addTest("testrun/return1 "); +addTest("testrun/for1 "); +addTest("testrun/void _GNUCC=1"); +addTest("test/voidtypedef "); +addTest("testrun/wrongnumargs "); +addBadComment("testrun/wrongnumargs", + "Should fail since we don't pad argument lists"); +addTest("test/restrict EXTRAARGS=-std=c9x _GNUCC=1"); +addTest("test/restrict1 _GNUCC=1"); +addTest("testrun/rmtmps1 "); +addTest("testrun/rmtmps2 _GNUCC=1"); +addTest("test/proto1 "); +addBadComment("test/proto1", + "Fails --check because of mismatched prototypes."); +addTest("test/proto2 "); +addBadComment("test/proto2", + "Bug in parser (precedences)"); +addTest("testrun/struct1 "); +addTest("testrun/voidarg "); +addTest("testrun/union2 "); +addTest("testrun/union3 "); +addTest("test/union5 "); +addTest("testrun/inline1 "); +addTest("runall/extinline "); + +addTest("testrun/rmtmps-attr "); +addBadComment("testrun/rmtmps-attr", + "A limitation of our support for attributes"); + +addTest("testrun/vsp"); + +addTest("test/cpp-2 "); +addBadComment("test/cpp-2", + "Bug in parser (empty pragmas)"); +addTest("test/cpp-3 _GNUCC=1"); + + + +if($win32) { + addTest("testrun/extern_init _MSVC=1"); + addTest("testrun/msvc2 _MSVC=1"); + addTest("testrun/msvc3 _MSVC=1"); + addTest("testrun/msvc4 _MSVC=1"); + addTest("testrun/msvc6 _MSVC=1"); + addTest("testrun/msvc7 _MSVC=1"); + addTest("testrun/msvc8 _MSVC=1"); + addTest("testrun/msvc9 _MSVC=1"); + + addTest("test-bad/try1 _MSVC=1"); +} +addTest("testrun/msvc1 "); +addTest("testrun/msvc5 "); + +addTest("testrun/extern1 "); + +addTest("test/duplicate "); + +addTest("testrun/simon6"); + +addTest("testrun/stringsize"); +addTest("testrun/min "); + + + +addTest("test/simplify_structs1 USECILLY=1 EXTRAARGS=--dosimplify"); +addTest("testrun/simplify_structs2 USECILLY=1 EXTRAARGS=--dosimplify"); + +addTest("test/tempname EXTRAARGS=--dosimplify"); + +addTest("testrun/typeof1 "); +addTest("testrun/semicolon _GNUCC=1"); + +addTest("merge-ar "); + + + +addTest("testrun/sizeof1"); +addTest("testrun/sizeof2"); +addTest("runall/sizeof3"); +addTest("test/outofmem "); +addTest("testrun/builtin "); +addTest("test/builtin2 "); +addTest("testrun/builtin3 "); +addTest("testrun/builtin_choose_expr"); +addTest("testrun/comparisons"); +addTest("testrun/assign"); + + + + +# self-contained tests of specific things which had problems before +addTest("scott/multiplestatics"); +addTest("scott/partialbracket"); +addTest("scott/enuminit"); + +addTest("scott/gimpdouble"); +addTest("scott/struct_cs"); + + +addTest("scott-nogcc/bogus_redef"); +addTest("scott/s59"); +addTest("scott/putc $gcc"); +addTest("scott/lexnum"); +addTest("scott/ctype"); + + +# function pointers don't work with inferred wildness +addTest("scott/funcptr"); + +# transparent unions are a problem for network apps +addTest("scott/transpunion $gcc"); +addTest("scott/sockaddr $gcc"); + +# misc... +addTest("scott/constdecl"); +addTest("scott/oldstyle"); +addTest("scott/typeof $gcc"); +addTest("scott/asmfndecl $gcc"); +addTest("scott/open $gcc"); +addTest("scott/constfold"); +addTest("scott/mode_sizes $gcc"); # mode(__QI__) stuff +addTest("scott-nolink/brlock $gcc"); +addTest("scott/regparm0 $gcc"); # this works, unfortunately.. +addTest("scott/unscomp"); # kernel/fs/buffer.c +addTest("scott/thing"); + +# current problematic test cases +addTest("mergeinline"); +addTest("scott/uninit_tmp"); +addTest("combine_samefn"); +addTest("combine_node_alloc"); +addTest("combine_sbump"); +addTest("combine_sbumpB"); +addTest("combine_sbumpB MERGEINLINES=1"); +addTest("combine_allocate"); +addTest("combine_allocate MERGEINLINES=1"); +addTest("combine_theFunc"); +addTest("combine_theFunc MERGEINLINES=1"); +addTest("combine_syserr"); +addTest("combine_syserr MERGEINLINES=1"); +addTest("combine_copyptrs WARNINGS_ARE_ERRORS=1"); +addTest("combine_copyptrs WARNINGS_ARE_ERRORS=1 MERGEINLINES=1"); + +# tests of things implemented for EDG compatibility +addTest("mergestruct"); + +# a few things that should fail +addTest("test-bad/trivial-tb"); +addTest("runall/runall_misc"); + + +# simple test of combiner +addTest("comb $gcc"); + +# test combiner's ability to detect inconsistency +addTest("baddef"); + + +# does not work: complains of many incompatible type redefinitions +#runTest $make apache/rewrite + +addTest("test/init"); +addTest("test/initial"); +addTest("test/jmp_buf"); +addTest("test/static"); + + +# more random stuff +addTest("scott-nogcc/funcname $gcc"); +addTest("scott/litstruct $gcc"); +addTest("scott/main $gcc"); +addTest("scott/globalprob $gcc"); +addTest("scott/bisonerror $gcc"); +addTest("scott/cmpzero"); +addTest("scott/kernel1 $gcc"); +addTest("scott/kernel2 $gcc"); +addTest("scott/xcheckers $gcc"); +addTest("scott/memberofptr $gcc"); +addTest("scott/invalredef $gcc"); +addTest("scott/invalredef2 $gcc"); +addTest("scott/errorinfn"); +addTest("scott/unionassign"); +addTest("scott/structattr"); +addTest("scott/neg64"); +addTest("testrun/arrayinitsize"); +addTest("test-bad/enuminit2"); +addTest("scott/volatilestruct"); +addTest("scott/sizeofchar"); +addTest("scott/initedextern"); +addTest("scott/arrayinit"); +addTest("runall/structattr2"); +addTest("scott/structattr3"); +addTest("scott/enumerator_sizeof"); +addTest("testrun/decl_mix_stmt"); +addTest("scott/enumattr"); +addTest("runall/alpha"); + + + +# ---------------- c-torture ------------- +## if we have the c-torture tests add them +## But only if the ctorture group was specfied +my $ctorture = '/usr/local/src/gcc/gcc/testsuite/gcc.c-torture'; +if(-d $ctorture && + defined $TEST->{option}->{group} && + grep { $_ eq 'ctorture'} @{$TEST->{option}->{group}}) { + + # Omit some tests because they use __complex__ + my @omit = ('compile/20000804-1', 'compile/20001222-1', 'compile/941019-1', + 'compile/981223-1', 'compile/991213-1', 'compile/20010605-2', + 'compile/960512-1', 'compile/complex-1', + 'compile/complex-2', 'compile/complex-4', + 'compile/complex-5', 'execute/complex-2', 'execute/complex-5', + 'execute/960512-1', 'execute/complex-4', + 'execute/complex-1', 'execute/20010605-2'); + + # Also omit those with inner functions + push @omit, + ('compile/951116-1', 'compile/920415-1', + 'execute/920415-1', 'compile/20010605-1', + 'execute/20010605-1', 'compile/20011023-1', + 'compile/20010903-2', 'execute/comp-goto-2', 'execute/nestfunc-2', + 'execute/921215-1', 'execute/920428-2', 'execute/921017-1', + 'execute/nest-stdar-1', 'execute/nestfunc-3', 'execute/920501-7', + 'execute/920721-4', 'execute/920612-2', 'execute/20010209', + 'execute/931002-1', 'execute/nestfunc-1', 'execute/20000822-1', + 'compile/930506-2', 'execute/20010209-1'); + + # Read the compile tests + my @tortures; + foreach my $tortdir ('compile', 'execute', 'compat') { + @tortures = + map { $_ =~ m|$ctorture/$tortdir/(.+)\.c|; $1 } + (glob "$ctorture/$tortdir/*.c"); + # Remove those that were produced in previous runs + @tortures = grep { $_ !~ m|cil$| } @tortures; + # Remove those that we know should fail + @tortures = grep { my $t = "$tortdir/$_"; + ! grep { $_ =~ m|$t|} @omit } @tortures; + foreach my $tst (@tortures) { + addTest("tort/$tortdir/$tst _GNUCC=1"); + $TEST->addGroups("tort/$tortdir/$tst", 'ctorture'); + } + } +} + + +## We add here a mechanism for adding new tests +if(defined $ENV{CILEXTRATESTS}) { + require $ENV{CILEXTRATESTS}; +} + +# print Dumper($TEST); + + +# Now invoke it +$TEST->doit(); + +# print Dumper($TEST); + +exit(0); + + +### +### +### +### Specialize RegTest +### +package CilRegTest; + +use strict; +# use Data::Dumper; + +BEGIN { + use RegTest; + @CilRegTest::ISA = qw(RegTest); # Inherit from RegTest +} + +# The constructor +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = $class->SUPER::new(@_); + + return $self; +} + +# Special command line options +sub extraOptions { + my($self) = @_; + my @supopt = $self->SUPER::extraOptions(); + return ( + @supopt, + "--cildebug!", + "--noremake!", + ); +} + + +sub extraHelpMessage { + my($self) = @_; + + my ($scriptname, $extra) = $self->SUPER::extraHelpMessage(); + return ("testcil", + $extra . << "EOF"); + +Additional arguments for SafeC test harness + --cildebug Use the debug versions of everything (default is false) + --noremake Does not try to remake the executable before each test. + (so that you can modify the sources while the test + is running) + Default log file is safec.log +EOF +} + +sub errorHeading { + my($self, $err) = @_; + return "Not executed" if $err == -1; + return "Success" if $err == 0; + return "Preprocessor error" if $err == 1000; + return "Parse error" if $err == 1001; + return "Cabs2cil error" if $err == 1002; + return "Compilation error" if $err == 1007; + return "Execution error" if $err == 1008; + return $self->SUPER::errorHeading($err); +} + +sub startParsingLog { + my($self, $tst) = @_; + $tst->{instage} = 1000; + $tst->{ErrorCode} = 0; +} + + +sub availableParameters { + my($self) = @_; + return %::availpars; +} + + +# given the current options configuration, return a string of +# additional 'make' arguments to append to test commands +sub testCommandExtras { + my ($self, $extraargs) = @_; + + # (sm: pulled this out of addTests so I could write my own addTests) + my $theargs = defined($self->{option}->{cildebug}) + ? " " : " RELEASE=1 "; + $theargs .= " $extraargs "; + if(defined $self->{option}->{noremake}) { + $theargs .= " NOREMAKE=1"; + } + # Turn on the verbose flag + $theargs .= " STATS=1 PRINTSTAGES=1 "; + # Turn on the strings + # $theargs .= " EXTRAARGS=--useStrings "; + + return $theargs; +} + + + +# ensure uniqueness of names (I don't like using these names to +# name tests.. regrtest used numbers.. oh well) +sub uniqueName { + my ($self, $name) = @_; + + if (!$self->testExists($name)) { + return $name; # already unique + } + else { + my $ct = 2; + while ($self->testExists($name . $ct)) { + $ct++; + } + return $name . $ct; + } +} + + +1; diff --git a/config.guess b/config.guess new file mode 100755 index 0000000..396482d --- /dev/null +++ b/config.guess @@ -0,0 +1,1500 @@ +#! /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-07-02' + +# 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 . +# Please send patches to . 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 ." + +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 powerpc-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 /* 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 + + 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 + #include + + 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 + 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*:[3456]*) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + EM64T:Interix*:[3456]*) + 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 ;; + avr32*: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 + #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' /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 + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # 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 < +# include +#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 + 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 +# 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 < 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/config.sub b/config.sub new file mode 100755 index 0000000..387c18d --- /dev/null +++ b/config.sub @@ -0,0 +1,1608 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, +# Inc. + +timestamp='2006-07-02' + +# 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., 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. + + +# Please send patches to . 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 ." + +version="\ +GNU config.sub ($timestamp) + +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" + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo $1 + exit ;; + + * ) + 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* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ + uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-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 | -knuth | -cray) + 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 + ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -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/'` + ;; + -sco5v6*) + # 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] \ + | am33_2.0 \ + | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ + | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | mcore \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64vr | mips64vrel \ + | mips64orion | mips64orionel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | mt \ + | msp430 \ + | nios | nios2 \ + | ns16k | ns32k \ + | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | pyramid \ + | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu | strongarm \ + | tahoe | thumb | tic4x | tic80 | tron \ + | v850 | v850e \ + | we32k \ + | x86 | xscale | xscalee[bl] | 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) + ;; + ms1) + basic_machine=mt-unknown + ;; + + # 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-* | avr32-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | clipper-* | craynv-* | 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-* | iq2000-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ + | m88110-* | m88k-* | maxq-* | mcore-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nios-* | nios2-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | pyramid-* \ + | romp-* | rs6000-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ + | tahoe-* | thumb-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tron-* \ + | v850-* | v850e-* | vax-* \ + | we32k-* \ + | x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \ + | 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 + ;; + abacus) + basic_machine=abacus-unknown + ;; + 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 + ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + 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 + ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16c) + basic_machine=cr16c-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; + 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 + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; + 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 + ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + morphos) + basic_machine=powerpc-unknown + os=-morphos + ;; + msdos) + basic_machine=i386-pc + os=-msdos + ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + 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 + ;; + openrisc | openrisc-*) + basic_machine=or32-unknown + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 + ;; + 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 + ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; + pentiumpro | p6 | 6x86 | athlon | athlon_*) + basic_machine=i686-pc + ;; + pentiumii | pentium2 | pentiumiii | pentium3) + basic_machine=i686-pc + ;; + pentium4) + basic_machine=i786-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-* | pentiumiii-* | pentium3-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium4-*) + basic_machine=i786-`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 + ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; + 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 + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; + sequent) + basic_machine=i386-sequent + ;; + sh) + basic_machine=sh-hitachi + os=-hms + ;; + sh64) + basic_machine=sh64-unknown + ;; + 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 + ;; + t3e) + basic_machine=alphaev5-cray + os=-unicos + ;; + t90) + basic_machine=t90-cray + os=-unicos + ;; + tic54x | c54x*) + basic_machine=tic54x-unknown + os=-coff + ;; + tic55x | c55x*) + basic_machine=tic55x-unknown + os=-coff + ;; + tic6x | c6x*) + basic_machine=tic6x-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 + ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; + 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 + ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; + 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 + ;; + mmix) + basic_machine=mmix-knuth + ;; + 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 + ;; + sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + 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* | -knetbsd* | -mirbsd* | -netbsd* \ + | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -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* | -linux-newlib* | -linux-uclibc* \ + | -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* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers*) + # 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* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; + -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 + ;; + -os400*) + os=-os400 + ;; + -wince*) + os=-wince + ;; + -osfrose*) + os=-osfrose + ;; + -osf*) + os=-osf + ;; + -utek*) + os=-bsd + ;; + -dynix*) + os=-bsd + ;; + -acis*) + os=-aos + ;; + -atheos*) + os=-atheos + ;; + -syllable*) + os=-syllable + ;; + -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 + ;; + -tpf*) + os=-tpf + ;; + -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 + ;; + -aros*) + os=-aros + ;; + -kaos*) + os=-kaos + ;; + -zvmoe) + os=-zvmoe + ;; + -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 + spu-*) + os=-elf + ;; + *-acorn) + os=-riscix1.2 + ;; + arm*-rebel) + os=-linux + ;; + arm*-semi) + os=-aout + ;; + c4x-* | tic4x-*) + os=-coff + ;; + # 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 + ;; + *-haiku) + os=-haiku + ;; + *-ibm) + os=-aix + ;; + *-knuth) + os=-mmixware + ;; + *-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 + ;; + -os400*) + vendor=ibm + ;; + -ptx*) + vendor=sequent + ;; + -tpf*) + vendor=ibm + ;; + -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 + +# 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/configure b/configure new file mode 100755 index 0000000..9ac5357 --- /dev/null +++ b/configure @@ -0,0 +1,4134 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.61. +# +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +# 2002, 2003, 2004, 2005, 2006 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 more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# 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 + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +as_nl=' +' +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +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 +IFS=$as_save_IFS + + ;; +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_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +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) >/dev/null 2>&1 && $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; 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'` + +# CDPATH. +$as_unset CDPATH + + +if test "x$CONFIG_SHELL" = x; then + if (eval ":") 2>/dev/null; then + as_have_required=yes +else + as_have_required=no +fi + + if test $as_have_required = yes && (eval ": +(as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=\$LINENO + as_lineno_2=\$LINENO + test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" && + test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; } +") 2> /dev/null; then + : +else + as_candidate_shells= + 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=. + case $as_dir in + /*) + for as_base in sh bash ksh sh5; do + as_candidate_shells="$as_candidate_shells $as_dir/$as_base" + done;; + esac +done +IFS=$as_save_IFS + + + for as_shell in $as_candidate_shells $SHELL; do + # Try only shells that exist, to save several forks. + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { ("$as_shell") 2> /dev/null <<\_ASEOF +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +_ASEOF +}; then + CONFIG_SHELL=$as_shell + as_have_required=yes + if { "$as_shell" 2> /dev/null <<\_ASEOF +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + +: +(as_func_return () { + (exit $1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = "$1" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test $exitcode = 0) || { (exit 1); exit 1; } + +( + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; } + +_ASEOF +}; then + break +fi + +fi + + done + + if test "x$CONFIG_SHELL" != x; then + for as_var in BASH_ENV ENV + do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var + done + export CONFIG_SHELL + exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} +fi + + + if test $as_have_required = no; then + echo This script requires a shell more modern than all the + echo shells that I found on your system. Please install a + echo modern shell, or manually run the script under such a + echo shell if you do have one. + { (exit 1); exit 1; } +fi + + +fi + +fi + + + +(eval "as_func_return () { + (exit \$1) +} +as_func_success () { + as_func_return 0 +} +as_func_failure () { + as_func_return 1 +} +as_func_ret_success () { + return 0 +} +as_func_ret_failure () { + return 1 +} + +exitcode=0 +if as_func_success; then + : +else + exitcode=1 + echo as_func_success failed. +fi + +if as_func_failure; then + exitcode=1 + echo as_func_failure succeeded. +fi + +if as_func_ret_success; then + : +else + exitcode=1 + echo as_func_ret_success failed. +fi + +if as_func_ret_failure; then + exitcode=1 + echo as_func_ret_failure succeeded. +fi + +if ( set x; as_func_ret_success y && test x = \"\$1\" ); then + : +else + exitcode=1 + echo positional parameters were not saved. +fi + +test \$exitcode = 0") || { + echo No shell found that supports shell functions. + echo Please tell autoconf@gnu.org about your system, + echo including any error possibly output before this + echo message +} + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # 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 after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, 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 + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\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 sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir +fi +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' +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$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# 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'" + + + +exec 7<&0 &1 + +# 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` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= + +ac_unique_file="src/main.ml" +ac_subst_vars='SHELL +PATH_SEPARATOR +PACKAGE_NAME +PACKAGE_TARNAME +PACKAGE_VERSION +PACKAGE_STRING +PACKAGE_BUGREPORT +exec_prefix +prefix +program_transform_name +bindir +sbindir +libexecdir +datarootdir +datadir +sysconfdir +sharedstatedir +localstatedir +includedir +oldincludedir +docdir +infodir +htmldir +dvidir +pdfdir +psdir +libdir +localedir +mandir +DEFS +ECHO_C +ECHO_N +ECHO_T +LIBS +build_alias +host_alias +target_alias +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 +LINUX_DIR +USE_LINUX +USE_MINE_OCT +USE_CVCL +USE_YICES +SATURNHOME +USE_SATURN +ARCHOS +DEPUTYHOME +DEFAULT_CIL_MODE +DEPUTY_VERSION +CVCLLIB +CVCLINC +OCAMLINC +LIBOBJS +LTLIBOBJS' +ac_subst_files='' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS' + + +# 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. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +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 + + case $ac_option in + *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -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) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$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 ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -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'` + 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 ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$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 ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + 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 ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$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'` + 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; }; } + 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 directory names. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 + { (exit 1); exit 1; }; } +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 + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + { echo "$as_me: error: Working directory cannot be determined" >&2 + { (exit 1); exit 1; }; } +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + { echo "$as_me: error: pwd does not report name of working directory" >&2 + { (exit 1); exit 1; }; } + + +# 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 the parent directory. + ac_confdir=`$as_dirname -- "$0" || +$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 + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 + { (exit 1); exit 1; }; } +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || { echo "$as_me: error: $ac_msg" >&2 + { (exit 1); exit 1; }; } + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# 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 \`..'] + +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] + --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] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_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-linux[=PATH] enable Linux kernel support + --with-mine-oct use Mine's Octagon library + --with-cvcl use the CVCL solver + --with-yices use the Yices solver + --with-saturn[=PATH] enable use of Saturn analysis + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS C/C++/Objective C preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested 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 + else + echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +configure +generated by GNU Autoconf 2.61 + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, +2002, 2003, 2004, 2005, 2006 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 +fi +cat >config.log <<_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.61. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +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` +/usr/bin/hostinfo = `(/usr/bin/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 +IFS=$as_save_IFS + +} >&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_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_arg'" + ;; + 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: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +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, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 +echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + *) $as_unset $ac_var ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + cat <<\_ASBOX +## ----------------- ## +## Output variables. ## +## ----------------- ## +_ASBOX + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + cat <<\_ASBOX +## ------------------- ## +## File substitutions. ## +## ------------------- ## +_ASBOX + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + cat <<\_ASBOX +## ----------- ## +## confdefs.h. ## +## ----------- ## +_ASBOX + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + echo "$as_me: caught signal $ac_signal" + echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r 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 -f -r conftest* 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 -n "$CONFIG_SITE"; then + set x "$CONFIG_SITE" +elif test "x$prefix" != xNONE; then + set x "$prefix/share/config.site" "$prefix/etc/config.site" +else + set x "$ac_default_prefix/share/config.site" \ + "$ac_default_prefix/etc/config.site" +fi +shift +for ac_site_file +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 $ac_precious_vars; 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_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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&5 +echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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.exe + 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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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.exe +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 { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + +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 + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ echo "$as_me:$LINENO: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&5 +echo "$as_me: WARNING: In the future, Autoconf will not detect cross-tools +whose name does not start with the host triplet. If you think this +configuration is useful to you, please write to autoconf@gnu.org." >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +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` +{ (ac_try="$ac_compiler --version >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compiler --version >&5") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -v >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compiler -v >&5") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } +{ (ac_try="$ac_compiler -V >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compiler -V >&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[^ ]*//'` +# +# List of possible output files, starting from the most likely. +# The algorithm is not robust to junk in `.', hence go to wildcards (a.*) +# only as a last resort. b.out is created by i960 compilers. +ac_files='a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out' +# +# The IRIX 6 linker writes into existing files which may not be +# executable, retaining their permissions. Remove them first so a +# subsequent execution test works. +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { (ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi + +{ echo "$as_me:$LINENO: result: $ac_file" >&5 +echo "${ECHO_T}$ac_file" >&6; } +if test -z "$ac_file"; then + 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 + +# Check that 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' + { (case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 that 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 { (ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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 | *.map | *.inf | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; then + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf ) ;; + *) 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; 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 core 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 +{ 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 + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + CFLAGS="" + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + : +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + 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 { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_g=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi + +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +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 ISO C89" >&5 +echo $ECHO_N "checking for $CC option to accept ISO C89... $ECHO_C" >&6; } +if test "${ac_cv_prog_cc_c89+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_prog_cc_c89=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 +#include +#include +#include +/* 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 -std 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 -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 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 +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + rm -f conftest.$ac_objext +if { (ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&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); } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then + ac_cv_prog_cc_c89=$ac_arg +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + +fi + +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { echo "$as_me:$LINENO: result: none needed" >&5 +echo "${ECHO_T}none needed" >&6; } ;; + xno) + { echo "$as_me:$LINENO: result: unsupported" >&5 +echo "${ECHO_T}unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5 +echo "${ECHO_T}$ac_cv_prog_cc_c89" >&6; } ;; +esac + + +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 + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# 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 { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$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 +IFS=$as_save_IFS + + +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. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + 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' + + +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + { { echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5 +echo "$as_me: error: cannot run $SHELL $ac_aux_dir/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_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + { { 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=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5 +echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_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; } +case $ac_cv_build in +*-*-*) ;; +*) { { echo "$as_me:$LINENO: error: invalid value of canonical build" >&5 +echo "$as_me: error: invalid value of canonical build" >&2;} + { (exit 1); exit 1; }; };; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ 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 + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5 +echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;} + { (exit 1); exit 1; }; } +fi + +fi +{ echo "$as_me:$LINENO: result: $ac_cv_host" >&5 +echo "${ECHO_T}$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) { { echo "$as_me:$LINENO: error: invalid value of canonical host" >&5 +echo "$as_me: error: invalid value of canonical host" >&2;} + { (exit 1); exit 1; }; };; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +{ 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 + if test "x$target_alias" = x; then + ac_cv_target=$ac_cv_host +else + ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` || + { { echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&5 +echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&2;} + { (exit 1); exit 1; }; } +fi + +fi +{ echo "$as_me:$LINENO: result: $ac_cv_target" >&5 +echo "${ECHO_T}$ac_cv_target" >&6; } +case $ac_cv_target in +*-*-*) ;; +*) { { echo "$as_me:$LINENO: error: invalid value of canonical target" >&5 +echo "$as_me: error: invalid value of canonical target" >&2;} + { (exit 1); exit 1; }; };; +esac +target=$ac_cv_target +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_target +shift +target_cpu=$1 +target_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +target_os=$* +IFS=$ac_save_IFS +case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac + + +# 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}- + +DEPUTYHOME=`pwd` +DEFAULT_CIL_MODE=GNUCC +DEPUTY_VERSION=1.1 + +CVCLLIB=/usr/local/lib +CVCLINC=/usr/local/include + +YICESLIB=/usr/local/lib +YICESINC=/usr/local/include + +OCAMLINC=/usr/lib/ocaml + +# make sure I haven't forgotten to run autoconf +if test configure -ot configure.ac; then + { { echo "$as_me:$LINENO: error: configure is older than configure.ac; you forgot to run autoconf" >&5 +echo "$as_me: error: configure is older than configure.ac; you forgot to run autoconf" >&2;} + { (exit 1); exit 1; }; } +fi + +case "$target" in + # Linux + *86*linux*|*86*openbsd*) + { echo "$as_me:$LINENO: result: configuring for $target" >&5 +echo "${ECHO_T}configuring for $target" >&6; } + ARCHOS=x86_LINUX + ;; + + # FreeBSD + *i386*freebsd*|*amd64*freebsd*) + if test x"${ARCH}" = x""; then + ARCH=`uname -p` + fi + + { echo "$as_me:$LINENO: result: configuring for $target" >&5 +echo "${ECHO_T}configuring for $target" >&6; } + ARCHOS=${ARCH}_FREEBSD + ;; + + # Mac OS X + *86*darwin*) + { echo "$as_me:$LINENO: result: configuring for $target" >&5 +echo "${ECHO_T}configuring for $target" >&6; } + ARCHOS=x86_DARWIN + ;; + + # Cygwin + *86*cygwin*) + { echo "$as_me:$LINENO: result: configuring for $target" >&5 +echo "${ECHO_T}configuring for $target" >&6; } + ARCHOS=x86_WIN32 + + # override DEPUTYHOME; even on cygwin we want forward slashes + # sm: I folded this into what I hope will be the only + # case-analysis of machine type + # DEPUTYHOME=`cygpath -wa "$DEPUTYHOME" | sed -e "s/\\\\\/\\//g"` + # Try to use the Unix paths even on cygwin. The newest versions of make + # do not like colons in file names + DEPUTYHOME=`cygpath -u "$DEPUTYHOME"` + CC=`which $CC` + CC=`cygpath -wa "$CC" | sed -e "s/\\\\\/\\//g"` + ;; + + *) + { { echo "$as_me:$LINENO: error: + Unsupported platform $target -- sorry. + ./configure supports these platforms: + on x86: Linux, Cygwin, FreeBSD, OpenBSD, Darwin + " >&5 +echo "$as_me: error: + Unsupported platform $target -- sorry. + ./configure supports these platforms: + on x86: Linux, Cygwin, FreeBSD, OpenBSD, Darwin + " >&2;} + { (exit 1); exit 1; }; } + ;; +esac + +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 { as_var=$as_ac_File; eval "test \"\${$as_var+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 +ac_res=`eval echo '${'$as_ac_File'}'` + { echo "$as_me:$LINENO: result: $ac_res" >&5 +echo "${ECHO_T}$ac_res" >&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 + + + +LINUX_MSG="n/a" +USE_LINUX="no" + +# Check whether --with-linux was given. +if test "${with_linux+set}" = set; then + withval=$with_linux; if test "x$withval" = "x" ; then + { { echo "$as_me:$LINENO: error: No Linux kernel path provided" >&5 +echo "$as_me: error: No Linux kernel path provided" >&2;} + { (exit 1); exit 1; }; } + else + if test "x$withval" != "xno" ; then + USE_LINUX="yes" + LINUX_MSG="$withval" + LINUX_DIR="$withval" + + fi + fi +fi + + + +USE_MINE_OCT="no" + +# Check whether --with-mine-oct was given. +if test "${with_mine_oct+set}" = set; then + withval=$with_mine_oct; USE_MINE_OCT="yes" +fi + + + +USE_CVCL="no" + +# Check whether --with-cvcl was given. +if test "${with_cvcl+set}" = set; then + withval=$with_cvcl; USE_CVCL="yes" +fi + + + +USE_YICES="no" + +# Check whether --with-yices was given. +if test "${with_yices+set}" = set; then + withval=$with_yices; USE_YICES="yes" +fi + + + +USE_SATURN="no" + +# Check whether --with-saturn was given. +if test "${with_saturn+set}" = set; then + withval=$with_saturn; if test "x$withval" = "x" ; then + { { echo "$as_me:$LINENO: error: No Saturn path provided" >&5 +echo "$as_me: error: No Saturn path provided" >&2;} + { (exit 1); exit 1; }; } + else + if test "x$withval" != "xno" ; then + USE_SATURN="yes" + SATURNHOME="$withval" + + fi + fi +fi + + + +#We can't use AC_CONFIG_SUBDIRS because it doesn't support adding new +#flags (--with-zrapp): +# AC_CONFIG_SUBDIRS(cil) +if test -f cil/configure; then + { echo "$as_me:$LINENO: Configuring CIL:" >&5 +echo "$as_me: Configuring CIL:" >&6;}; + cd cil; ./configure --with-zrapp; cd .. +else + { { echo "$as_me:$LINENO: error: Missing the CIL directory" >&5 +echo "$as_me: error: Missing the CIL directory" >&2;} + { (exit 1); exit 1; }; } +fi + + + + + + + + + + +# finish the configure script and generate various files; ./configure +# will apply variable substitutions to .in to generate ; +# 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 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 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 +} + +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, we kill variables containing newlines. +# 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. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { echo "$as_me:$LINENO: WARNING: Cache variable $ac_var contains a newline." >&5 +echo "$as_me: WARNING: Cache variable $ac_var contains a newline." >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + *) $as_unset $ac_var ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}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 "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + 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 "$as_me:$LINENO: updating cache $cache_file" >&5 +echo "$as_me: updating cache $cache_file" >&6;} + cat confcache >$cache_file + else + { echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5 +echo "$as_me: not updating unwritable cache $cache_file" >&6;} + 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}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.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_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`echo "$ac_i" | sed "$ac_script"` + # 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 more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +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+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in + *posix*) set -o posix ;; +esac + +fi + + + + +# PATH needs CR +# 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 + +# Support unset when possible. +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + as_unset=unset +else + as_unset=false +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +as_nl=' +' +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +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 +IFS=$as_save_IFS + + ;; +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_myself: error: cannot find myself; rerun with an absolute file name" >&2 + { (exit 1); exit 1; } +fi + +# Work around bugs in pre-3.0 UWIN ksh. +for as_var in ENV MAIL MAILPATH +do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var +done +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) >/dev/null 2>&1 && $as_unset $as_var + fi +done + +# Required to use basename. +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; 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'` + +# CDPATH. +$as_unset CDPATH + + + + as_lineno_1=$LINENO + as_lineno_2=$LINENO + test "x$as_lineno_1" != "x$as_lineno_2" && + test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || { + + # 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 after each line using $LINENO; the second 'sed' + # does the real work. The second script uses 'N' to pair each + # line-number line with the line containing $LINENO, 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 + # scripts with optimization help from Paolo Bonzini. Blame Lee + # E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\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 sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in +-n*) + case `echo 'x\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + *) ECHO_C='\c';; + esac;; +*) + ECHO_N='-n';; +esac + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir +fi +echo >conf$$.file +if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -p'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -p' +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$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p=: +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +if test -x / >/dev/null 2>&1; then + as_test_x='test -x' +else + if ls -dL / >/dev/null 2>&1; then + as_ls_L_option=L + else + as_ls_L_option= + fi + as_test_x=' + eval sh -c '\'' + if test -d "$1"; then + test -d "$1/."; + else + case $1 in + -*)set "./$1";; + esac; + case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in + ???[sx]*):;;*)false;;esac;fi + '\'' sh + ' +fi +as_executable_p=$as_test_x + +# 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'" + + +exec 6>&1 + +# Save the log message, to keep $[0] and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by $as_me, which was +generated by GNU Autoconf 2.61. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +cat >>$CONFIG_STATUS <<_ACEOF +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +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 and configuration settings, 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 + +Configuration files: +$config_files + +Report bugs to ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.61, + with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\" + +Copyright (C) 2006 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +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 + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + echo "$ac_cs_version"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + CONFIG_FILES="$CONFIG_FILES $ac_optarg" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) { 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" + ac_need_defaults=false ;; + + 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 CONFIG_SHELL=$SHELL $SHELL $0 "$ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 + CONFIG_SHELL=$SHELL + export CONFIG_SHELL + exec $SHELL "$0"$ac_configure_args \$ac_configure_extra_args --no-create --no-recursion +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "test/Makefile") CONFIG_FILES="$CONFIG_FILES test/Makefile" ;; + "doc/index.html") CONFIG_FILES="$CONFIG_FILES doc/index.html" ;; + "doc/header.html") CONFIG_FILES="$CONFIG_FILES doc/header.html" ;; + + *) { { 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 +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= + trap 'exit_status=$? + { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$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 "./confXXXXXX") 2>/dev/null` && + test -n "$tmp" && test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || +{ + echo "$me: cannot create a temporary directory in ." >&2 + { (exit 1); exit 1; } +} + +# +# Set up the sed scripts for 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 + +_ACEOF + + + +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + cat >conf$$subs.sed <<_ACEOF +SHELL!$SHELL$ac_delim +PATH_SEPARATOR!$PATH_SEPARATOR$ac_delim +PACKAGE_NAME!$PACKAGE_NAME$ac_delim +PACKAGE_TARNAME!$PACKAGE_TARNAME$ac_delim +PACKAGE_VERSION!$PACKAGE_VERSION$ac_delim +PACKAGE_STRING!$PACKAGE_STRING$ac_delim +PACKAGE_BUGREPORT!$PACKAGE_BUGREPORT$ac_delim +exec_prefix!$exec_prefix$ac_delim +prefix!$prefix$ac_delim +program_transform_name!$program_transform_name$ac_delim +bindir!$bindir$ac_delim +sbindir!$sbindir$ac_delim +libexecdir!$libexecdir$ac_delim +datarootdir!$datarootdir$ac_delim +datadir!$datadir$ac_delim +sysconfdir!$sysconfdir$ac_delim +sharedstatedir!$sharedstatedir$ac_delim +localstatedir!$localstatedir$ac_delim +includedir!$includedir$ac_delim +oldincludedir!$oldincludedir$ac_delim +docdir!$docdir$ac_delim +infodir!$infodir$ac_delim +htmldir!$htmldir$ac_delim +dvidir!$dvidir$ac_delim +pdfdir!$pdfdir$ac_delim +psdir!$psdir$ac_delim +libdir!$libdir$ac_delim +localedir!$localedir$ac_delim +mandir!$mandir$ac_delim +DEFS!$DEFS$ac_delim +ECHO_C!$ECHO_C$ac_delim +ECHO_N!$ECHO_N$ac_delim +ECHO_T!$ECHO_T$ac_delim +LIBS!$LIBS$ac_delim +build_alias!$build_alias$ac_delim +host_alias!$host_alias$ac_delim +target_alias!$target_alias$ac_delim +CC!$CC$ac_delim +CFLAGS!$CFLAGS$ac_delim +LDFLAGS!$LDFLAGS$ac_delim +CPPFLAGS!$CPPFLAGS$ac_delim +ac_ct_CC!$ac_ct_CC$ac_delim +EXEEXT!$EXEEXT$ac_delim +OBJEXT!$OBJEXT$ac_delim +INSTALL_PROGRAM!$INSTALL_PROGRAM$ac_delim +INSTALL_SCRIPT!$INSTALL_SCRIPT$ac_delim +INSTALL_DATA!$INSTALL_DATA$ac_delim +build!$build$ac_delim +build_cpu!$build_cpu$ac_delim +build_vendor!$build_vendor$ac_delim +build_os!$build_os$ac_delim +host!$host$ac_delim +host_cpu!$host_cpu$ac_delim +host_vendor!$host_vendor$ac_delim +host_os!$host_os$ac_delim +target!$target$ac_delim +target_cpu!$target_cpu$ac_delim +target_vendor!$target_vendor$ac_delim +target_os!$target_os$ac_delim +LINUX_DIR!$LINUX_DIR$ac_delim +USE_LINUX!$USE_LINUX$ac_delim +USE_MINE_OCT!$USE_MINE_OCT$ac_delim +USE_CVCL!$USE_CVCL$ac_delim +USE_YICES!$USE_YICES$ac_delim +SATURNHOME!$SATURNHOME$ac_delim +USE_SATURN!$USE_SATURN$ac_delim +ARCHOS!$ARCHOS$ac_delim +DEPUTYHOME!$DEPUTYHOME$ac_delim +DEFAULT_CIL_MODE!$DEFAULT_CIL_MODE$ac_delim +DEPUTY_VERSION!$DEPUTY_VERSION$ac_delim +CVCLLIB!$CVCLLIB$ac_delim +CVCLINC!$CVCLINC$ac_delim +OCAMLINC!$OCAMLINC$ac_delim +LIBOBJS!$LIBOBJS$ac_delim +LTLIBOBJS!$LTLIBOBJS$ac_delim +_ACEOF + + if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 75; then + break + elif $ac_last_try; then + { { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5 +echo "$as_me: error: could not make $CONFIG_STATUS" >&2;} + { (exit 1); exit 1; }; } + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +ac_eof=`sed -n '/^CEOF[0-9]*$/s/CEOF/0/p' conf$$subs.sed` +if test -n "$ac_eof"; then + ac_eof=`echo "$ac_eof" | sort -nru | sed 1q` + ac_eof=`expr $ac_eof + 1` +fi + +cat >>$CONFIG_STATUS <<_ACEOF +cat >"\$tmp/subs-1.sed" <<\CEOF$ac_eof +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b end +_ACEOF +sed ' +s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g +s/^/s,@/; s/!/@,|#_!!_#|/ +:n +t n +s/'"$ac_delim"'$/,g/; t +s/$/\\/; p +N; s/^.*\n//; s/[,\\&]/\\&/g; s/@/@|#_!!_#|/g; b n +' >>$CONFIG_STATUS >$CONFIG_STATUS <<_ACEOF +:end +s/|#_!!_#|//g +CEOF$ac_eof +_ACEOF + + +# 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 + +cat >>$CONFIG_STATUS <<\_ACEOF +fi # test -n "$CONFIG_FILES" + + +for ac_tag in :F $CONFIG_FILES +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) { { echo "$as_me:$LINENO: error: Invalid tag $ac_tag." >&5 +echo "$as_me: error: Invalid tag $ac_tag." >&2;} + { (exit 1); exit 1; }; };; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + { { echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5 +echo "$as_me: error: cannot find input file: $ac_f" >&2;} + { (exit 1); exit 1; }; };; + esac + ac_file_inputs="$ac_file_inputs $ac_f" + done + + # 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. */ + configure_input="Generated from "`IFS=: + echo $* | sed 's|^[^:]*/||;s|:[^:]*/|, |g'`" by configure." + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { echo "$as_me:$LINENO: creating $ac_file" >&5 +echo "$as_me: creating $ac_file" >&6;} + fi + + case $ac_tag in + *:-:* | *:-) cat >"$tmp/stdin";; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$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'` + { as_dir="$ac_dir" + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$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'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || { { echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5 +echo "$as_me: error: cannot create directory $as_dir" >&2;} + { (exit 1); exit 1; }; }; } + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,/..,g;s,/,,'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= + +case `sed -n '/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p +' $ac_file_inputs` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +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&@top_builddir@&$ac_top_builddir_sub&;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&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +$ac_datarootdir_hack +" $ac_file_inputs | sed -f "$tmp/subs-1.sed" >$tmp/out + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&5 +echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined." >&2;} + + rm -f "$tmp/stdin" + case $ac_file in + -) cat "$tmp/out"; rm -f "$tmp/out";; + *) rm -f "$ac_file"; mv "$tmp/out" $ac_file;; + esac + ;; + + + + esac + + + case $ac_file$ac_mode in + "Makefile":F) chmod a-w Makefile ;; + "test/Makefile":F) chmod a-w test/Makefile ;; + "doc/index.html":F) chmod a-w doc/index.html ;; + "doc/header.html":F) chmod a-w doc/header.html ;; + + esac +done # for ac_tag + + +{ (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 + + +cat <.in to generate ; +# 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(test/Makefile) +MY_AC_CONFIG_FILES(doc/index.html) +MY_AC_CONFIG_FILES(doc/header.html) + +AC_OUTPUT() + +cat < Wed, 10 Jan 2007 10:09:09 -0800 + diff --git a/debian/compat b/debian/compat new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/debian/compat @@ -0,0 +1 @@ +5 diff --git a/debian/control b/debian/control new file mode 100644 index 0000000..8c052f5 --- /dev/null +++ b/debian/control @@ -0,0 +1,15 @@ +Source: deputy +Section: devel +Priority: optional +Maintainer: Jeremy Condit +Build-Depends: debhelper (>= 5), autotools-dev, ocaml (>= 3.08) +Standards-Version: 3.7.2 + +Package: deputy +Architecture: any +Depends: ${shlibs:Depends}, ${misc:Depends}, perl-base (>= 5.6.1), gcc (>= 4) +Recommends: ocaml-interp (>= 3.08) +Description: Advanced C compiler for enforcing type and memory safety + Advanced C compiler that uses type annotations to enforce type and memory + safety in existing C programs. Performs additional static checking, and + inserts run-time checks when static checking is insufficient. diff --git a/debian/copyright b/debian/copyright new file mode 100644 index 0000000..e89d191 --- /dev/null +++ b/debian/copyright @@ -0,0 +1,47 @@ +This package was debianized by Jeremy Condit on +Wed, 10 Jan 2007 10:09:09 -0800. + +It was downloaded from http://deputy.cs.berkeley.edu/ + +Upstream Author: Jeremy Condit + +Copyright: 2006-07 by Jeremy Condit, Matthew Harren, Zachary Anderson, and +George C. Necula. + +License: + +Copyright (c) 2006-07, + Jeremy Condit + Matthew Harren + Zachary Anderson + George C. Necula +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/debian/dirs b/debian/dirs new file mode 100644 index 0000000..e772481 --- /dev/null +++ b/debian/dirs @@ -0,0 +1 @@ +usr/bin diff --git a/debian/docs b/debian/docs new file mode 100644 index 0000000..e69de29 diff --git a/debian/files b/debian/files new file mode 100644 index 0000000..980fadb --- /dev/null +++ b/debian/files @@ -0,0 +1 @@ +deputy_1.1-1_i386.deb devel optional diff --git a/debian/rules b/debian/rules new file mode 100755 index 0000000..dda0e02 --- /dev/null +++ b/debian/rules @@ -0,0 +1,107 @@ +#!/usr/bin/make -f +# -*- makefile -*- +# Sample debian/rules that uses debhelper. +# This file was originally written by Joey Hess and Craig Small. +# As a special exception, when this file is copied by dh-make into a +# dh-make output file, you may use that output file without restriction. +# This special exception was added by Craig Small in version 0.37 of dh-make. + +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 + + +# These are used for cross-compiling and for saving the configure script +# from having to guess our platform (since we know it already) +DEB_HOST_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE) +DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) + + +CFLAGS = -Wall -g + +ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) + CFLAGS += -O0 +else + CFLAGS += -O2 +endif + +config.status: configure + dh_testdir + # Add here commands to configure the package. + ./configure --host=$(DEB_HOST_GNU_TYPE) --build=$(DEB_BUILD_GNU_TYPE) --prefix=/usr --mandir=\$${prefix}/share/man --infodir=\$${prefix}/share/info CFLAGS="$(CFLAGS)" LDFLAGS="-Wl,-z,defs" + + +build: build-stamp + +build-stamp: config.status + dh_testdir + + # Add here commands to compile the package. + $(MAKE) + #docbook-to-man debian/deputy.sgml > deputy.1 + + touch $@ + +clean: + dh_testdir + dh_testroot + rm -f build-stamp + + # Add here commands to clean up after the build process. + -$(MAKE) realclean +ifneq "$(wildcard /usr/share/misc/config.sub)" "" + cp -f /usr/share/misc/config.sub config.sub +endif +ifneq "$(wildcard /usr/share/misc/config.guess)" "" + cp -f /usr/share/misc/config.guess config.guess +endif + + + dh_clean + +install: build + dh_testdir + dh_testroot + dh_clean -k + dh_installdirs + + # Add here commands to install the package into debian/deputy. + $(MAKE) prefix=$(CURDIR)/debian/deputy/usr install-base + + +# Build architecture-independent files here. +binary-indep: build install +# We have nothing to do by default. + +# Build architecture-dependent files here. +binary-arch: build install + dh_testdir + dh_testroot + dh_installchangelogs + dh_installdocs + dh_installexamples +# dh_install +# dh_installmenu +# dh_installdebconf +# dh_installlogrotate +# dh_installemacsen +# dh_installpam +# dh_installmime +# dh_python +# dh_installinit +# dh_installcron +# dh_installinfo + dh_installman doc/deputy.1 + dh_link + dh_strip + dh_compress + dh_fixperms +# dh_perl +# dh_makeshlibs + dh_installdeb + dh_shlibdeps + dh_gencontrol + dh_md5sums + dh_builddeb + +binary: binary-indep binary-arch +.PHONY: build clean binary-indep binary-arch binary install diff --git a/debian/watch b/debian/watch new file mode 100644 index 0000000..5bafa1d --- /dev/null +++ b/debian/watch @@ -0,0 +1,22 @@ +# Example watch control file for uscan +# Rename this file to "watch" and then you can run the "uscan" command +# to check for upstream updates and more. +# See uscan(1) for format + +# Compulsory line, this is a version 3 file +version=3 + +# Uncomment to examine a Webpage +# +http://deputy.cs.berkeley.edu/ deputy-(.*)\.tar\.gz + +# Uncomment to examine a Webserver directory +#http://www.example.com/pub/deputy-(.*)\.tar\.gz + +# Uncommment to examine a FTP server +#ftp://ftp.example.com/pub/deputy-(.*)\.tar\.gz debian uupdate + +# Uncomment to find new files on sourceforge, for debscripts >= 2.9 +# http://sf.net/deputy/deputy-(.*)\.tar\.gz + + diff --git a/doc/.cvsignore b/doc/.cvsignore new file mode 100755 index 0000000..e58a344 --- /dev/null +++ b/doc/.cvsignore @@ -0,0 +1,22 @@ +*.mfj +*.dvi +*.aux +*.ps +*.log +*.blg +*.bbl +*.lof +*.lot +*.toc +*.pdf +*.png +*.out +*.xyc +*.xyd +auto +cil-api.tex +deputy.version.tex +deputypp.tex +deputycode.tmp +index.html +header.html \ No newline at end of file diff --git a/doc/TODO b/doc/TODO new file mode 100755 index 0000000..ffb6331 --- /dev/null +++ b/doc/TODO @@ -0,0 +1,14 @@ + +Deputy compiler +- complain about functions without prototype + + +Deputy run-time checks +- compile the library with optimizations on (two versions) +- efficient checking sequences without code-cache pollution + + +Example: +- in bh I had to turn the union into a struct because fields were used +differently in different stages of the computation. I should be able to add a +tag field though. \ No newline at end of file diff --git a/doc/comment.sty b/doc/comment.sty new file mode 100755 index 0000000..658686f --- /dev/null +++ b/doc/comment.sty @@ -0,0 +1,278 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Comment.sty version 3.6, October 1999 +% +% Purpose: +% selectively in/exclude pieces of text: the user can define new +% comment versions, and each is controlled separately. +% Special comments can be defined where the user specifies the +% action that is to be taken with each comment line. +% +% Author +% Victor Eijkhout +% Department of Computer Science +% University of Tennessee +% 107 Ayres Hall +% Knoxville TN 37996 +% USA +% +% victor@eijkhout.net +% +% This program 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. +% +% For a copy of the GNU General Public License, write to the +% Free Software Foundation, Inc., +% 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA, +% or find it on the net, for instance at +% http://www.gnu.org/copyleft/gpl.html +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% This style can be used with plain TeX or LaTeX, and probably +% most other packages too. +% +% Usage: all text included between +% \comment ... \endcomment +% or \begin{comment} ... \end{comment} +% is discarded. +% +% The opening and closing commands should appear on a line +% of their own. No starting spaces, nothing after it. +% This environment should work with arbitrary amounts +% of comment, and the comment can be arbitrary text. +% +% Other `comment' environments are defined by +% and are selected/deselected with +% \includecomment{versiona} +% \excludecoment{versionb} +% +% These environments are used as +% \versiona ... \endversiona +% or \begin{versiona} ... \end{versiona} +% with the opening and closing commands again on a line of +% their own. +% +% LaTeX users note: for an included comment, the +% \begin and \end lines act as if they don't exist. +% In particular, they don't imply grouping, so assignments +% &c are not local. +% +% Special comments are defined as +% \specialcomment{name}{before commands}{after commands} +% where the second and third arguments are executed before +% and after each comment block. You can use this for global +% formatting commands. +% To keep definitions &c local, you can include \begingroup +% in the `before commands' and \endgroup in the `after commands'. +% ex: +% \specialcomment{smalltt} +% {\begingroup\ttfamily\footnotesize}{\endgroup} +% You do *not* have to do an additional +% \includecomment{smalltt} +% To remove 'smalltt' blocks, give \excludecomment{smalltt} +% after the definition. +% +% Processing comments can apply processing to each line. +% \processcomment{name}{each-line commands}% +% {before commands}{after commands} +% By defining a control sequence +% \def\Thiscomment##1{...} in the before commands the user can +% specify what is to be done with each comment line. +% BUG this does not work quite yet BUG +% +% Trick for short in/exclude macros (such as \maybe{this snippet}): +%\includecomment{cond} +%\newcommand{\maybe}[1]{} +%\begin{cond} +%\renewcommand{\maybe}[1]{#1} +%\end{cond} +% +% Basic approach of the implementation: +% to comment something out, scoop up every line in verbatim mode +% as macro argument, then throw it away. +% For inclusions, in LaTeX the block is written out to +% a file \CommentCutFile (default "comment.cut"), which is +% then included. +% In plain TeX (and other formats) both the opening and +% closing comands are defined as noop. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Changes in version 3.1 +% - updated author's address +% - cleaned up some code +% - trailing contents on \begin{env} line is always discarded +% even if you've done \includecomment{env} +% - comments no longer define grouping!! you can even +% \includecomment{env} +% \begin{env} +% \begin{itemize} +% \end{env} +% Isn't that something ... +% - included comments are written to file and input again. +% Changes in 3.2 +% - \specialcomment brought up to date (thanks to Ivo Welch). +% Changes in 3.3 +% - updated author's address again +% - parametrised \CommentCutFile +% Changes in 3.4 +% - added GNU public license +% - added \processcomment, because Ivo's fix (above) brought an +% inconsistency to light. +% Changes in 3.5 +% - corrected typo in header. +% - changed author email +% - corrected \specialcomment yet again. +% - fixed excludecomment of an earlier defined environment. +% Changes in 3.6 +% - The 'cut' file is now written more verbatim, using \meaning; +% some people reported having trouble with ISO latin 1, or umlaute.sty. +% - removed some \newif statements. +% Has this suddenly become \outer again? +% +% Known bugs: +% - excludecomment leads to one superfluous space +% - processcomment leads to a superfluous line break +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\def\makeinnocent#1{\catcode`#1=12 } +\def\csarg#1#2{\expandafter#1\csname#2\endcsname} +\def\latexname{lplain}\def\latexename{LaTeX2e} +\newwrite\CommentStream +\def\CommentCutFile{comment.cut} + +\def\ProcessComment#1% start it all of + {\begingroup + \def\CurrentComment{#1}% + \let\do\makeinnocent \dospecials + \makeinnocent\^^L% and whatever other special cases + \endlinechar`\^^M \catcode`\^^M=12 \xComment} +%\def\ProcessCommentWithArg#1#2% to be used in \leveledcomment +% {\begingroup +% \def\CurrentComment{#1}% +% \let\do\makeinnocent \dospecials +% \makeinnocent\^^L% and whatever other special cases +% \endlinechar`\^^M \catcode`\^^M=12 \xComment} +{\catcode`\^^M=12 \endlinechar=-1 % + \gdef\xComment#1^^M{% + \expandafter\ProcessCommentLine} + \gdef\ProcessCommentLine#1^^M{\def\test{#1} + \csarg\ifx{End\CurrentComment Test}\test + \edef\next{\noexpand\EndOfComment{\CurrentComment}}% + \else \ThisComment{#1}\let\next\ProcessCommentLine + \fi \next} +} + +\def\CSstringmeaning#1{\expandafter\CSgobblearrow\meaning#1} +\def\CSstringcsnoescape#1{\expandafter\CSgobbleescape\string#1} +{\escapechar-1 +\expandafter\expandafter\expandafter\gdef + \expandafter\expandafter\expandafter\CSgobblearrow + \expandafter\string\csname macro:->\endcsname{} +} +\def\CSgobbleescape#1{\ifnum`\\=`#1 \else #1\fi} +\def\WriteCommentLine#1{\def\CStmp{#1}% + \immediate\write\CommentStream{\CSstringmeaning\CStmp}} + +% 3.1 change: in LaTeX and LaTeX2e prevent grouping +\if 0% +\ifx\fmtname\latexename + 0% +\else \ifx\fmtname\latexname + 0% + \else + 1% +\fi \fi +%%%% +%%%% definitions for LaTeX +%%%% +\def\AfterIncludedComment + {\immediate\closeout\CommentStream + \input{\CommentCutFile}\relax + }% +\def\TossComment{\immediate\closeout\CommentStream} +\def\BeforeIncludedComment + {\immediate\openout\CommentStream=\CommentCutFile + \let\ThisComment\WriteCommentLine} +\def\includecomment + #1{\message{Include comment '#1'}% + \csarg\let{After#1Comment}\AfterIncludedComment + \csarg\def{#1}{\BeforeIncludedComment + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\long\def\specialcomment + #1#2#3{\message{Special comment '#1'}% + % note: \AfterIncludedComment does \input, so #2 goes here! + \csarg\def{After#1Comment}{#2\AfterIncludedComment#3}% + \csarg\def{#1}{\BeforeIncludedComment\relax + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\long\def\processcomment + #1#2#3#4{\message{Lines-Processing comment '#1'}% + \csarg\def{After#1Comment}{#3\AfterIncludedComment#4}% + \csarg\def{#1}{\BeforeIncludedComment#2\relax + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\def\leveledcomment + #1#2{\message{Include comment '#1' up to level '#2'}% + %\csname #1IsLeveledCommenttrue\endcsname + \csarg\let{After#1Comment}\AfterIncludedComment + \csarg\def{#1}{\BeforeIncludedComment + \ProcessCommentWithArg{#1}}% + \CommentEndDef{#1}} +\else +%%%% +%%%%plain TeX and other formats +%%%% +\def\includecomment + #1{\message{Including comment '#1'}% + \csarg\def{#1}{}% + \csarg\def{end#1}{}} +\long\def\specialcomment + #1#2#3{\message{Special comment '#1'}% + \csarg\def{#1}{\def\ThisComment{}\def\AfterComment{#3}#2% + \ProcessComment{#1}}% + \CommentEndDef{#1}} +\fi + +%%%% +%%%% general definition of skipped comment +%%%% +\def\excludecomment + #1{\message{Excluding comment '#1'}% + \csarg\def{#1}{\let\AfterComment\relax + \def\ThisComment####1{}\ProcessComment{#1}}% + \csarg\let{After#1Comment}\TossComment + \CommentEndDef{#1}} + +\if 0% +\ifx\fmtname\latexename + 0% +\else \ifx\fmtname\latexname + 0% + \else + 1% +\fi \fi +% latex & latex2e: +\def\EndOfComment#1{\endgroup\end{#1}% + \csname After#1Comment\endcsname} +\def\CommentEndDef#1{{\escapechar=-1\relax + \csarg\xdef{End#1Test}{\string\\end\string\{#1\string\}}% + }} +\else +% plain & other +\def\EndOfComment#1{\endgroup\AfterComment} +\def\CommentEndDef#1{{\escapechar=-1\relax + \csarg\xdef{End#1Test}{\string\\end#1}% + }} +\fi + +\excludecomment{comment} + +\endinput diff --git a/doc/deputy.1 b/doc/deputy.1 new file mode 100644 index 0000000..f7ec8a0 --- /dev/null +++ b/doc/deputy.1 @@ -0,0 +1,50 @@ +.\" Hey, EMACS: -*- nroff -*- +.TH DEPUTY 1 "January 10, 2007" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +deputy \- Advanced C compiler that enforces type and memory safety +.SH SYNOPSIS +.B deputy +.RI [ options ] " files" ... +.SH DESCRIPTION +.\" TeX users may be more comfortable with the \fB\fP and +.\" \fI\fP escape sequences to invode bold face and italics, +.\" respectively. +Deputy is an advanced C compiler that enforces type and memory safety +in existing C programs. The programmer must add type annotations that +describe, for example, the bounds of each pointer in terms of other +program variables. Deputy uses static analysis and run-time checks to +enforce safety based on these annotations. +.PP +Further information and documentation is available at +\fBhttp://deputy.cs.berkeley.edu/\fP. +.SH OPTIONS +The \fBdeputy\fP command is designed to be a drop-in replacement for +\fBgcc\fP, so most of the standard options for \fBgcc\fP should work +as expected. Further information can be found at the URL above and +by using the following commands: +.TP +.B \-h, \-\-help +Show summary of options. +.TP +.B \-v, \-\-version +Show version of program. +.SH SEE ALSO +.BR gcc (1). +.SH AUTHOR +Deputy was written by Jeremy Condit , Matthew +Harren , Zachary Anderson , +and George C. Necula . +.PP +This manual page was written by Jeremy Condit . diff --git a/doc/deputy.tex b/doc/deputy.tex new file mode 100755 index 0000000..0cd7e42 --- /dev/null +++ b/doc/deputy.tex @@ -0,0 +1,3877 @@ +\documentclass{book} + +\usepackage{hevea} +\usepackage{graphicx} % for includegraphics + +%\begin{latexonly} +%\ifx\pdfoutput\undefined +% \usepackage{hyperref} +%\else +% \usepackage[pdftex]{hyperref} +%\fi +%\end{latexonly} + +\usepackage{color} + +% deputy.version.tex is generated automatically to define \deputyversion +% and \deputyversion +\include{deputy.version} + +\renewcommand\t[1]{{\tt #1}} +\newcommand\codecolor{\ifhevea\blue\else\fi} +\renewcommand\c[1]{{\codecolor #1}} % Use for code fragments +\newcommand\SAFE{\t{SAFE}} +\newcommand\BND{\t{BND}} +\newcommand\NTS{\t{NTS}} +\newcommand\COUNT{\t{COUNT}} +\newcommand\AUTO{\t{\_\_auto}} +\newcommand\THIS{\t{\_\_this}} + +\newcommand\RTTI{\t{RTTI???}} +\newcommand\SEQ{\t{SEQ???}} +\newcommand\FSEQ{\t{FSEQ???}} +\newcommand\WILD{\t{WILD???}} + +\newcommand\TODO[1]{{\ifhevea\red\else\fi TODO: #1}} +\newcommand\secref[1]{Section~\ref{sec-#1}} +\newcommand\chref[1]{Chapter~\ref{ch-#1}} +\newcommand\appref[1]{Appendix~\ref{ch-#1}} + +%%% Define an environment for code +%% Unfortunately since hevea is not quite TeX you have to use this as follows +%\begin{code} +% ... +%\end{verbatim}\end{code} +\def\code{\begingroup\codecolor\begin{verbatim}} +\def\endcode{\endgroup} + +% +% \begin{deputycode}...\end{deputycode} is taken care by deputycode.pl +% + +%use this for links to external pages. It will open pages in the +%top frame. +\newcommand\ahreftop[2]{{\ahref{javascript:loadTop('#1')}{#2}}} + + + +% Make sure that most documents show up in the main frame, +% and define javascript:loadTop for those links that should fill the window. +% Use BEGIN/END IMAGE to make sure that makeatletter/makeatother +% appear in the image file too. +%BEGIN IMAGE +\makeatletter +%END IMAGE +\let\oldmeta=\@meta +\def\@meta{% +\oldmeta +\begin{rawhtml} + + +\end{rawhtml}} +%BEGIN IMAGE +\makeatother +%END IMAGE + + +\begin{document} +\begin{latexonly} +\title{Deputy \deputyversion: User Manual} +\end{latexonly} +\maketitle + +\chapter{Introduction} + + \emph{This version of the document refers to Deputy {\deputyversion} + and was last modified on \today. This document is also available in + \ahref{DEPUTY.pdf}{PDF format}} + + +Deputy is a source-to-source translator for C. It analyzes the C program to +determine the smallest number of run-time checks that must be inserted in the +program to prevent all memory safety violations. The resulting program is +memory safe, meaning that it will stop rather than overrun a buffer or +scribble over memory that it shouldn't touch. ... + + Deputy relies on a lightweight system of annotations on pointer types. The +programmer must supply the annotations for all global pointers (function +arguments and returns, structure fields, types of global variables) and Deputy +will attempt to infer the annotations for local variables and for type casts. + + The Deputy itself is written in Ocaml (a dialect of ML). There is also a +Perl script, \c{deputy}, that operates as a drop-in replacement for 'gcc', so +that software packages' existing Makefiles can be used with very minor +changes. + + Deputy is implemented on top of the \@print{CIL framework}. for analysis and transformation +of C programs. CIL allows the quick development of program analysis +modules that works on ANSI C code as well as on code that uses the GNU C +extensions. + + If you are anxious to see Deputy in action you can try out our +\@print{online demo}. + + In this manual you can find a tutorial on getting started with Deputy +(\chref{tutorial}), documentation for all of the features (actually some of +the more researchy features are not yet fully documented) and step-by-step +accounts on what it takes to use Deputy on several example programs +(\chref{examples}). We suggest that you read the chapters in order and go to +the ``Advanced Deputy Features'' only if you need it. The \chref{warn} (Deputy +Warnings and Errors) will help you figure out if you are running into an error +that is covered by an advanced feature. + +\section{Authors} + + Deputy was developed primarily by +\ahref{mailto:jcondit@cs.berkeley.edu}{Jeremy Condit}, +\ahref{mailto:matth@cs.berkeley.edu}{Matthew Harren} and +\ahref{mailto:necula@cs.berkeley.edu}{George Necula}. +Other people helped with +various components: ... + + This work was supported in part by the National Science Foundation under +Grants No. ???, 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. + + \chapter{Installation}\label{ch-start} + + Deputy works on Linux and MS Windows (for now only with cygwin). + + Deputy is somewhat sensitive to the version of the compiler that you are +using. More precisely, Deputy is sensitive to the format of the system include +files that you are using. When you install Deputy it will create slightly +modified copies of some of the system include files. These copies are created +based on some patches that we distribute with Deputy. If your include files +are different from those that we used to create the patches then the Deputy +installation might fail. At the moment we have tested Deputy with the +following compilers: + +\begin{itemize} +\item On Windows, using \c{cygwin} and \c{gcc} version 3.4.4. +\item On Linux, using \c{gcc} version 3.4.4 +\end{itemize} + + If you want to use Deputy on Windows then you must get a complete +installation of \c{cygwin} (make sure you install the development tools such +as \c{gcc} and \c{ld} as well and the \c{perl} interpreter) and the {\bf +source-code} Ocaml distribution and compile it yourself using the cygwin tools +(as opposed to getting the Win32 native-code version of Ocaml). You will need +Ocaml release 3.08 or higher to build Deputy. If you have not done this before +then take a look \ahref{../ccured/setup.html}{here}. (Don't need to worry +about \c{cvs} and \c{ssh} unless you will need to use the master CVS +repository for Deputy.) + +\section{Get the Deputy sources} + + Download the Deputy \ahref{distrib}{distribution} (latest version is +\ahrefurl{distrib/deputy-\deputyversion.tar.gz}). See the \secref{changes} for +recent changes to the Deputy distribution. + + If you are one of the Deputy developers you can ask Jeremy Condit +(\mailto{jcondit@cs.berkeley.edu}) for an account that allows you to use the +master CVS repository on \c{manju.cs.berkeley.edu}. Assuming you have already +setup \c{cvs} and \c{ssh} as discussed in \ahrefurl{cvssetup.html}, you can +check out the sources in a subdirectory \c{deputy} as follows: + +\begin{verbatim} + % cvs -d :ext:jcondit@manju.cs.berkeley.edu:/home/cvs-repository checkout deputy + ^^^^^^^ + use your username instead +\end{verbatim} + +\section{Configure and Compile Deputy} + + Run the following commands in the top level directory. If you are using +Windows then at least the \c{configure} command must be run from within +\c{bash}. +\begin{verbatim} +./configure +make +make quicktest (optional) +\end{verbatim} + + The \c{configure} script tries to find appropriate defaults for your system. + + It is possible that you get a configuration error saying that certain patterns +did not match. This means that your standard include files are different than +those that we have prepared the distribution for. (See the above discussion.) +Your recourse in this case is either to install one of the versions of the +compiler that we tested Deputy for or to extend the patch files so that they +match your includes. It is not hard, and it is explained in the +\ahref{../cil/patcher.html}{patcher} documentation. + + After running \c{make} you have built a few executables (in the \c{obj} +directory) and have configured the \c{bin/deputy} Perl script. If you want to +move this script to another directory (e.g. to \c{/usr/local/bin}) make sure +to copy the \c{DeputyConfig.pm} file to the same directory. + + Now you can continue with a tutorial (\chref{tutorial}), or you can jump +ahead and find out how to run Deputy (\chref{invoke}). + +\section{Test Deputy} + + Once you have built Deputy you can run +\begin{verbatim} +make quicktest +\end{verbatim} + + This will run a few small examples. If you want to test Deputy on a large +part of our own regression suite you need to do the following: +\begin{itemize} +\item In the \t{test} directory, run +\begin{verbatim} +runtests --run +\end{verbatim} + + See \secref{regtest} for details on how to use the regression tester. + +\end{itemize} + + +\chapter{Deputy Tutorial}\label{ch-tutorial}\cutname{tutorial.html} + + Deputy is an extension of the C programming language that distinguishes among +various kinds of pointers depending on their usage. The purpose of this +distinction is to be able to prevent improper usage of pointers and thus to +guarantee that your programs do not access memory areas they shouldn't access. +You can continue to write C programs but Deputy will change them slightly so +that they are type safe. In this chapter we explain in what situations will +your program be changed and in which way. + + Deputy leaves unchanged code that does not use pointers or arrays. Actually, +Deputy is implemented on top of the C Intermediate Language (CIL) +infrastructure, which means that C programs are first translated into a subset +of the C language that has simple semantic rules. The following are some of +the transformations that are performed: +\begin{itemize} +\item C expressions and statements are separated into expressions (no +side-effect and no control-flow), instructions (assignments and function +calls, with one side-effect and no control-flow) and statements (the +control-flow constructs). This means that CIL serializes the side-effects and +the control-flow. +\item All type and structure declarations are moved to the beginning of the +file. +\item The scope of variables is resolved and local variables are renamed +accordingly. All local variables are moved to function-scope and are declared +at the beginning of the function body. The initialization for such variables +is done using explicit assignment instructions. +\item Anonymous structures and unions are given unique names. +\item All implicit casts and conversion are expressed as explicit casts. +\item All GNU CC extensions are compiled into regular C code. +\end{itemize} + + For a complete description of the CIL infrastructure see +\ahref{../cil/index.html}{the CIL documentation}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Deputy Annotations}\label{sec-typeannot} + + The most significant difference between C and Deputy is that Deputy pays +close attention to how pointers are manipulated and it classifies pointers +into various kinds according to what you do with them. We'll discuss the +various kinds starting in the next section but before that we need to +introduce an important notation that you can use to communicate to Deputy +which pointer kinds you want for your pointers. + + Deputy uses type attributes to express the kind of pointers. Type attributes +exist in a limited form in ANSI C (i.e. the \c{volatile}, \c{const} and +\c{restrict} type qualifiers) and in a richer form in the GCC dialect of C. +Deputy, just like GCC, allows any attributes to be specified for types, names +of variables, functions or fields, and for structure or union declarations. +Unlike GCC, Deputy has precise rules for how attributes are interpreted in a +declaration (instead GCC relies on knowing the semantics of the attribute in +order to associate it with the proper element of a declaration). The rule of +thumb is that the attribute of a pointer type is written immediately {\bf +following} the \c{*} pointer-type constructor and the attribute of a name is +written immediately before the semicolon or the \c{=} sign that terminates the +declaration of the name. Deputy uses pointer-kinds such as \SAFE{}, \NTS{} and +\BND{} and the corresponding attribute use the same names. For example, in the following declaration: +\begin{deputycode}[] +int * NTS * SAFE x; +\end{deputycode} + + the type of \c{x} is declared to be a \SAFE pointer to a null-terminated C +string (\NTS). Just like pointer-types in C, attributes are read from +right-to-left. The \c{SAFE} attribute in this case applies to the pointer-type +of \c{x}. + + (The complete attribute-parsing rules for CIL are described in the +\ahref{../cil/attributes.html}{CIL manual}.) + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{\SAFE{} pointers} + + The main action in Deputy concerns the features that endanger type safety in +C: pointer, arrays, union types, and variable argument functions. Pointers in +C can be assigned to l-values, dereferenced, subject to pointer arithmetic and +cast to other pointer or non-pointer types. In contrast, pointers in a typical +type-safe language (e.g. Java, Basic, ML) cannot be subject to arithmetic or +(arbitrary) casts. Deputy allows (almost) all the pointer operations that C +allows but gives preferential treatment to pointers that are not subject to +arithmetic or to casts. Deputy refers to such pointers as \SAFE{} pointers. + + Consider for example this small code-fragment that computes the length of a +linked list: +\begin{deputycode}[] +struct list { + int car; + struct list * SAFE cdr; +}; + +int length(struct list * SAFE l) { + int i = 0; + while(l) { + l = l->cdr; + i ++; + } + return i; +} +\end{deputycode} + + The only pointers used in this code fragment are pointers to list cells and +they are not subject to arithmetic or to casts. In fact, this code fragment +can be transcribed literally into Java or C\#. You can see in the output of +Deputy that the pointer dereferences contain only \TODO{what? There are + actually no checks} checks. + +\paragraph{Properties of \SAFE{} pointers} + The \SAFE{} pointers are the ``best'' kind of pointers, meaning that they +incur the least amount of run-time cost. Here is a list of the properties of +\SAFE{} pointers: +\begin{itemize} +\item Cannot be subject to pointer arithmetic (adding or subtracting an +integer from it). +\item Cannot be cast (except subject to stringent rules which we'll discuss +below). Note that assignment, passing actual arguments and returning are +implicit casts. +\item Can be set to a compile-time constant equal to 0 but not to any other +integer expression. +\item Can be cast to an integer and can be subtracted from another pointer. +This is useful for comparisons. +\item \SAFE{} pointers are represented using the standard C representation +using one word. +\item Every time a \SAFE{} pointer is dereferenced, a null check is inserted +before the dereference. +\end{itemize} + + All of these restrictions are such that the following invariant holds for all +\SAFE{} pointers: +\begin{center}\bf +A \SAFE{} pointer to type \c{T} is either 0 or else it points to a valid area +of memory containing an object of type \c{T}. Furthermore, all other pointers +to the same area agree on the type \c{T} of the stored object. +\end{center} + + +% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 +% \subsection{Safe Casts} +% +% Casting a pointer to an integer is always allowed. Deputy does actually allow +%certain other casts on \SAFE{} pointers. For example it is safe to cast a +%pointer to a structure containing two integers into a pointer to integer. In +%general it is safe to cast a pointer to a long structure into a pointer to a +%short structure as long as the two structures agree on the types of the +%elements in the overlapping portion. Deputy is actually quite liberal about +%these rules and will think of nested combinations of structures and arrays as +%one big structure with non-structure and non-array fields. This feature is +%called {\em physical subtyping}. For example, in the code shown below, all of +%the four casts implicit in the assignments are safe and Deputy will infer that +%all pointers involved are \SAFE{}. +% +%\begin{deputycode}[] +%struct large { +% struct small { +% int * SAFE f1; +% int * SAFE f2; +% } a; +% int * SAFE f3; +%} x; +% +%struct small * SAFE s1 = & x; +%int * SAFE * SAFE s2 = & x; +%struct large1 { int * SAFE a1, * SAFE a2, * SAFE a3; } * SAFE s3 = & x; +%struct large2 { int * SAFE a1, * SAFE a2[2]; } * SAFE s4 = & x; +%\end{deputycode} +% +% Notice that all of the \c{s1}, \c{s2}, \c{s3} and \c{s4} are aliases for the +%address of \c{x} but they agree on the type of the object pointed to. +% +% Following are two examples of casts that are not allowed (for \SAFE{} +%pointers; you can see that Deputy infers the \WILD{} kind for the pointers +%involved) \TODO{what we need to say here. Deputy allows this}: +%\begin{deputycode}[] +%int y1; +%int * * x1 = & y1; // Cast an int * to a int * * +%int y2; +%struct large { int * a1, a2; } * x2 = &y2; +%\end{deputycode} +% +% If the first cast were allowed then by writing to \c{y1} an arbitrary +%integer we would be invalidating the assumption that \c{x1} points to a +%pointer value. The second cast is similar. + + + %%%%%%%%%%%%%%%%%%%%%%%%%% + \subsection{\SAFE{} Function Pointers} + + There is nothing special about function pointers. They can be safe provided +that they are not cast to incompatible pointer types. A function pointer type +is compatible only with another function pointer type with the same number and +type of arguments and the same result type. + + A common problem with function pointers (and functions) in Deputy is if your +program uses external function without prototypes. This makes Deputy think +that the function is taking no arguments and returning an integer and every +time you use it in a different way Deputy behaves as if you are casting the +function pointer (denoted implicitly by the function's name) to the type +needed in the cast. Deputy will give errors when you are using +using functions without +prototype and we recommend that you fix those problems and try Deputy again. + + + %%%%%%%%%%%%%%%%%%%%%%%%%\ + \section{Checks for \SAFE{} Pointers} + + As we mentioned above, every time a \SAFE{} pointer is dereferenced it must be +checked whether it is null or not. We know from the invariant for \SAFE{} +pointers that non-null pointers can be dereferenced and we can count that the +value read through them has the type given by the pointer type. + + A null check appears in the output of Deputy as a call to the function +\c{CNonNull}. This and other run-time checking functions used by Deputy have a +name that starts with the prefix \c{C} and are declared in the file +\ahrefurl{include/deputy/checks.h}. You will see in that file that most of +these functions are declared inline. + + Checking for null pointers is necessary not just when reading or writing +through them but also when they are used to compute the address of a subobject +of the object they point to. For example, in the following code Deputy will +add a run-time check that \c{s} is not null before computing the value of +\c{x}. Then again there will be a check that \c{x} is not null before +dereferencing it. +\begin{deputycode}[] +struct str { + int a, b; +}; + +int getaddr(struct str * SAFE s) { + int * SAFE x = & (s->b); + return *x; +} +\end{deputycode} + + The first check in the code above is necessary to enforce the invariant that +\SAFE{} pointers are either 0 or else valid pointers. Without that check the +value of \c{x} would be 4 (on most machines) which would break the invariant +and would defeat the second null-check\TODO{How come there is no run-time + check on *x? We should explain.} thus letting you dereference an invalid +pointer. + + At this point you are starting to see some of the subtleties in the design of +Deputy. To ensure that we got everything right we have formalized the type +system of Deputy and we proved (for a subset of Deputy) that the set of +run-time checks and invariants achieve memory safety. + + Deputy includes a simple optimizer that tries to eliminate redundant +checks and checks that cannot possibly fail (such as checking that the address +of a global variable is non-null). Currently the optimizer is fairly naive. +For example, it does not know that since \c{s} is a non-null \SAFE{} pointer +to \c{struct str} then \c{\&(s->b)} is guaranteed to be non-null as well, thus +the second check is not really necessary.\TODO{It might actually already know +that.} + + Speaking of too many checks, some of the more experienced C programmers +will have noticed that our run-time checks prevent a common idiom for computing +the offset of fields in structures. The typical code for doing that is shown +below (as is defined as the macro \c{offsetof} in many C libraries): +\begin{deputycode}[] +struct str { + int a, b; +}; + +int get_offset_of_b() { + return (int) &(((struct str*)0)->b); +} +\end{deputycode} + + Deputy recognizes in this specific case that you are casting the result of +the \c{\&} operator to an integer, so it avoids the run-time check.\TODO{Does + Deputy recognize this? It should.} + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Pointer Arithmetic} + + So far we have discussed pointers for which we disallow most casts and +pointer arithmetic. In this section we will generalize \SAFE{} pointers to +allow pointer arithmetic, while allowing for static and run-time checks +against buffer overrun. The cost that the programmer pays for using these more +capable pointers is that each dereference will be accompanied by bounds +checks. + +\TODO{I am trying to add the checks one by one} + Consider the following code fragment. The pointer \c{x} cannot be \SAFE{} +because adding \c{delta} to it is not guaranteed to yield a meaningful result. +Instead, we declare \c{x} as a pointer to at least 8 integers. +\begin{deputycode}[] +int increment(int * COUNT(8) x, int delta) { + return (int)(x + delta); +} +\end{deputycode} + + You can see in the Deputy output for the above example that Deputy first +checks that \t{x} is not null, and then adds a series of checks. First, there +are checks that ensure that \c{x + delta} does not overflow (\c{COverflow}), +and it remains within the declared bounds (two instances of \c{CUnsignedLE}). + + Deputy also inserts checks on assignment of pointer to buffers: +\begin{deputycode}[] +int index(int * COUNT(count) x, int count) { + int * COUNT(2) y = x; + return *y; +} +\end{deputycode} + + We see that Deputy requires that either \c{x} is null, or else \c{x} $\leq$ x +$\leq$ \c{x + 2} (check \c{CNullOrLE}) to ensure that after the assignment +\c{y = x} we establish the invariant required for $y$. (The last check in the +above example is due to the reading from \c{y}; only a null check is needed +since we know that if \c{y} is not-null it is safe to read from it.) + + Now we can put together the arithmetic check and the coercion check: +\begin{deputycode} +int index (int * COUNT(count) x, int count) { + int * COUNT(1) y = x + 2; + return *y; +} +\end{deputycode} + +\TODO{How come we do not have an overflow check above? What if x + 2 overflows?} + +\subsection{Bounded Pointers} + + The most general form of bounded pointers uses the \BND{} annotation, with +two expressions denoting the start (inclusive) and the end (exclusive) of the +memory area pointed-to by a pointer. + + For example, in the following program \t{x} is declared to be either null, or + larger or equal to \t{b} and less than \t{b + 8}: +\begin{deputycode} +int foo(int * BND(b, b + 8) x, int * b) { + return x[3]; +} +\end{deputycode} + + In fact, the \SAFE{} and \COUNT{} annotations described before are just +special cases of \BND{} annotations: +\begin{verbatim} +#define COUNT(n) BND(__this, __this + (n)) +#define SAFE BND(__this, __this + 1) +\end{verbatim} + +\subsection{Invariants for bounded pointers} +\begin{itemize} +\item Cannot be cast (except subject to stringent rules which we'll discuss +below). Note that assignment, passing actual arguments and returning are +implicit casts. +\item Can be subject to pointer arithmetic (adding or subtracting an +integer from it). +\item Can be cast to an integer and can be subtracted from another pointer. +This is useful for comparisons. +\item Every time a bounded pointer is dereferenced, both a check that the +pointer is not null and a bounds check are inserted. +\end{itemize} + +\begin{deputycode} +extern void* (DALLOC(sz) malloc)(unsigned int sz); +int foo(int x) { + int * COUNT(8) p, * COUNT(16) r1, * COUNT(8) r2; + int a[8]; + + r1 = (int*)malloc(16); + r2 = a; + p = r1; + p = r2; + return *(p + x); +} +\end{deputycode} + +The invariant for a pointer \t{p} with type \t{T * BND(b,e)} is that it is +either null, or else there exists a valid allocation area starting at \t{a}, +containing \t{n} elements of type \t{T}, and $\t{a} \leq \t{b} \leq \t{p} \leq +\t{e} \leq \t{a + n}$. Furthermore, \t{b}, \t{p} and \t{e} are aligned with +respect to the start of the allocation area and the type \t{T}. + +\subsection{Run-time checks for bounded pointers}\label{sec-checkseq} + + Every time we dereference a bounded pointer, we must check that it is +non-null and it is not equal to the declared upper bound. + +Also, for a pointer arithmetic operation we check that the pointer is +non-null and after the operation is stays in the same area as the original +pointer. + + For example, in the following code we must check that the operation \t{x + i} +results in a pointer withing the declared bounds of \t{x}. +\begin{deputycode} +int foo(int * BND(b, b + 8) x, int * b, int i) { + int * BND(b, b + 8) p = x + i; + return *p; +} +\end{deputycode} + + An interesting situation is when we assign bounded pointers: +\begin{deputycode} +int foo(int * BND(b, b + 8) x, int * b, int * e, int i) { + int * BND(e, e + 2) p = x + i; + return *p; +} +\end{deputycode} + + +% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Auto Bounds} + + Deputy allows the programmer to control a mechanism for inferring the bounds +of pointers. To invoke this mechanism, you can use the keyword \AUTO{} in +place of one or both of the arguments of the \BND{} annotation. When seeing +such an annotation the +\begin{itemize} +\item If \AUTO{} appears in the type of a local variable, a formal argument, + or a cast, Deputy will create a local variable (or formal argument) for the + corresponding bound and will insert code to track its value +\begin{deputycode} +int foo(int * COUNT(n) p, int n) { + int * x; + if(*p) { + x = p; + } else { + x = p + 2; + } + return *x; +} +\end{deputycode} + + This local use of \AUTO{} is entirely safe, and in fact Deputy will use tihs + feature for all local variables and casts that do not have bounds + annotations. + +\item If \AUTO{} appears in the return type of a function, the type of a + global variable, the type of a field, or the base type of a pointer type, + then the annotated pointer type is transformed into a ``fat'' structure with + new fields to carry the necessary data: +\begin{deputycode} +struct foo { + int * BND(__this, __auto) fseq; +} p; +int array[8]; +int main() { + p.fseq = & array[2]; +} +\end{deputycode} + + Here is an example with \AUTO{} in the return type of a function: +\begin{deputycode} +int array[8]; +int * BND(__this, __auto) getints(void) { + return & array[2]; +} +\end{deputycode} + +Such uses of \AUTO{} are dangerous because they change the representation of +data in a way that is visible from other functions. To prevent you from +accidentaly mixing deputized and native versions of the same globals, Deputy +will change the name of globals (or functions) whose representation (or +calling convention) changes. + +\end{itemize} + + +% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Default Annotations} + + If a pointer is missing bounds annotations then Deputy will add its own + annotation as follows: +\begin{itemize} +\item If this is a cast or the type of a local variable it adds \BND(\AUTO, + \AUTO), in essence demanding the creation of local variables to track the + bounds. +\item In all other cases, Deputy adds the annotation \SAFE. +\end{itemize} + +% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{String Pointers} + +The C idiom of using a character pointer for passing character strings +is so ubiquitous that Deputy has a specialized kind of pointer qualifier +for this usage, called \TODO{??}. + + +%Conceptually, a string pointer is just like an \FSEQ{} pointer, except the +%end-pointer is implicitly stored in the string data itself, rather than +%alongside the main pointer. In particular, the memory pointed-to is +%declared to be an array of characters, and is always used in a way +%consistent with that declaration. +% +%String pointers maintain the invariant that (unless \c{NULL}) they always +%point within a valid array of characters, and there is always a 0 byte +%just beyond the end of the array. +% +% String pointers can be converted to \FSEQ{} pointers using an invocation of +%the +%\begin{deputycode} +%int foo(char __RWSTRING *s) { +% char * __FSEQ x = s; +%} +%\end{deputycode} +% +% +%The 0 byte beyond the end cannot be changed by the program, whether through +%a string pointer or through another kind of pointer. Other kinds of +%pointers will have their metadata arranged to prevent writing the 0. +%Strings are never allowed to overwrite \emph{any} 0 byte they encounter +%(because it could be the last one). +% +%To guarantee the existence and immutability of the 0 byte, every occurrence +%in the program of the type ``array of characters of length $n$'' is +%rewritten to be ``array of characters of length $n+1$''. But, this happens +%after boxing, so all pointer metadata continues to disallow access beyond +%the $n$th byte, hence the 0 byte is protected. Further, any call +%to \c{malloc} requesting $n$ bytes gets at least $n+1$ bytes of data, all +%initialized to zero (a possible improvement is to allocate the extra +%byte more selectively, only when a string pointer will point to the memory +%being allocated). +% +%One problem with this scheme is the program might ask for the size of an +%array using \c{sizeof}. Since the length has changed, \c{sizeof} will +%return $n+1$, which is now an observable consequence of translation. To +%partially mitigate this, any occurrence of ``\c{sizeof($e$)}'' where $e$ has +%type ``array of characters'' is rewritten to be ``\c{(sizeof($e$)-1)}''. +%This rewriting does not look inside structure types, for example, so it does +%not completely hide the effect. However, it has proven sufficient for +%the programs translated so far. +% +%All of the rewriting described in this section is done by the +%\c{expandCharArrays} visitor in \c{box.ml}. + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Safe Union Types}\label{sec-union} + +Union types are another potential source of unsoundness in C programs. +Deputy supports {\em tagged unions}, in which a tag value near the +union denotes which field of the union is ``active''. These +tags are already present in most C code; Deputy enforces them in a +type-safe way. + +The following example shows the most common form of a tagged union: a +union and its tag together in a struct. In this program, the tag +\c{x.tag} is used to determine the active field of union \c{x.data}. + +\begin{deputycode}[] +enum tagValues { ZERO, ONE, TWO, THREE }; +struct twothings { int a; int* p; }; + +struct variant { + enum tagValues tag; + union un { + int f1 WHEN(tag == ONE); + int * SAFE f2 WHEN(tag == TWO); + struct twothings f3 WHEN(tag == ZERO || tag == THREE); + } data; +} x; + +int foo() { + return x.data.f1; +} +\end{deputycode} + +Tags are defined by annotating each union field with \c{WHEN($exp$)} +where \c{$exp$} is a boolean expression that is true when the field is +active. \c{WHEN} conditions can contain integer arithmetic and +comparisons, and they can depend on one or more names in the same +context as the union. So if a local variable has union type, its +\c{WHEN} clauses can depend on other locals, while a union type used +as a struct field (by far the most common case) can depend on other +fields of the struct. +\TODO{Make sure this matches the terminology (e.g. ``contexts'') +that's used in the discussion of pointer dependencies.} + +You must ensure that the \c{WHEN} annotations are disjoint. That is, +no two fields should be ``selected'' at once. Deputy does not yet check +this statically, so it's a runtime error to use a tag value that +selects more than one field. + +There are three key rules when using tagged unions: +\begin{itemize} +\item Whenever you read from or write to a field, Deputy will check that + the tag value(s) satisfy the \c{WHEN} clause for that field. +\item Whenever you change a tag value, the entire union must first be + zeroed. Doing this ensures that the new active field can be + immediately read; a pointer field will be \t{NULL}, which is always + valid for a pointer type. +\item You may not take the address of a union field. (This would be + unsound, if the pointer to the field was used after the tag changed.) +\end{itemize} + +If you want to change the value of both a union and a tag, you should +do the following. This is analogous to the procedure for changing +dependent pointers, in which you must usually zero the pointer before +changing the length. +\begin{enumerate} +\item Zero the entire body of the union (\c{memset} is easiest). +\item Change the tag(s) as desired. +\item Set the newly-active union field to the new value. +\end{enumerate} + +\begin{deputycode}[] +#include + +enum tagValues { ZERO, ONE, TWO, THREE }; +struct twothings { int a; int* p; }; + +struct variant { + enum tagValues tag; + union un { + int f1 WHEN(tag == ONE); + int * SAFE f2 WHEN(tag == TWO); + struct twothings f3 WHEN(tag == ZERO || tag == THREE); + } data; +} x; + +int setData(int new_a, int* new_p) { + + memset(&x.data, 0 , sizeof(x.data)); + //It is now legal to change x.tag to any value + + x.tag = THREE; + //x.data.f3 is now the active field of x.data. + + x.data.f3.a = new_a; + x.data.f3.p = new_p; + return *x.data.f3.p; +} +\end{deputycode} + + + +\subsection{Non-pointer fields} + +For the sake of type safety, you must provide a \c{WHEN} annotation +for a field whose type contains a pointer. But these annotations are +optional for fields that don't involve pointers. Deputy allows reads +from unannotated fields regardless of the tag value, which is sound +because Deputy's type safety invariants apply only to pointers, not +integers. + +This union contains no pointers, so it can be left completely +unannotated. In fact, the programmer may very well be intending to +write to one field but read from another. +\begin{code} +typedef union _LARGE_INTEGER { + struct parts { + ULONG LowPart; + LONG HighPart; + } u; + LONGLONG QuadPart; +} LARGE_INTEGER; +\end{verbatim}\end{code} + +If you want to avoid accidentally confusing the fields of this union, +you can always choose to annotate it. If \c{WHEN} clauses are used, +they will be enforced even though memory safety doesn't require it. + +One common use of this rule is unions that have both integer and +pointer fields, where the program may want to write to a pointer field +but read from the integer field. In this case, you can leave the +integer field unannotated to indicate that all reads through that +field are allowed. Of course, it's illegal to write to the unannotated +field if any annotated field is currently selected. + +\begin{deputycode}[] +enum tagValues { ZERO, ONE, TWO, THREE }; +struct twothings { int a; int* p; }; +extern int hash(int z); + +struct variant { + enum tagValues tag; + union un { + int hashcode ; // No WHEN annotation + double * SAFE f1 WHEN(tag == ONE); + int * SAFE f2 WHEN(tag == TWO); + struct twothings f3 WHEN(tag == THREE); + } data; +}; + +int hash_of_variant(struct variant* x) { + // Reading x->data.hashcode is legal no matter which field of + // the union is selected. + return hash(x->data.hashcode); +} + +void write(struct variant* x) { + //This will fail at runtime if x->tag is 1, 2, or 3! + x->data.hashcode = 0xdeadbeef; +} +\end{deputycode} + +\subsection{Trusted unions} + +If you want to ignore the unsoundness of a union that contains +pointers, or if you've convinced yourself that the union is used in a +sound way, you can mark the union as \c{TRUSTED}. Deputy will do no +checking of trusted unions, and will allow you to take the address +of union fields. + +You can place the \c{TRUSTED} annotation after either the word +\c{union} or the closing right brace. + +\begin{deputycode}[] +union TRUSTED afl { + double f1; + int * SAFE f2; +} data1; + +//This is an equivalent placement of TRUSTED: +union cio { + double f1; + int * SAFE f2; +} TRUSTED data2; + +int* SAFE * SAFE intpp; + +void unsound() { + intpp = &data1.f2; + data1.f1 = 3.14159; +} +\end{deputycode} + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Not-Yet Documented Features} + +\TODO{This section contains only reminders of features to document} +\begin{itemize} +\item When you take the address of an element into an array, the inferred + pointer type refers to the whole array. In other words ``\& array[idx]'' + behaves exacly like ``array + idx''. +\end{itemize} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Invoking Deputy}\label{ch-invoke} + +\TODO{this section} + + Deputy consists of several components: an Ocaml application that does the +main work, a set of Perl scripts that are used to invoke the Deputy +application, and a set of header and run-time library files. + + The easiest way to use Deputy is through the \c{bin/deputy} script. This +script is intended to be used in the same context and with the same +command-options as either the \c{gcc} compiler or the Microsoft Visual C +compiler (MSVC). This script is configured at installation time to know where +the rest of the Deputy installation resides. If you move this script to +another directory you must also make a copy in the new directory of the +\c{DeputyConfig.pm} file. + + Since \c{deputy} is a drop-in replacement for \c{gcc}, for most software +projects you can reuse the regular build-infrastructure: +\begin{verbatim} +make mystuff CC="bin/deputy [options]" +\end{verbatim} + + Here is the sequence of actions that the \c{deputy} script performs: +\begin{enumerate} +\item It recognizes among the command-line arguments those that are intended +for the pre-processor; then, for each source file (i.e. with the extension +t{.c}), calls the preprocessor and places the result in a file with the +extension \c{.i} in the same directory as the source file. +\item For every \c{.i} file that it produces and that must be compiled (i.e. +the \c{-E} option was not specified to require only preprocessing) \c{ccured} +will save a copy of the file with the extension \c{.o}, thus ``fooling'' +\c{make} that the object file was actually produced. +\item Whenever \c{ccured} is invoked to link {\em into a library} a number of +\c{.o} files that are actually preprocessed sources saved in the previous +step, the Deputy engine will be invoked to parse all of the files and produce +a single \c{C} file with the same content but with names of types and +variables properly renamed. The output is then saved as the resulting library. +You should use the \c{--mode=AR} argument to Deputy if you want to pass the +remaining arguments as for the \c{ar} utility. More details about the merging +stage that Deputy used can be found \ahref{../cil/merger.html}. +\item Finally, when \c{ccured} is called to link {\em into an executable} a +number of object files and libraries it will separate from them those that are +actually saved sources and will merge them all in memory. The resulting file +is then subject to Deputy type inference followed by the insertion of run-time +checks. Optionally, an optimizer is invoked to try to clean up some of the +inserted run-time checks. The result is saved using the full name of the +desired executable with the suffix \c{ccured.c}. Finally this file is +preprocessed, compiled and linked using the underlying compiler. +\end{enumerate} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 +\section{Command-line options}\label{sec-commandline} + +\TODO{this section} + + You always run Deputy with the command options of \c{gcc} (e.g., \c{-c} to +compile only, \c{-o} to specify the output file, etc.). Here are some common +ways to use invoke Deputy: +\begin{itemize} +\item \c{bin/ccured --nocure --nomerge hello1.c hello2.c -o hello.exe} +\hspace{1cm}- Compiles and links without curing and without merging (still +uses the CIL front-end) +\item \c{bin/ccured --nocure hello1.c hello2.c -o hello.exe} +\hspace{1cm}-Merges using CIL, then compiles and links with \c{gcc} +\item \c{bin/ccured hello1.c hello2.c -o hello.exe} \hspace{1cm}-Merges using +CIL, processes with Deputy, the compiles and links with \c{gcc} +\item \c{bin/ccured -c hello1.c hello2.c} \hspace{1cm}-Just put preprocessed source in the object files +\item \c{bin/ccured hello1.o hello2.o -o hello.exe} \hspace{1cm}-Take the +preprocessed source in the object file, merge, cure, gcc. +\item \c{bin/ccured --mode=AR cr hello.a hello1.o hello2.o} \hspace{1cm}-Merge +the preprocessed source in the object files into an archive (which itself +contains source) +\item \c{bin/ccured hello.a main.c -o hello.exe}\hspace{1cm}-Preprocess the C +source, merge with the sources in the archive, cure and gcc. +\end{itemize} + +\TODO{I made a pass over the arguments} + + Most of the command-line options that you pass to \c{ccured} will be passed +along to the underlying preprocessor, compiler or linker. However the +\c{ccured} script recognizes the following special options: +\begin{itemize} +\item General options +\begin{itemize} +\item \c{--save-temps}. It tells the Deputy script to save the temporary files + (including the output of Deputy). +\item \c{--mode=MSVC}. Use instead of the Microsoft Visual C compiler +(\c{cl}). Deputy and the CIL front-end know how to handle the MSVC extensions. +\item \c{--leavealone=foo}. Deputy will not merge and will not process the +file whose name starts with foo. Instead it will compile it as usual and will +link it in when needed. You can put in this file functions that you do not +want Deputy to see (e.g., if they are really ugly and you are ashamed of +what you did!). See \secref{trusted} for details. +\item \c{--stats}. Print some statistics about the inserted checks. +\item \c{--stages}. Print details about the various stages. +\item \c{--extrafiles=}. Give the name of a text file that contains +whitespace-separated named of additional files to process (in case your +command lines are too long). +\item \c{--keepunused}. Disable the removal of apparently unused elements from +the file, such as local variables or prototypes. +\item \c{--noPrintLn}. Turns off the printing of line-number information. This +way the errors will be referenced to the Cured file not the source file. +\item \c{--commPrintLn}. Print line-number information as comments. This +way the errors that Deputy prints at run-time and the debugging information in +the cured code refer to the cured file, not the original source, but +you can still figure out from what file this is coming. +\item \t{--printCilAsIs}. Do not attempt to simplify the program while + printing. If this is turned on, then all loops will be printed as + ``while(1)'', as they are in the internal language. +\end{itemize} + +\item Options controlling compile-time behaviour +\begin{itemize} +\item \c{--deputyverbose}. Print information about what Deputy is doing. +\item \c{--deputyinferout=foo}. Print in the file \c{foo} a version of the + source that contains the information that Deputy has inferred. +\item \c{--deputyopt=n}. Choose the optimization level: + \begin{itemize} + \item \c{0} - no optimization. Not recomended because it leads to so + many checks that gcc is overwhelmed + \item \c{1} - flow-insensitve optimizations. + \item \c{2} - flow-sensitive optimizations. + \end{itemize} +\end{itemize} + + +\item Options controlling run-time behaviour +\begin{itemize} +\item \c{--deputyAlwaysStopOnError}. Generate code that always stops on error + (slightly faster). +\item \c{--failIsTerse}. Do not print source-file location on failure. This + makes your program smaller and faster. +\end{itemize} +\end{itemize} + + For most performance you should use the options: +\begin{verbatim} +--deputyopt=2 --releaselib --deputyAlwaysStopOnError --failIsTerse +\end{verbatim} + + All of the other options that start with \c{--} (and are not recognized as +compiler options) are passed unmodified to the Deputy Ocaml application. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Controlling error handling at run time}\label{sec-errorhandle} + + After you process a program you can run it as usual. If you have used the +\c{--deputyAlwaysStopOnError} flag to Deputy then the only option you have +when a check fails is to stop the execution. This assumption allows the +compiler to generate faster checking code. If you do not use that flag then by +default the program will print failure messages on standard error and the +execution will continue as if Deputy has not been used. \TODO{This would be a +nice property to have. I am not sure we have it though (e.g., unions)} + + Alternatively, you have the option to set the environment variable + \c{DEPUTY\_ONERROR} to one of the following values. +\begin{itemize} +\item \c{warn} - warning messages are printed and the execution continues. + This is as if you did not set the \c{DEPUTY\_ONERROR} variable. +\item \c{stop} - execution stops on the first error, after printing the error + message. This is almost as if you had specified + \c{--deputyAlwaysSleepOnError} except that the program might be slightly + slower. +\item \c{ignore} - the failure messages are ignored (not even printed) and the + execution continues. +\item \c{sleep} - the program goes to sleep on an error. When it does so, it +prints the process id to standard error. You can then connect to it using +\t{gdb} as follows (replace \t{test} with the name of your executable and +\t{10343} with the actual process id printed when the process goes to sleep.): +\begin{itemize} +\item Start \t{gdb} (preferably from within Emacs) +\item Type +\begin{verbatim} +(gdb) file test +(gdb) attach 10343 +\end{verbatim} +\end{itemize} + + This is useful for debugging multi-threaded code or code that +is started by daemons. This has effect only if the program would actually stop +there. + + Note that this mode is most useful when you compiled the code with \t{-g} and +you did not use \t{--releaselib}. I also prefer to use \t{-commPrintLn} so +that the debugging information refers to the cured file, not the original. +\end{itemize} + +%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%% +\chapter{Using Deputy}\label{ch-examples} + + In this chapter we describe the typical steps that must be taken to use +Deputy on a new software package. For each step we give general instructions. +Then, we look at a few concrete software packages and we describe all the +steps that were necessary. We describe the warnings and the errors that we ran +into and how we solved them. Most of these warnings and errors are also +discussed in \chref{warn}. Take a look there if the explanation here is too +terse. + +\begin{enumerate} +\item {\bf Regular build} First try to download the sources and build them in +the regular manner (using \c{gcc}). It might be a good idea to setup a CVS +repository right after you download the sources, in order to better keep track +of the changes you are making. + +\item {\bf Build using CIL} Next you should try to build the package using CIL +(the front-end that Deputy uses). This step is optional but is a good idea +just in case your software package exposes a bug in CIL. To perform this step +you should edit the Makefile as follows (assuming it uses CC to invoke the +compiler \emph{and} the linker): +\begin{verbatim} +ifdef DEPUTY + CC:=/home/necula/ccured/bin/ccured +endif +ifdef ONLYCIL + CC+= --nodeputy +endif +\end{verbatim} +\TODO{We ought to support CIL-only build mode with the deputy script. This + should define away the attributes} + + If your project includes a more complicated setup, you must make the +necessary changes to use the above commands instead of \c{gcc}. + + Then you can run: +\begin{verbatim} +make clean +make DEPUTY=1 ONLYCIL=1 +\end{verbatim} + + This should build your project as before, except that each source file is +first preprocessed, then passed through the \c{deputy.asm.exe} executable to +produce the CIL output (a file with suffix \c{cil.c} that contains the source +of your program after being processed by the CIL front-end), then preprocessed +again and then finally passed to \c{gcc}. Here is an example of what you +should see for the file \c{util.c} from the \c{mathopd} package: + +\begin{verbatim} +/home/necula/deputy/bin/deputy --nodeputy -c -O -Wall -DHAVE_CRYPT_H util.c -o util.o +gcc -D_GNUCC -E -O -DHAVE_CRYPT_H util.c -o ./util.i +/home/necula/deputy/obj/x86_LINUX/deputy.asm.exe --cilout ./utilcil.c --nodeputy --warnall ./util.i +gcc -D_GNUCC -E -O -DHAVE_CRYPT_H -I/home/necula/deputy/include ./util.cil.c -o ./util.cil.i +gcc -D_GNUCC -c -O -DHAVE_CRYPT_H -Wall -o util.o ./util.cil.i +\end{verbatim} + + At this point you should ensure that the executable still works as expected. +If it does not then you have found a bug in the CIL front-end or in the +\c{deputy} Perl script that tries to impersonate \c{gcc}. CIL has been tested +extensively, so you can consider yourself truly unfortunate. Please let us know +about your problem. +\TODO{Should we explain how to use merging?} + +\item {\bf Build with Deputy} + Now we start using Deputy: +\begin{verbatim} +make clean +make DEPUTY=1 +\end{verbatim} + +Deputy will print information about the stages that it goes through. You +should watch for warnings and error messages, especially in the ``Inference'' +stage and in the ``Curing'' stage. If you are lucky the above steps are enough +to build the executable. However, many times Deputy will stop with some error. +The first thing you should do in that case is to scan the warnings that lead +to the error and proceed as explained in \chref{warn}. + +\item {\bf Run and debug the processed code} +\TODO{Would be nice to have an attribute to use where we used ``cured'' before} + Now that you have build your executable with Deputy you should run it on as +many examples as possible. Remember that Deputy is engineered to catch the +majority of the bugs at run-time (it is designed with the philosophy that the +C programmer is better than the Deputy static analyzer, so Deputy just +silently inserts run-time checks when it cannot ensure statically that what +the program is doing is guaranteed to be correct). + + When you get an error message from Deputy you should investigate it to see if +it is a false alarm or a true bug. + + You can tell Deputy to continue the execution after it encounters an error if +you set the environment variable \c{DEPUTY\_CONTINUE\_ON\_ERROR}. + +\end{enumerate} + + Next we look at concrete examples. If you want to try your hand at using +Deputy on real code you might want to try it on these packages and then use +the instructions when you get stuck. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Example: \t{mathopd} HTTP server}\label{sec-mathopd} +\TODO{this example} + + \subsection{Step 1: Regular Build} + +From the README file: ``This is Mathopd, a fast, lightweight, non-forking HTTP + server for UN*X systems.'' + + We describe here the steps required for processing the version 1.4-gamma of +mathopd (a development version). This package contains of 5000 lines of code. + + We download \c{mathopd-1.4-gamma.tar.gz}, unpack, change the Makefile as +required for Linux and then we try it out: +\begin{verbatim} +cd src +make +\end{verbatim} + + Next we edit the configuration file (\c{doc/sample.cfg}) so that we can run +the server on port 8000. Right after the line \c{Server \{} we add \c{Port + 8000}. Then we must become root and create a directory for the log: +\begin{verbatim} +su root +mkdir /var/mathopd +chmod 777 /var/mathopd +exit +./mathopd <../doc/sample.cfg +\end{verbatim} + + Now from another machine (make sure you have ~/public\_html/index.html on the + server machine): +\begin{verbatim} +explorer http://manju.cs.berkeley.edu:8000/~necula/ +\end{verbatim} + + and we see that it works. + + \subsection{Step 2: Build with CIL} + + Completely uneventful. + + \subsection{Step 3: Build with Deputy} + + For \c{mathopd} we saw the warning: +\begin{verbatim} +Warning: Generated automatic vararg descriptor for log_d: struct autoVarargDescr_log_d : char const */* __attribute__((___ptrnode__(922))) */, +uid_t +If this is a printf-like function you should declare it! +\end{verbatim} + + As explained in \chref{warn}, we take a look at the implementation of +\c{log\_d} (we find it in the merged file \c{mathopd\_comb.c}) to make sure +Deputy did not miss anything. Sure enough, \c{log\_d} is a printf warning. +Same thing for \c{die}. We fix this by adding the following pragma in +\c{main.c} (see \secref{manualvararg} for details): +\begin{verbatim} +#pragma ccuredvararg("log_d", printf(1)) +#pragma ccuredvararg("die", printf(2)) +\end{verbatim} + + + In the process of doing mathopd, we encountered the warning: +\begin{verbatim} +/home/necula/ccured/include/netdb_wrappers.h:329: Warning: Solver: changing User Specified SAFE node 1371 (the local variable p_ith_alias) to WILD +\end{verbatim} + + This turned out to be a bug in the wrapper for the socket functions. We found +it using the browser (see \secref{browser}). + + Then we saw a warning: +\begin{verbatim} +/usr/include/sys/socket.h:156: Warning: sendmsg appears to be external + (it has a wrapper), yet it has a mangled name: sendmsg_scsws_. + Did you forget to use __ptrof and a version of __mkptr? + For more information, consult the online documentation on + "Writing Wrappers". +\end{verbatim} + + This turned out to be due to the same socket wrapper error. + + Another warning you might see when you run Deputy is: +\begin{verbatim} +3 incompatible types flow into node void *1127 + Type struct iovec_LEAN *1178 at /home/necula/ccured/include/socket_wrappers.h:237 + Type char */* __NODE(1371) __ROSTRING */ *1372 at /home/necula/ccured/include/netdb_wrappers.h:332 + Type struct iovec_LEAN *1146 at /home/necula/ccured/include/socket_wrappers.h:219 +\end{verbatim} + + This means that a \c{void *} node is cast to several incompatible types. When +you investigate this (using the browser, for example, or just following the +line numbers) you discover that the \c{\_\_trusted\_add\_iov} issue is the +cause of this also. + + Once we fix the above problem we notice that there are no more \WILD{} +pointers: +\begin{verbatim} +ptrkinds: Graph contains 12886 nodes +ptrkinds: SAFE - 9256 ( 72\%) +ptrkinds: SEQ - 429 ( 3\%) +ptrkinds: FSEQ - 3201 ( 25\%) +\end{verbatim} + + \subsection{Step 4: Write the wrappers} + +We see now that there are some missing functions: +\begin{verbatim} +mathopd_comb.o: In function `log_request': +mathopd_comb.o(.text+0x1b02d): undefined reference to `asctime_qs' +\end{verbatim} + + See \chref{wrapper} for information on how to write this wrapper: Essentially +this is what we had to add to \c{time\_wrappers.h} file: +\begin{verbatim} +#pragma ccuredwrapper("asctime_wrapper", of("asctime")) +__inline static +char *asctime_wrapper(const struct tm *timep) { + struct tm *thinTimep = __ptrof(timep); + char *thinRet = asctime(thinTimep); + return __mkptr_string(thinRet); +} +\end{verbatim} + + \subsection{Step 5: Run and Debug the cured code} + + We ran the \c{mathopd} server and we get an error right away: +\begin{verbatim} +Failure at config.c:924: new_pool(): Ubound +Aborted +\end{verbatim} + + We look at the code and we see this code in \c{config.c}: +\begin{code} +p->ceiling = t + s; +\end{verbatim}\end{code} + + This looks like the pointer that is stored in the \c{ceiling} field is +outside bounds, that that is Ok. This field is never used as a pointer. So, we +change its type to \c{long} instead. We could change it to \FSEQ{} as well. +See \chref{warn} for more possible solutions. + + Now mathopd seems to work!! But of course you should be using it for real in +order to find the bugs. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55 + \section{Example: UCSPI TCP Suite}\label{sec-ucspi} +\TODO{this example} + + \subsection{Step 1: Regular Build} + + This is a package that provides ``tcpserver'' and ``tcpclient''. From their +web page (\ahreftop{http://cr.yp.to/ucspi-tcp.html}): ``they are easy-to-use +command-line tools for building TCP client-server applications.'' The package +also includes a number of clients built using these tools. There are 6700 +lines of code in this package. We actually found one bug in this library. + + + We downloaded the version 0.88 (as of January 9, 2003). Following the +instructions: +\begin{verbatim} +gunzip ucspi-tcp-0.88.tar +tar -xf ucspi-tcp-0.88.tar +cd ucspi-tcp-0.88 +make +\end{verbatim} + + Before we install it, we edit the file conf\_home to point to the current +directory (we do not want to mess up the /usr/local). Then we continue: +\begin{verbatim} +make setup check +\end{verbatim} + + And now the big moment: +\begin{verbatim} +./http@ www.yahoo.com +\end{verbatim} + + Bingo! + + \subsection{Step 2: Build with CIL} + + This software package has a strange build interface. The Makefile contains +things like: +\begin{verbatim} +addcr.o: \ +compile addcr.c buffer.h exit.h + ./compile addcr.c + +compile: \ +warn-auto.sh conf-cc + ( cat warn-auto.sh; \ + echo exec "`head -1 conf-cc`" '-c $${1+"$$@"}' \ + ) > compile + chmod 755 compile +\end{verbatim} + + What is happening is that the compile script is created from the first line +of \c{conf-cc} and then used as a compiler. That line contains \c{gcc -O2} +right now. We change that file to use instead the value of the CC environment variable: +\begin{verbatim} +$CC -O2 +\end{verbatim} +% $ + + (You might want to also change warn-auto.sh to add a -v argument to /bin/sh + so that you see what is going on.) + + Then we add the stuff to Makefile to define CC (and export it to child +scripts). It turns out that this file also was missing a clean target, so we +add that as well: +\begin{verbatim} +export CC:=gcc +ifdef DEPUTY + CC:=/home/necula/ccured/bin/ccured +endif +ifdef NOCURE + CC+= --nocure +endif +ifdef NOMERGE + CC+= --nomerge +endif + +clean: + rm -f *.i *.o *.a + rm -f *cil.c *infer.c *comb.c *cured.c + rm http@ tcpclient tcpserver +\end{verbatim} + + Just to test the new setup we make it again and test it again. + + Now we try to make it with CIL. +\begin{verbatim} +make clean +make DEPUTY=1 NOCURE=1 NOMERGE=1 +\end{verbatim} + + Now we get an error: +\begin{verbatim} +tcpserver.o: In function `main': +tcpserver.o(.text+0xa29): undefined reference to `env_get' +tcpserver.o(.text+0xa50): undefined reference to `env_get' +\end{verbatim} + + Clearly we have done something wrong. A quick investigation reveals that +tcpserver.c does need \c{env\_get}, which is defined in env.c, but seems to +be missing from \c{envcil.c}. This means that the CIL front-end has dropped +this function. This is an embarrassing CIL bug. Now, when you have things +disappear then the fault is most often in the algorithm that CIL uses to +remove ``unnecessary'' things (such as locals or prototypes that are not +used). To disable that stage, pass the \c{--keepunused} flag to Deputy. + + Anyway, we fix that bug and now everything works. We now have to try the +merging. For this we must also intervene in the way the Makefile links +libraries and executables. It uses the scripts \c{makelib} to make a library +and \c{load} to make an executable. + + For the \c{load} script all we need to change is the \c{conf-ld} to use +\c{\$CC} instead of \c{gcc}. We do this and we run with merging. We get this +error: +\begin{verbatim} +gcc -D_GNUCC -o tcpserver -s tcpserver_comb.o cdb.a dns.a time.a unix.a byte.a +cdb.a: could not read symbols: Archive has no index; run ranlib to add one +\end{verbatim} + + As explained in \chref{warn}, this is because we should not use \c{ar} to +archive files in the merging mode, but we should use \c{ccured --mode=AR}. We +achieve this by changing the Makefile, which creates the \c{makelib} script. +We change it such that the \c{makelib} script uses the environment variable +\c{AR} instead of \c{ar}. And we defined AR in the Makefile as follows: +\begin{verbatim} +export AR:=ar +ifdef DEPUTY + ifndef NOMERGE + AR:=/home/necula/ccured/bin/ccured --mode=AR + endif +endif + +\end{verbatim} + + We run again in merging mode and now we get: +\begin{verbatim} +ranlib: cdb.a: File format not recognized +\end{verbatim} + + You look at \c{cdb.a} and find that it is a merged source file. You should +not use \c{ranlib} on such files. We edit the Makefile again and rerun. + + Now we get this error message when trying to merge \c{rblsmtpd} from a number +of object files and libraries: +\begin{verbatim} +/usr/include/sys/socket.h:189: Error: Incompatible declaration for accept (4). Previous was at rblsmtpd.c:103 (0) (different type constructors: void vs. int ) +\end{verbatim} + + + What happens is that the file \c{rblsmtpd.c} defines its own global \c{accept} +(luckily, with a different type than the one in the library; otherwise Deputy +would not have noticed!). Yet, one of the +other files that are merged (\c{socket\_accept.c}) uses the standard +library's accept. This looks like a bug. When the linker puts everything +together the references to the ``accept'' from \c{socket\_accept} will be +resolved to the ``accept'' from \c{rblsmtpd} (which is clearly not an +acceptable replacement for the socket function). + + We change the name of the ``accept'' in \c{rblsmtpd} and we rerun and now +everything works. A result of your work so far is that for all of the utility +programs that make up this package you have their sources in one source file +(e.g. \c{tcpclient\_comb.c}. And, we have found a bug even before we started +to use the actual Deputy! + + \subsection{Step 3: Build with Deputy} + + The first thing we see when we enable Deputy on this package is: +\begin{verbatim} +chkshsgr.c:8: Warning: Calling function getgroups without proper prototype: will be WILD. + getgroups has type void * __attribute__((___ptrnode__(12))) /* /* missing proto */ */() +chkshsgr.c:8: Warning: Calling function _exit with 1 arguments when expecting 0: will be WILD. + _exit has type void () +\end{verbatim} + + Two warnings, both due to missing or incomplete prototypes. In the cast of +\c{getgroups} it is a missing prototype. We add to \c{chkshgr.c} the following: +\begin{verbatim} +#include // For getgroups +#include // For setgroups +\end{verbatim} + + We also exit the prototype of \c{\_exit} in \c{exit.h}: + +\begin{verbatim} +extern void _exit(int); // The "int" was missing +\end{verbatim} + + Now Deputy succeeds in making this executable and proceeds to make +\c{tcpserver}. Here we find this one: +\begin{verbatim} +tcpserver.c:352: Error: You did not turn on the handling of inline assembly. Better hide this assembly somewhere else! +\end{verbatim} + + This is interesting! We look at the inline assembly (a good place to look in +is \c{tcpserver\_comb.c}, you'll see them all in there). One is a use of +\c{ntohs}, which is harmless because it does not involve pointers. We'll +leave this alone. + + But the other 5 or 6 such things are uses of the macros \c{FD\_SET} and +friends from \c{}. We investigate and we find that these macros +are defined in \c{}, and luckily that file also provides +regular C implementation for them, along the following lines: +\begin{verbatim} +#if defined __GNUC__ && __GNUC__ >= 2 + +# define __FD_ZERO(fdsp) \ + do { \ + int __d0, __d1; \ + __asm__ __volatile__ ("cld; rep; stosl" \ + : "=c" (__d0), "=D" (__d1) \ + : "a" (0), "0" (sizeof (fd_set) \ + / sizeof (__fd_mask)), \ + "1" (&__FDS_BITS (fdsp)[0]) \ + : "memory"); \ + } while (0) +#else /* ! GNU CC */ +# define __FD_ZERO(set) \ + do { \ + unsigned int __i; \ + fd_set *__arr = (set); \ + for (__i = 0; __i < sizeof (fd_set) / sizeof (__fd_mask); ++__i) \ + __FDS_BITS (__arr)[__i] = 0; \ + } while (0) + +#endif /* GNU CC */ +\end{verbatim} + + I am going to patch that include file to make the conditional test always +false and thus ensure that the C version is used always. +\begin{enumerate} +\item First, we tell Deputy that \c{} is a file that must be +patched (you can see that it is not patched already because it is not present +in the directory \c{cil/include/gcc\_2.95.3}; by the time you read this it this +whole patching business should have been done already). We go into +\c{cil/Makefile.gcc} and add to the list of \c{PATCH\_SYSINCLUDES} the name +\c{bits/select.h} (but we do it only in the Linux section). +\item Then, we specify the patch. We add the following to the file \c{cil/ccured\_GNUCC.patch}: +\begin{verbatim} +<<< file=bits/select.h, system=linux +#if defined __GNUC__ && __GNUC__ >= 2 +=== +#if 0 && defined __GNUC__ && __GNUC__ >= 2 +>>> +\end{verbatim} + +This says that the specified patch should be applied to the file + \c{bits/select.h} when Deputy is run on a Linux system. (Not all + platforms have bits/select.h.) +Matching is done whitespace-insensitive. Now you rebuild Deputy (just run +\c{make}) and you should find the patched file in the +\c{cil/include/gcc\_2.95.3/bits}. Make sure it is as you need. More information +about the patcher is at \ahrefurl{../cil/patcher.html} +\end{enumerate} + + And since we have left one inline assembly in, we must tell Deputy to accept +it as is. We change the Makefile to pass the \c{--allowInlineAssembly} to +Deputy. + + Now we find more missing prototype problems: +\begin{verbatim} +tcpserver.c:210: Warning: Calling function close with 1 arguments when expecting 0: will be WILD. + close has type int () +\end{verbatim} + + In fact, \c{close} does not have a prototype at all. Deputy has supplied one +without arguments while making \c{unix.a}! We add the ``\#include '' +to \c{tcpserver.c} and go on. + + We add a few more prototypes and then we get: +\begin{verbatim} +buffer_get.c:10: Warning: Calling function (*op) with 3 arguments when expecting 0: will be WILD. + (*op) has type int () +\end{verbatim} + + We find in \c{buffer.h} and \c{buffer\_get} a function pointer type declared +as ``int (*op)()''. Again the missing argument types. We fill those in. + + Now starts the real fun, chasing away the \WILD{} pointers (see +\chref{nowild} for general techniques). We see this message: +\begin{verbatim} +** 1: Bad cast at cdb_make.c:36 (char *510 ->struct cdb_hplist *1376) +** 2: Bad cast at pathexec_env.c:42 (char *510 ->char */* __NODE(2537) */ *2538) +** 3: Bad cast at pathexec_env.c:67 (char */* __NODE(2537) */ *2538 ->char *2553) +** 4: Bad cast at sig.c:12 (void (int ) *2695 ->void () *2694) +** 5: Bad cast at sig_catch.c:9 (void () *673 ->void (int ) *2711) +ptrkinds: Graph contains 4383 nodes +ptrkinds: SAFE - 3142 ( 72%) +ptrkinds: SEQ - 15 ( 0%) +ptrkinds: FSEQ - 127 ( 3%) +ptrkinds: WILD - 1099 ( 25%) +535 pointers are void* +5 bad casts of which 0 involved void* and 2 involved function pointers +1 (20%) of the bad casts are downcasts +0 incompatible equivalence classes +\end{verbatim} + + The casts 4 and 5 are due to missing argument types function types. We edit +sig.h to add the ``int'' as the argument type for signal handler. + + We investigate cast number 2 and we find something like this: +\begin{verbatim} + e = (char **) alloc((elen + 1) * sizeof(char *)); +\end{verbatim} + + This is a custom allocator. We must declare it (in alloc.h): +\begin{verbatim} +extern void *alloc(unsigned int); +#pragma ccuredalloc("alloc", nozero, sizein(1)) // We added this line +\end{verbatim} + + We run Deputy again and no more bad casts (it looks like all the others were +due to \c{alloc}), but still a bunch of \WILD{}: +pointers: +\begin{verbatim} +ptrkinds: Graph contains 4575 nodes +ptrkinds: SAFE - 3324 ( 73%) +ptrkinds: SEQ - 41 ( 1%) +ptrkinds: FSEQ - 150 ( 3%) +ptrkinds: WILD - 1060 ( 23%) +579 pointers are void* +0 bad casts of which 0 involved void* and 0 involved function pointers +No bad casts, so no downcasts +2 incompatible types flow into node void *518 + Type char */* __NODE(2549) */ *2550 at pathexec_env.c:67 + Type char *102 at dns_transmit.c:63 +2 incompatible equivalence classes +\end{verbatim} + + Notice that we have more pointers in the program. This is due to the +allocator, which is now polymorphic and is duplicated several times. But we +also have incompatible equivalence classes. This is because there is a \c{void +*} pointer that is used with several incompatible types (in this case \c{char +*} and \c{char **}). See \secref{poly} for more details on this. This turns +out to be because the function \c{alloc\_free} with a declared argument of +type \c{void *} is used in two places with different argument types. We simply +declare that function to be polymorphic (in \c{alloc.h}): +\begin{verbatim} +#pragma ccuredpoly("alloc_free") +\end{verbatim} + + Finally, Deputy succeeds, with no \WILD{} pointers, but there still is a +warning that we have not looked at: +\begin{verbatim} +pathexec_env.c:42: Warning: Encountered sizeof(char */* __attribute__((___ptrnode__(2595))) */) when type contains pointers. Use sizeof expression. Type has a disconnected node. +\end{verbatim} + + As explained in \secref{sizeof} we should take a look at the code. We find +this typical example, and we fix it accordingly: +\begin{verbatim} + e = (char **) alloc((elen + 1) * sizeof(* e)); // Was sizeof(char *) +\end{verbatim} + + + \subsection{Step 4: Run and debug the cured code} + + + We have built the suite of tools and now we run it. Right away we get a +run-time error, so we set \c{DEPUTY\_CONTINUE\_ON\_ERROR} +(\secref{errorhandle}) to see them all. +\begin{verbatim} +Failure STORE_SP at pathexec_env.c:47: pathexec_qq(): Storing stack address +... +Failure STORE_SP at /home/necula/ccured/include/functions/deepcopy_stringarray.h:70: __deepcopy_stringarray_to_compat___0_ssqq(): Storing stack address +\end{verbatim} + + There are two distinct errors. We'll fix them, but here is a way to silence +Deputy if you are lazy: we can use +\c{DEPUTY\_ERROR\_HANDLERS} to specify that we want to ignore all +\c{STORE\_SP} errors in those two functions. For this we write a text file +(ucspi.handlers): +\begin{verbatim} +ignore STORE_SP at *:*:pathexec_qq +ignore STORE_SP at *:*:__deepcopy_stringarray_to_compat___0_ssqq +\end{verbatim} + + Now we run as follows: +\begin{verbatim} +DEPUTY_ERROR_HANDLERS=ucspi.handlers ./http@ +\end{verbatim} + + and \t{http@} seems to work. + + + Let's go back to fixing these errors. These errors are all trying to store +strings that are obtained from the \c{environ} variable. It turns out that +those strings are on the stack (allocated before \c{main} is invoked). The +solution would be to copy those strings on the heap. But right after I saw +this error I realized that Deputy should not complain if the address that is +being stored is in the stack frame of \c{main} or at higher addresses. So, I +added this feature to Deputy and now you will not see these particular errors. +But if you run \t{http@ www.yahoo.com} you will get: +\begin{verbatim} +Failure STORE_SP at dns_transmit.c:213: dns_transmit_start_sqqff(): Storing stack address +\end{verbatim} + + It does not take much to find that this is due to the following code: +\begin{verbatim} +# 5 "dns_resolve.c" +int dns_resolve(char *q,char qtype[2]) +{ + struct taia stamp; + struct taia deadline; + char servers[64]; + + if (dns_transmit_start(&dns_resolve_tx,servers,1,q,qtype,"\0\0\0\0") == -1) return -1; +\end{verbatim} + + \t{dns\_transmit\_start} then stores the address of the array \c{servers} +into the heap. The solution here is to move the \c{servers} array into the +heap (or make it a global). We can achieve the former by declaring: +\begin{verbatim} + char servers[64] __HEAPIFY; +\end{verbatim} + + and Deputy will move it to the heap (see \secref{storeptr}). + + Bingo! It seems to work. Now, you can start measuring performance and, if +desired, you can try to make Deputy infer better checks for your code. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Example: PING} +\TODO{this example} + + In this section I describe what it took to do the \t{ping} utility from +\t{netkit-base-0.17}. + + We download, compile, test it. Then we setup the Makefiles to use ccured +instead of \t{gcc} and we test that it works in the \t{--nocure} mode. Then we +turn on curing. + + First we see two errors pointing out that there is inline assembly in +\t{ping}. Deputy also prints the instructions and we see that they are just +bit manipulations. So, we just pass \t{--allowInlineAssembly} to ccured and go +on. + + Now we get: +\begin{verbatim} +Failure UBOUND at ping.c:1303: main(): Ubound +\end{verbatim} + + To investigate this one we can use \t{DEPUTY\_SLEEP\_ON\_ERROR} (see +\chref{invoke}). The fragment of code that causes this error is similar to the +following code: +\begin{deputycode}[norun] +struct icmp { + int various; + char data[1]; +}; +char outpack[65536]; + +char foo() { + // Get the 8th data character + return ((struct icmp*)outpack)->data[8]; +} +\end{deputycode} + + The problem is that once \c{outpack} is cast to a \c{struct icmp *} it looses +the ability to access most element in the original array. The solution for +this particular error involves a slight rewrite of the access as: +\begin{deputycode}[norun] +char foo() { + // Get the offset of the 8th data character + int off = (int) & ((struct icmp*)0)->data[8]; + return outpack[off]; +} +\end{deputycode} + + We need to fix that problem in all accesses to the \t{data} field. After +that, we run into another problem: +\begin{verbatim} +Failure ALIGNSEQ at ./ping_combcured.c:3923: pinger(): Creating an unaligned sequence +\end{verbatim} + + This is because at some point we create a sequence pointer whose home area +does not contain a whole number of elements. See \secref{checkseq} for the +various ways to address this problem. We choose to simply tell Deputy to allow +partial elements in structures and to adapt its checks accordingly. To achieve +this we pass \t{--allowPartialElementsInSequence} to Deputy. + + Now it works, we are done. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Example: THTTPD Server} +\TODO{this example} + +In this section, we take a look into how to cure thttpd, described by its +author as ``a simple, small, portable, fast, and secure HTTP server.'' It +is currently the fifth most popular HTTP server on the net. You can get it +at \ahreftop{http://www.acme.com/software/thttpd/}. The version I work +with is 2.23 beta 1. + + \subsection{Step 1: Regular Build} + +First, we unpack the files: + +\begin{verbatim} +gunzip thttpd-2.23beta1.tar.gz +tar -xvf thttpd-2.23beta1.tar +\end{verbatim} + +Look into the directory for the file \c{configure}. We don't want to mess up +the /usr/local/ folder, so go into \c{configure} and delete the folder path +from \c{ac\_default\_prefix}. Now Makefile should make thttpd to the folder +where the source code resides. Run \c{configure}. + +\begin{verbatim} +./configure +\end{verbatim} + +The file should do some work and generate a few files. + +There is also another modification we should make to avoid conflicts with any +existing http servers (e.g. Apache). In \c{config.h}, go-to Line 321 and +change the default port from 80 to something like 7500. + +Now we can run make. The compiler does work and should produce a file named +\c{thttpd}. Run the program and test the server from another computer. In my +case, I steered my browser to \c{http://manju.cs.berkeley.edu:7500/~andypang/}. + +\begin{verbatim} +make +\end{verbatim} +a few seconds later... +\begin{verbatim} +./thttpd +\end{verbatim} + +If you see your homepage, thttpd is working. If not, make sure you have a +public\_html folder. If you are lazy, there is another way to check if thttpd +is working. Check whether the site for the server is up at the port you +specified (e.g. \c{http://manju.cs.berkeley.edu:7500/}). A page with a green +background should appear notifying you that thttpd is running. + +\subsection{Step 2: Build with CIL} + +It's time to look into that \c{Makefile.in} that came with thttpd. +\c{Makefile.in} is the file from which \c{configure} generates \c{Makefile}, +which in turn is used to build the application. + +Below the line that says ``You shouldn't need to edit anything below here,'' +we make the same changes to the \c{CC} variable as in the other tutorials. + +\begin{verbatim} +ifdef DEPUTY + CC:=/home/andypang/cil/bin/ccured +endif +ifdef NOCURE + CC+= --nocure +endif +ifdef NOMERGE + CC+= --nomerge +endif +\end{verbatim} + +Be sure to insert these ifdefs below the block of variable declarations (below +line 60). Otherwise, gcc would be used to compile the files. + +There will also be more files to clean after CIL/Deputy is run, so I added +the following to clean up the CIL files and folders that will be generated: + +\begin{verbatim} +CIL = $(SRC:.c=.i) *cil* + +COMB = *comb* +\end{verbatim} +% $ + +I modified the variable CLEANFILES to include those files. + +\begin{verbatim} +CLEANFILES = $(ALL) $(OBJ) $(GENSRC) $(GENHDR) $(CIL) $(COMB) +\end{verbatim} + +Now we are ready to compile using CIL. First, we run \c{configure} again to +update the Makefile. + +\begin{verbatim} +./configure +make clean +make DEPUTY=1 NOCURE=1 NOMERGE=1 +\end{verbatim} + +Ensure the application still works correctly. It should. Now build with +merging. + +\begin{verbatim} +make clean +make DEPUTY=1 NOCURE=1 +\end{verbatim} + +Again, check for proper functionality. + +\subsection{Step 3: Build with Deputy} + +The big moment. + +\begin{verbatim} +make clean +make DEPUTY=1 +\end{verbatim} + +You should see a number of errors and warnings. Many of these will involve +a warning of a ``malformed format string'' looking something like this: + +\begin{verbatim} +libhttpd.c:226: Warning: Malformed format string [child wait - %m] +\end{verbatim} + +If you take a look at the string, the warning stems from a call to syslog +with a \%m. This is safe, and can be safely ignored. *********** + + +Now we see a prototyping warning: + +\begin{verbatim} +thttpd.c:437: Warning: Calling function sigset without proper prototype: will be WILD. + sigset has type void * __attribute__((___ptrnode__(1666))) /* /* missing proto */ */() +\end{verbatim} + +At this point we realize that some files are read-only. We chmod the thttp folder from its +parent directory so that we can write to any file in the directory: + +\begin{verbatim} +chmod -R u+w thttpd-2.23beta1 +\end{verbatim} + +Back to the problem at hand. If one punches in \c{sigset} on Google, one +will that it is a function in \c{signal.h}. Add the following \c{thttpd.c} +to remedy the warning: + +\begin{verbatim} +extern void *sigset(int, void*); +\end{verbatim} + +Although the warning also appeared for the file \c{libhttpd.c}, the +prototype in \c{thttpd.c} will work for all files in the project. + + +The next most prevalent warning should be a sscanf error, where Deputy +warns that it does not expect the type \c{char *}. Deputy does not accept +strings in sscanf because one could potentially read in an unbounded +string. This characteristic could be used for malicious intentions. + +Although \c{\%400[a-zA-Z]} is used and hence strings that are accepted by +sscanf will be limited to 400 bytes, Deputy currently does not support this. +This may change in the future, because this method of scanning strings is +not suspectible to the same problems as simply using \c{\%s}. + +To fix this error, use Deputy's sscanf/fscanf functions in place of +the ones in \c{stdio.h}. Please refer to \secref{scanf-like} +for more details. As an example, the following is how I modified the code +at Line 213 in \c{tdate\_parse.c}. + +\begin{verbatim} + /* DD-mth-YY HH:MM:SS GMT */ + if ( + (resetSScanfCount(cp), + tm_mday = ccured_fscanf_int(ccured_sscanf_file, "$d-"), + ccured_fscanf_string(ccured_sscanf_file, "%400[a-zA-Z]-", str_mon), + tm_year = ccured_fscanf_int(ccured_sscanf_file, "$d "), + tm_hour = ccured_fscanf_int(ccured_sscanf_file, "$d:"), + tm_min = ccured_fscanf_int(ccured_sscanf_file, "$d:"), + tm_sec = ccured_fscanf_int(ccured_sscanf_file, "$d GMT"), + getScanfCount()) == 6 && + /* + sscanf( cp, "%d-%400[a-zA-Z]-%d %d:%d:%d GMT", + &tm_mday, str_mon, &tm_year, &tm_hour, &tm_min, + &tm_sec ) == 6 && + */ + scan_mon( str_mon, &tm_mon ) ) + { +\end{verbatim} +% $ + + +Then we see several warnings regarding the use of sizeof: + +\begin{verbatim} +libhttpd.c:2782: Warning: Encountered sizeof(char */* __attribute__((___ptrnode__(5491))) */) when type contains pointers. Use sizeof expression. Type has a disconnected node. +\end{verbatim} + +We take a look at this line and find that it is a function call to \c{RENEW}. + +\begin{verbatim} +nameptrs = RENEW( nameptrs, char*, maxnames ); +\end{verbatim} + +The definition of \c{RENEW} can be found in \c{libhttpd.h}. + +\begin{verbatim} +#define RENEW(o,t,n) ((t*) realloc( (void*) o, sizeof(t) * (n) )) +\end{verbatim} + +The warning arises from the fact that the Deputy inferencer cannot make +the connection between \c{nameptrs} and \c{char *}'s. See \secref{sizeof} +for more details. + +To fix the warning, we let Deputy inference the argument in \c{sizeof} +to \c{nameptr} by modifying the code in the following way: + +In libhttpd.c +\begin{verbatim} +nameptrs = RENEW( nameptrs, nameptr*, maxnames ); +\end{verbatim} + +In libhttpd.h +\begin{verbatim} +#define RENEW(o,t,n) (realloc( (void*) o, sizeof(t) * (n) )) +\end{verbatim} + +Now Deputy will know that we are allocating memory based on the size of +the pointers to \c{nameptr}. + +The macro \c{NEW} is defined one line before \c{RENEW}, and we fix a couple +of calls to \c{NEW} in the same way. + + +We now face a number of warnings of the following form: + +\begin{verbatim} +libhttpd.c:2519: Warning: Solver: changing User Specified SAFE node 5283 (an unnamed location (often an inserted cast)) to FSEQ +\end{verbatim} + +A quick look at \c{libhttpd.c} shows that a call to \c{qsort} is made. +The wrapper for qsort can be found in \c{stdlib\_wrappers.h}, and there +appears to be two versions of \c{qsort}. One versions supports polymorphism +and the other does not. Add \c{-DUSE\_POLYMORPHIC\_QSORT} in \c{Makefile.in} +after we make the call to \c{cil/bin/ccured}, so that Deputy will know to +use the polymorphic qsort. + + +This fixes the problems in \c{libhttpd.c} but not \c{tdate\_parse.c}. We go +to Line 113 and find a call to qsort. At first it looks like a problem with +sizeof, but fixing the calls to sizeof proves to be fruitless (although still +a good programming practice). + +Let's turn to the browser to track down the bad cast for us. Looking at the +problematic node will show us that it is in the arguments passed into the +comparator for qsort. The arguments of the comparator are declared as \c{char *}, +but they are also cast to \c{struct strlong *} in the function. This is a +bad cast. Change the types of the accepted arguments to \c{void *} and +the problem is solved. + + +Next we tackle a similar problem in \c{tdate\_parse.c}: +\begin{verbatim} +** 1: Bad cast (seq) at tdate_parse.c:202 (struct tm *7100 ->char *7136) +\end{verbatim} + +Once again, we use the browser to track down the problem, and find a cast +from a \c{struct tm *} to a \c{char *}. We change the \c{char *} to a +\c{void *} and the bad cast disappears. + +\begin{verbatim} + (void) memset( (void*) &tm, 0, sizeof(struct tm) ); +\end{verbatim} + + +The last bad cast: +\begin{verbatim} +** 1: Bad cast at timers.h:41 (void */* __NODE(346) */ *347 ->long *349) +\end{verbatim} + +Going to Line 41 reveals a union of \c{void *}, \c{int}, and \c{long}. This +cannot possibly be safe because \c{i} could later be used as a pointer +with \c{p}. We change this union to a tagged union as instructed in +\secref{taggedunion}. + +\begin{verbatim} +union ClientData { + void* p; + int i; + long l; +} __TAGGED; +typedef union ClientData ClientData; +\end{verbatim} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\section{Porting Code from CCured to Deputy}\label{sec-ccuredport} +One way to determine which pointers will need annotation for Deputy is +to run CCured's whole-program analysis. The CCured flag +\c{-{}-listnonsafe} will list the pointers in your program that need +bounds information. + +Using this tool requires that CCured is able to compile your program. +This itself involves some porting effort, but hopefully many of the +changes needed for CCured are also needed for Deputy. + +This is a simple, unpolished tool. Send suggested improvements to +\ahref{mailto:matth@cs}{Matt}. + +\subsection{Running CCured} +To use the \c{-{}-listnonsafe} option, make sure each file in your +program includes \c{deputy/include/ccuredport.h}. This file redefines +the Deputy macros so that any Deputy annotations you've added are +translated to CCured annotations. Any pointers that already have +Deputy annotations are marked so that you won't see additional +warnings that those nodes need annotations. + +Now run \c{ccured -{}-listnonsafe} on your program. You can do this +from within Emacs' compile-mode so that it's easy to find the +associated code. You'll see a list of items like this: + +\begin{verbatim} +test.c:36: node (int * __NODE(9) ) in field "y" is Seq/FSeq +test.c:36: node (int * __NODE(9) ) in field "y" is a void* that CCured has inferred to be a int * +test.c:28: node (int * __NODE(216) ) in the return value is Seq/FSeq +test.c:28: node (int * __NODE(217) ) in formal "x" is Seq/FSeq +test.c:28: node (int * __NODE(217) * __NODE(218) ) in formal "x" is Seq/FSeq +\end{verbatim} + +Currently, you'll be notified of all Seq/FSeq pointers (which need +bounds information) that are used in the types of fields, formals, and +return types. With local variables, Deputy's inference will often +obviate the need for annotations. So for these we don't prompt for +bounds information unless the type is a pointer to a pointer and the +inner pointer needs bounds. Finally, you'll also be notified of +\c{void*} pointers that CCured inferred to have a more specific type. +If a pointer already has a Deputy annotation on it, it is not listed +in the output. + +\subsection{Limitations} + +\begin{itemize} +\item One requirement of Deputy is that any annotations on a global + appear on all declarations of that global (e.g. in .h files). + Because CIL's merger combines all declared types into one node, + there's no way for CCured to warn about half-missing annotations. +\item CCured's features don't match Deputy's, so annotations such as + \c{\_\_SIZE} in CCured have no exact equivalent in Deputy. +\item If a function or struct uses CCured-style polymorphism, you'll + get several messages that ``\t{foo is a void* that CCured has inferred + to be X}'', for various X. For now, you'll probably have to make + this node TRUSTED in Deputy. +\item Types in cast expressions are not reported. +\end{itemize} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5555 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Advanced Deputy Issues} +\TODO{this entire chapter} + + In this chapter we discuss a collection of issues having to do with using +Deputy on real programs. Some of the issues are related to sound handling of +dark corners of the C programming language (e.g. function pointers, +initialization of globals, variable argument functions). Other issues are +related to mechanisms to give hints to the Deputy inferencer. + + + We recommend that you take a look at the warnings and messages that +Deputy gives and try to address the bad casts. In this chapter, we describe +a few tricks that you can use to change the code, and a few features that +Deputy has to help you do that. + + First, a few notes: +\begin{itemize} +\item Do not use functions without prototypes. They will be \WILD{} along with +their arguments and result values. + +\item Fill in the full type of functions and pointers. In C it is technically +sufficient to leave the argument part of a function type empty, and this +allows to call the function with whatever arguments you feel like. Deputy will +accept that but will make the function \WILD{}! + +\item If your program has custom memory allocators (generally wrappers around +\c{malloc} and friend), you must declare them (\secref{malloc}). + +\item If you have functions that use pointers polymorphically, make sure those +pointer types are \c{void *} (not \c{char *} as it was common before ANSI C). +\end{itemize} + + When it notices bad casts, Deputy will print something like this: +\begin{verbatim} +** 1: Bad cast at cdb_make.c:36 (char *510 ->struct cdb_hplist *1376) +** 2: Bad cast at pathexec_env.c:42 (char *510 ->char */* __NODE(2537) */ *2538) +** 3: Bad cast at pathexec_env.c:67 (char */* __NODE(2537) */ *2538 ->char *2553) +** 4: Bad cast at sig.c:12 (void (int ) *2695 ->void () *2694) +** 5: Bad cast at sig_catch.c:9 (void () *673 ->void (int ) *2711) +ptrkinds: Graph contains 4383 nodes +ptrkinds: SAFE - 3142 ( 72%) +ptrkinds: SEQ - 15 ( 0%) +ptrkinds: FSEQ - 127 ( 3%) +ptrkinds: WILD - 1099 ( 25%) +535 pointers are void* +5 bad casts of which 0 involved void* and 2 involved function pointers +1 (20%) of the bad casts are downcasts +0 incompatible equivalence classes +\end{verbatim} + + This means that there are 5 bad casts (which contaminate 25\% of your +pointers). There are no incompatible equivalence classes in this case. + + You can either go directly at the line numbers in which the bad casts are +reported, or you can use the browser (\secref{browser}). + + Bad cast number 4 and 5 in the example above are clear indications that there +are some incomplete function types in your program. Go and add the argument +types. + + The other bad casts are due to an undeclared memory allocator. After we fix + those we rerun and we get: +\begin{verbatim} +ptrkinds: Graph contains 4575 nodes +ptrkinds: SAFE - 3324 ( 73%) +ptrkinds: SEQ - 41 ( 1%) +ptrkinds: FSEQ - 150 ( 3%) +ptrkinds: WILD - 1060 ( 23%) +579 pointers are void* +0 bad casts of which 0 involved void* and 0 involved function pointers +No bad casts, so no downcasts +2 incompatible types flow into node void *518 + Type char */* __NODE(2549) */ *2550 at pathexec_env.c:67 + Type char *102 at dns_transmit.c:63 +2 incompatible equivalence classes +\end{verbatim} + + Notice that we have more pointers in the program. This is due to the +allocator, which is now polymorphic and is duplicated several times. But we +also have incompatible equivalence classes. This is because there is a \c{void +*} pointer that is used with several incompatible types (in this case \c{char +*} and \c{char **}). See \secref{poly} for more details on this. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Polymorphism}\label{sec-poly} + +% Polymorphism is the ability a program fragment to operate on data of +%different types. This is a useful thing to be able to do and since C does not +%have special support for it, each programmer implements polymorphism by +%extensive use of casting. But not all casts are equal. Consider for example a +%function that just returns its argument: +%\begin{code} +%int identity_bad(int x) { return x; } +%\end{verbatim}\end{code} +% +% This function can be used with any type that fits in an integer, provided the +%appropriate casts from the type to \c{int} and back are inserted. But as we +%have already discussed in \secref{castint} this won't work in Deputy because +%the pointers you get out are not usable. +% +% A better way to do this is as follows: +%\begin{code} +%void* identity(void* x) { return x; } +%\end{verbatim}\end{code} +% +% It is a common paradigm in C to use \c{void*} for a ``pointer to I don't know +%what'' type. Deputy supports this view directly by considering each use of +%\c{void *} in the program as an occurrence of an unknown type. The Deputy +%inferencer will try to find a replacement type that makes sense in that +%context. For example, in the following code fragment Deputy will think of both +%occurrences of \c{void *} as actually being \c{int * *}. +%\begin{deputycode} +%void* identity(void* x) { return x; } +% +%int main() { +% int * * p = 0; +% int * * res = identity(p); +%} +%\end{deputycode} +% +% This model works for even very complicated code, such as the following +%fragment that +%defines a function \c{apply} which applies a function pointer to some +%arguments (see in the output that all pointers are inferred \SAFE{}): +%\begin{deputycode} +%// Applies a function to an argument +%void * apply(void* (*f)(void*), void *arg) { +% return f(arg); +%} +% +%// A simple dereference function +%int * deref(int * * addr) { +% return *addr; +%} +% +%int main() { +% int * x = 0; +% int * res = apply(deref, & x); +%} +%\end{deputycode} +% +% +% In the above example there are four occurrences of \c{void *} in the +%definition of \c{apply}. Based on the actual usage of \c{apply} the first two +%are mapped to \c{int *} and the latter two are mapped to \c{int * *}. +% +% This very flexible scheme breaks down when you have inconsistent usage of a +%\c{void *} type, such as in the following code: +%\begin{deputycode} +%void* identity(void* x) { return x; } +% +%int main() { +% int * p = 0; +% int * * res_pp = identity(& p); +% int * res_p = identity(p); +%} +%\end{deputycode} +% +% In the above code the \c{identity} function is used both with \c{int *} and +%\c{int **} argument. Since Deputy cannot find any single non-\WILD{} type that +%is compatible with all contexts in which the \c{void *} is used, it is going +%to infer that the type of the \c{void *} argument is \WILD{}. And since the +%argument is assigned to the result (implicitly due to the \c{return} +%statement) the result type is also \WILD{}. (You can use the browser to see +%all the different incompatible types that ``flow'' into a \c{void *}). It +%seems that we need a way to tell Deputy to treat the two invocations +%separately. +% +% Deputy has a crude but effective mechanism for doing just that. First, you +%have to tell Deputy that a function is polymorphic: +%\begin{code} +%#pragma ccuredpoly("identity") +%\end{verbatim}\end{code} +% +% (you can list multiple names in one \c{ccuredpoly} pragma. The pragma can +% appear anywhere in your program.). +% +%If you tell Deputy that a function is polymorphic it will take the following +%steps: +%\begin{enumerate} +%\item For each call site of the function, Deputy will create a copy of the +%function and it will assign it the name \c{/*15*/identity}, where the number +%15 is a running counter to ensure that the names are different. +%\item Then it will perform the usual inference in which case each copy of the +%\c{identity} function is used only once. +%\item Finally, for each combination of pointer kinds in the +%various flavors of \c{identity} Deputy will keep one copy and erase all the +%others. +%\end{enumerate} +% +% Consider as an example the code from above, in which all pointers are now +%\SAFE{}. The output contains calls to \c{/*1*/identity} and \c{/*2*/identity} +%but since they both have the same pointer kinds for the arguments and results, +%only the body of \c{/*1*/identity} is kept: +%\begin{deputycode} +%#pragma ccuredpoly("identity") +%void* identity(void* x) { return x; } +% +%int main() { +% int * p = 0; +% int * * res_pp = identity(& p); +% int * res_p = identity(p); +%} +%\end{deputycode} +% +% If the copies of the polymorphic function do not all have the same pointer +%kind then multiple definitions are kept, as in the code below where we have +%both a \SAFE{} and a \WILD{} copy of the \c{identity} function: +%\begin{deputycode} +%#pragma ccuredpoly("identity") +%void* identity(void* x) { return x; } +% +%int main() { +% int * __WILD p = 0; +% int * * res_pp = identity(& p); +% int * res_p = identity(p); +%} +%\end{deputycode} +% +%% For some reason this does not work anymore +%% Deputy creates a new instantiation of a polymorphic function also for each +%%place where the address of the function is taken: +%%\begin{deputycode} +%%#pragma ccuredpoly("identity") +%%void* identity(void* x) { return x; } +%% +%%int main() { +%% int * __WILD p = 0; +%% int * * (*p_identity)(int * *) = identity; // Take its address +%% int * * res_pp = p_identity(& p); +%% int * res_p = identity(p); +%%} +%%\end{deputycode} +%% +% +% +%\paragraph{Polymorphic types} +% +%A similar mechanism is also available for types. You can add in the arguments +%of the \c{ccuredpoly} pragma strings like \c{"struct list"} to say that a copy of +%\c{struct list} must be created for each occurrence in the program. The +%inference will then find out which of the copies have to be compatible and at +%the very end will keep only one copy for each kind. Note however that this +%form of polymorphism does not have any run-time cost because only types are +%duplicated. It will however slow down the Deputy type inference. +% +% Note: If the polymorphism directives do not seem to take any effect, pass the +% \t{-verbose} to ccured to see how it parses them. +% +% For example, here is how you would write polymorphic list length: +%\begin{deputycode} +%#pragma ccuredpoly("length", "struct list") +%struct list { +% void *car; +% struct list *cdr; +%}; +% +%int length(struct list *l) { +% for(int i = 0; l; i ++, l=l->cdr) ; +%} +% +%int main() { +% struct list list_of_int = { 5, 0 }; +% struct list list_of_wild_ptr = { (int * __WILD)5, 0 }; +% struct list wild_list = { 5 , (struct list * __WILD)0 }; +% +% int l1 = length(& list_of_int); +% int l2 = length(& list_of_wild_ptr); +% int l3 = length(& wild_list); +%} +%\end{deputycode} +% +% You can see in the browser information that the references to \t{struct list} +%have been replaced with separate names such as \t{struct /*45*/list}. +% +% In the case of recursive structures (whose name is refered directly or +%indirectly in the name of the fields), the fields use the same version of the +%structure as the structure itself. +% +% Deputy has polymorphism for types and for functions because those are the +%entities that can be copied legally in C. {\em There is no similar +%polymorphism for data variables, nor should there be.}. +% +% If you have a type name for a polymorphic structure, then Deputy will replace +% all occurrences of the type name with a reference to the structure itself, +% meaning that each use of the type name gets its own independent copy. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{User-defined memory allocators}\label{sec-malloc} + +% If your program has a user-defined memory allocator that is used to allocate +%data of different types then its return type will be \WILD{} and so will be +%all of the pointers you store with the allocated area. Declaring such a +%function to be polymorphic will likely not help because the function is +%probably using a global data structure (the allocation buffer) that is shared +%by all polymorphic copies of the function. +% +% Deputy allows you to declare a function to be a user-defined memory allocator +%using one of the following pragmas: +%\begin{code} +%#pragma ccuredalloc("myfunc", , ) +% ::= zero | nozero +% ::= sizein(k) | sizemul(k1, k2) +%\end{verbatim}\end{code} +% +% The \c{zero} argument means that the allocator zeroes the allocated area. +%Otherwise Deputy will zero it itself, if it contains pointers. The +%\c{sizein(k)} argument means that the allocator is being passed the size (in +%bytes) of the area to be allocated in argument number $k$ (counting starts at +%1). The \c{sizemul(k1, k2)} argument means that the allocator allocates a +%number of bytes equal to the product of the arguments number $k1$ and $k2$. +% +% For example the following are the pragmas for the standard library allocators +%\c{malloc} and \c{calloc}: +%\begin{code} +%void* malloc(unsigned int size); +%#pragma ccuredalloc("malloc", nozero, sizein(1)) +%void* calloc(unsigned int nr_elems, unsigned int size); +%#pragma ccuredalloc("calloc", zero, sizemul(1, 2)) +%\end{verbatim}\end{code} +% +% A memory allocator should have return type \c{void *}. In the pre-ANSI C days +%allocators were written with the type \c{char *}. Once you declare a function +%to be allocator, its return type will be changed to \c{unsigned long}. At all +%call sites Deputy will examine what kind of data is being allocated and will +%construct the metadata for it. +% +% Note that declaring a function an allocator has the effect of also making it +%polymorphic. This means that Deputy will create as many copies of your +%allocators as you have allocation sites. (After curing only copies with +%distinct calling convention will be kept, however.) +% +% Note that when you declare a custom-memory allocator as such, Deputy will +%trust that you are not going to re-use the memory area that you return. This +%means that you can use this feature to write unsafe programs in Deputy. The +%following program will succeed in trying to dereference the address 5! +%\begin{deputycode} +%#pragma curealloc("myalloc", sizein(1), zero) +%int data[8]; +%void* myalloc(int sz) { +% return data; +%} +%int main() { +% int ** p = (int **)myalloc(8); +% data[1] = 5; +% return *p[1]; // Will dereference 5 !!! +%} +%\end{deputycode} +% +% Most often the custom-memory allocators are just wrappers around the system +%\t{malloc}. In that case there is no danger of unsoundness. +% +% Note also that Deputy relies on the fact that the result of the custom-memory +%allocators is assigned to a variable of the right type. It is from the +%type of the destination of the allocator, or from the type cast with which the +%allocators is used, that Deputy knows what kind of metadata to create. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Pointers with Run-Time Type Information}\label{sec-rtti} + +% There are many C programs in which \c{void *} pointers are used +%non-parametrically. An example is a global variable (of type \c{void *}) that +%is used to store values of different types at different times. Consider for +%example the following code, where Deputy is forced to infer that the \c{g} +%pointer has kind \WILD{} because the \c{struct foo} and \c{struct bar} are +%incompatible: +%\begin{deputycode} +%struct foo { +% int f1; +%} gfoo; +% +%struct bar { +% int * f1; +% int f2; +%} gbar; +% +%void * g; +% +%int main() { +% int acc = 0; +% g = (void *)&gfoo; +% acc += ((struct foo *)g)->f1; +% g = (void *)&gbar; +% acc += ((struct bar *)g)->f2; +% return acc; +%} +%\end{deputycode} +% +% In this example \c{g} is used polymorphically but not in a way that could be +%handled through our support of polymorphism. (This form of polymorphism is +%called non-parametric polymorphism.) Deputy will consider the casts on \c{g} +%as bad and will mark those pointers \WILD{}. +% +% Deputy contains special support for handling such cases, by tagging the +%polymorphic values with information about their actual type. To enable this +%behavior you must use the \RTTI{} pointer kind qualifier on the polymorphic +%pointer. Consider again the example from before but with a \c{RTTI} +%annotation: +%\begin{deputycode} +%struct foo { +% int f1; +%} gfoo; +% +%struct bar { +% int * f1; +% int f2; +%} gbar; +% +%void * __RTTI g; +% +%int main() { +% int acc = 0; +% g = (void *)&gfoo; +% acc += ((struct foo *)g)->f1; +% g = (void *)&gbar; +% acc += ((struct bar *)g)->f2; +% return acc; +%} +%\end{deputycode} +% +% If you use the browser, you will see that there are no more bad casts and no +%\WILD{} pointers in this example. If you also look at the Deputy output for +%the above example you will see that instead the \c{g} variable is now +%represented using two words, one to store its value and another to store the +%actual type of the pointer it contains. This type is created when \c{g} is +%assigned to and is checked when \c{g} is used. +% +% Deputy can work with run-time type information only for certain pointer +%types. We call such types as {\em extensible} and for each type we also +%construct a name. Specifically, the extensible types are: +%\begin{itemize} +%\item \c{void}, named \c{"void"} +%\item A structure or union type, in which case the name is the letter \c{"S"} +%followed by the name of the structure or union type. Equivalently it can be a +%\c{typedef} name for a structure or union type. +%\item A \c{typedef} (that {\em does not} refer to a structure or union type), +%in which case the name is the letter \c{"T"} followed by the type name. +%However, since Deputy eagerly unrolls typedefs, you {\ bf should give the +%\c{\_\_NOUNROLL} attribute}: +%\begin{verbatim} +%typedef int * MY_TYPE_NAME __NOUNROLL; +%\end{verbatim} +%\end{itemize} +% +% \RTTI{} pointers can be created on by casting from a scalar or a \SAFE{} pointer to an +%extensible type and can be cast only to scalars and a \SAFE{} pointer to an extensible +%type. In the example above, \c{struct boo} and \c{struct bar} are extensible +%pointers and we can cast pointers to these structs to \c{void * RTTI} and +%back. +% +% Deputy also supports the \RTTI{} pointer kind on pointers whose base type is +%different from \c{void}. Consider the following example: +%\begin{deputycode} +%struct foo { +% int *f1; +% int f2; +%} gfoo; +% +%struct bar { +% int *f3; +% int f4; +% int f5; +%} gbar; +% +%#pragma ccured_extends("Sbar", "Sfoo") +% +%struct foo * __RTTI g; +% +%int main() { +% int acc = 0; +% g = (struct foo *)&gfoo; +% acc += g->f2; +% g = (struct foo *)&gbar; +% acc += g->f2; +% acc += ((struct bar *)g)->f5; +% gfoo.f1 ++; // To make foo.f1 and bar.f3 both FSEQ pointers +% return acc; +%} +%\end{deputycode} +% +% Notice that the \RTTI{} pointer kind is used with the base kind \c{struct +%foo}. An \RTTI{} pointer is strictly more powerful than a \SAFE{} pointer of +%the same base type. This means that \c{g} in the code above can be used to +%access the field \c{f1} and \c{f2} without any overhead. This is because +%Deputy enforces the requirement that an \RTTI{} pointer of base type +%\c{T} contains only pointer values whose base type {\em extends} \c{T}. The +%extension relationship is a subset of the physical subtyping relationship: we +%say that type \c{T} {\em extends} type \c{Q} if: +%\begin{itemize} +%\item Both \c{T} and \c{Q} are extensible, and +%\item Either \c{T} and \c{Q} are the same type, or +%\item \c{Q} is \c{void}, or +%\item There exists a pragma \c{ccured\_extends(T, T')} and \c{T'} {\em extends} +%\c{Q}. In this case Deputy verifies that it is safe to cast a pointer to \c{T} +%to a pointer to \c{T'}, using the usual physical subtyping relationships. +%\end{itemize} +% +% The \c{ccured\_extends} pragmas use extensible type names to declare a +%extension hierarchy (similar to a single-inheritance class hierarchy) in which +%\c{void} is the top. Note that only extensible types can appear in the +%hierarchy and an extensible type can appear at most once on the left-side of a +%\c{ccured\_extends} pragma. An \RTTI{} pointer can contain values that are +%pointers to some extensible base type that extends that of the \RTTI{} pointer +%itself. +% +% The \RTTI{} pointer kind can be applied only to base types that are either +%\c{void} or non-leaf in the extension hierarchy. +% +% For example, in the following code +%\begin{verbatim} +%struct foo { int x; } +%struct bar { int y; int z; } +%typedef int MY_INT __NOUNROLL; +%#pragma ccured_extends("Sbar", "Sfoo") +%#pragma ccured_extends("Sfoo", "TMY_INT") +%\end{verbatim} +% +% we can use the \RTTI{} pointer kind for \c{struct foo *} and \c{MY\_INT *} +%but not for \c{struct bar}. Notice that in all declared extension +%relationships physical subtyping is respected. +% +% The inferencer will spread the \RTTI{} pointer kind backwards through +%assignments but only on pointers that can be \RTTI{}. If you want to cut short +%the propagation of the \RTTI{} pointer king you can use the \SAFE{} pointer +%kind. +% +% To summarize, \RTTI{} pointers can be used with the following constraints: +%\begin{itemize} +%\item The \RTTI{} pointer kind is never inferred by the Deputy inferencer. You +%must specify it on some pointers and then the inferencer will propagate it. +% +%\item The \RTTI{} pointer kind is not able to carry bounds information. Thus +%you cannot use it on pointers that are involved in pointer arithmetic. +% +%\item Only pointers to extensible types can be cast to and from \c{RTTI} +%pointer types. Additionally, you may cast scalars into \c{RTTI} pointers. +% +%\item You must use \c{ccured\_extends} pragmas to declare the extension +%hierarchy. +% +%\item \c{void*} polymorphism is turned off for the \_\_RTTI types. +%\end{itemize} +% +% Interestingly enough the \RTTI{} pointer kind can be used to implement in a +%type-safe way virtual method dispatch, as shown in the example below: +%\begin{deputycode} +%typedef struct parent { +% void * __RTTI * vtbl; // virtual table, with various types of functions +% int *f1; // some field +%} Parent; +% +%#pragma ccured_extends("Schild", "Sparent") +% +%typedef struct child { +% void * __RTTI * vtbl; +% int *f2; +% int f3; +%} Child; +% +%// virtual method foo for class P +%// notice that the self parameter is an RTTI. It must +%// be of base type void to ensure that foo_P and foo_C have the +%// same type +%int* foo_P(void * __RTTI self_rtti, Parent *x) { +% Parent * self = (Parent *)self_rtti; // downcast +% return self->f1; +%} +% +%// virtual method bar for class P +%int * bar_P(void * __RTTI self_rtti) { +% Parent * self = (Parent *)self_rtti; +% return self->f1; +%} +% +%int* foo_C(void * __RTTI self_rtti, Parent *x) { +% Child * self = (Child *)self_rtti; +% return self->f2 + self->f3; +%} +% +%// Name the types of the virtual methods, to make them extensible +%typedef int * FOO_METHOD(void *, Parent *) __NOUNROLL; +%typedef int * BAR_METHOD(void *) __NOUNROLL; +% +%// Now the virtual tables +%void * vtbl_P[] = { (void*) (FOO_METHOD *)foo_P, +% (void*) (BAR_METHOD *)bar_P }; +% +% +%// child inherits bar_P +%void * vtbl_C[] = { (void*) (FOO_METHOD *)foo_C, +% (void*) (BAR_METHOD *)bar_P }; +% +% +%int array[8]; +% +%// Now the constructors +%void ctor_P(Parent * p) { p->vtbl = vtbl_P; p->f1 = array; } +% +%void ctor_C(Child * c) { c->vtbl = vtbl_C; c->f2 = array; c->f3 = 5; } +% +%int main() { +% Parent p; +% Child c; +% Parent * pp = &p, * pc = &c; +% Child * pc1; +% +% // Construct +% ctor_P(&p); ctor_C(&c); +% +% // Now try a downcast +% pc1 = (Child * __RTTI)pc; +% // Now invoke some virtual methods +% { +% FOO_METHOD *pfoo = (FOO_METHOD *) pp->vtbl[0]; +% pfoo((void *)pp, pc); +% pfoo = (FOO_METHOD *) pc->vtbl[0]; +% pfoo1((void *)pc, pp); +% } +%} +%\end{deputycode} +% +% Notice the use of the \c{\_\_NOUNROLL} typedefs for the function types. +% +% \subsection{Implementation Details} +% +% Deputy collects all extensible types in your program (either those declared +%using the \c{ccured\_extends} pragma or those that are used in casts to and +%from \RTTI{} pointers) and constructs the extension hierarchy. An encoding of +%this hierarchy is dumped in the resulting code in the array \c{RTTI\_ARRAY}. +%Each entry in the array corresponds to an extensible type and it contains the +%difference between the entry corresponding to the parent of the extensible +%entry and the index of th current entry. The root of the extension hierarchy +%is always at index 0 and that entry contains 0. The function +%\c{CHECK\_RTTICAST} is used to walk this encoding to verify a cast from a +%\RTTI{} pointer into a \SAFE{} pointer or another \RTTI{} pointer. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Specifying Trusted Code}\label{sec-trusted} +\TODO{this section} + + In this section we describe a few mechanisms that you can use to override +Deputy's reasoning. These are powerful mechanisms but you can use them to +write unsafe code. + + \subsection{Trusted casts} + + Occasionally there are casts in your program that are judged as bad, yet you +know that they are sound and it is too inconvenient to change the program to +expose the soundness to Deputy. In that case, you can use the +\c{TC} built-in function. In the following example we know that +the \c{boxedint} type can encode an integer (if odd) or a pointer to a +\c{boxedint} if even. We could use \RTTI{} pointers to encode this safely in +Deputy. Or, we can use a trusted cast: +\begin{deputycode}[fails] +typedef void * boxedint; // If even, then a pointer to a boxedint +int unroll(boxedint x) { + if((unsigned long)x & 1) return x; + return unroll(* (boxedint * SAFE)TC(x)); +} +\end{deputycode} +\TODO{Why does this code fail? Fix it, and remove the fails annotation} + + Deputy will not complain if the argument and result type of +\c{TC} are incompatible. However, it will ensure the following: +\begin{itemize} +\item A \c{TC} acts as a cast from the point of view of + propagating the \SEQ{} and \FSEQ{} requirement. This means that both the + argument and the result type will have the same kind. +%\item The argument and the result type are compared and in those pointer types +% in them that correspond, are forced to have the same kind. +\end{itemize} + + For example, in the following example, the variable \c{q} and the field +\c{f1} in \c{struct foo} are made \FSEQ{}. The \FSEQ{} constraint propagates +back through \c{TC} to \c{p}. +%\begin{deputycode} +%struct foo { +% int * f1; +% int f2; +%}; +%struct bar { +% int * f1; +% int * f2; +%}; +%int main(struct bar * p) { +% struct foo * q = TC(p); +% p->f1 ++; // Make foo.f1 FSEQ +% return q[1].f2; // Make q FSEQ +%} +%\end{deputycode} + + If you look carefully at the above examples you will see one of the potential +dangers of using \c{TC}: you are on your own to ensure that the +argument type and the result type match. In the above example, this is not +true because the field \c{f1} in \c{struct bar} is \SAFE{} while the field +\c{f1} in \c{struct foo} is \FSEQ{}! + + If you want to prevent a pointer arithmetic operation from generating +sequence pointers, you can use the \c{TC} function: +\begin{deputycode} +int foo(int *p) { + int * q = TC(p) + 4; + return *q; +} +\end{deputycode} + + You can use a \c{TC} to cast an integer into a pointer. This +works as expected if the type of the resulting pointer is \SAFE{} (as in the +example with \c{boxedint} earlier in this section). But if it is \FSEQ{} or +\SEQ{} then you will get exactly the same effect as if the +\c{TC} was not there: you will obtain a pointer with null +metadata and thus unusable for memory dereference. + + + \subsection{Turning off Deputy} + + You can turn the curing off for a fragment of a source file, for a function, +or for a block statement. + +% You can use the \t{cure} pragma to turn curing off for a fragment of a source +%file (in Deputy pragmas can only appear at global scope and therefore you +%cannot use this mechanism to turn curing off for part of the definition of a +%global function): +%%\begin{deputycode} +%%int * g; // This is a pointer to several integers +%% // but we do not want to make it SEQ +%%#pragma ccured(off) +%%int foo() { +%% return g[2]; // Deputy won't see this and will leave g SAFE +%% // But also Deputy won't check this code +%%} +%%#pragma ccured(on) +%%\end{deputycode} +% +% Alternatively, you can add the \t{nocure} attribute to a function to tell +%Deputy to not cure this function: +% +%\begin{deputycode} +%int * g; // This is a pointer to several integers +% // but we do not want to make it SEQ +% +%// We must put the attribute in a prototype +%int foo(void) __NOCURE; +%int foo(void) { +% return g[2]; // Deputy won't see this and will leave g SAFE +% // But also Deputy won't check this code +%} +%\end{deputycode} +% +% At a finer-grained level, you can use the \t{\_\_NOCUREBLOCK} attribute with +%a block statement: +%\begin{deputycode} +%int * g; // This is a pointer to several integers +% // but we do not want to make it SEQ +% +%int foo(void) { +% int res; +% { __NOCUREBLOCK +% res = g[2]; // Deputy won't see this and will leave g SAFE +% } +% return res; +%} +%\end{deputycode} +% +% In all of these cases, the Deputy inferencer does not even look at the +%non-cured portions of the code. However, Deputy will at least change the +%non-cured code to access the fat pointers properly. For example, in the +%following example the global \c{g} is a sequence pointer. While Deputy will +%not complain about the unsafe cast to \c{int **}, it will make sure that at +%least the proper component of \c{g} is used: +% +%\begin{deputycode} +%int * g; // This will be FSEQ +% +%int ** foo(void) { +% int res = g[2]; // Make g FSEQ +% { __NOCUREBLOCK +% return (int **)g; // But not WILD +% } +%} +%\end{deputycode} +% +% Finally, to avoid curing a whole source file (say \t{trusted\_foo.c}), you can +%use the \t{--leavealone=trusted} argument to Deputy. All source files whose +%names start with the given ``leave alone'' prefix, are not merged and are not +%scanned by Deputy at all. Instead they are compiled with \t{gcc} and linked in +%the final executable. + + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Function Pointers}\label{sec-funptr} +\TODO{this section} + + One of the signs that a C program is a ``serious'' one is the use of function +pointers. There would be nothing wrong or unsafe about that if it wasn't also +the case that most programmers do not feel necessary to use accurate types for +function pointers, or to even use function prototypes. This is probably due to +the fact that the syntax for function types in C is terrible. How often have +you declared your function pointers to have type \c{void (*)()} when you +actually wanted to say \c{int * (* (* x3))(int x)(float)} (a pointer to a +function that takes an \c{int} and returns a pointer to a function that takes +a \c{float} and returns a pointer to an \c{int}). + + Of course, misusing function pointers can lead to the worst kind of errors. +Fortunately such error rarely go unnoticed in code that is executed. + + Deputy supports two kinds of function pointers. The \SAFE{} function pointers +can only be invoked with the same number of arguments. If the types of the +arguments are not right it is the argument that becomes \WILD{} not the +function pointer. A \SAFE{} function pointer can only be cast to an integer or +to the same function pointer type. We also have \WILD{} function pointers +which you can (try to) use as you please. In fact a \WILD{} function pointer +can be cast to any other \WILD{} pointer type and can be stored in any tagged +area. For this reason its representation must match that of any \WILD{} +pointer. However the capabilities of a \WILD{} function pointer are typically +quite different from those of a regular function pointer. For example, you +should not be able to read or write from a function pointer. + + Any function whose address is taken and becomes \WILD{}, or that is used +without a prototype (see the discussion at the end of this section) is a {\em +tagged function} and has an associated descriptor that encodes the actual code +to the function and the number of arguments. Here is an example: + +%\begin{deputycode} +%int taggedfun(int anint, int * aptr) { +% return anint + * aptr; +%} +% +%int main() { +% int * i = taggedfun; // Bad cast. wildfun becomes tagged +% // Now we invoke it +% ((void (*)(int,int*))i)(5, i); +%} +%\end{deputycode} + + The structure of a function descriptor is as shown below and a pointer to the +\c{\_pfun} field is used as the \c{\_b} field whenever the address of the +function is taken. + +\begin{code} +struct __functionDescriptor { + unsigned int _len ; // Always 0 + void (* _pfun)() ; // Pointer to a function + unsigned int _nrargs ; // The number of arguments +}; +\end{verbatim}\end{code} + + Since the \c{\_len} field is always initialized to zero, whenever this +\WILD{} pointer is used for a read or a write it would appear that it points +into a zero-length tagged memory area, so the bounds check will fail. We then +have to protect against the pointer being subject to arithmetic prior to +invocation. We do this by storing in the function descriptor the actual +pointer to the function and checking at the time of a call through a \WILD{} +function pointer that the \c{\_p} field of the pointer is equal to the +\c{\_pfun} field in the descriptor. + + Finally we have to ensure that the function is called with the right number +and kinds of arguments. There is no hope to be able to ensure this statically +because a \WILD{} function pointer can be used very liberally as any other +\WILD{} pointer. So, Deputy conservatively forces +all arguments and the return type to be \WILD{} pointers. This includes +arguments and return types that are actually scalars (see the example above +for how integers are wrapped into \WILD{} pointers). This will ensure that the +types are the same (or compatible) and all we have to check is the right +number of arguments is passed to the function. To perform these checks we use +the following run-time support function: +\begin{code} +/* Check that a function pointer points to a valid tagged function and check + that we are passing enough arguments. We allow the passing of more + arguments than the function actually expects */ +__CHECK_FUNCTIONPOINTER(void *_p, /* The _p field of the function pointer */ + void *_b, /* The _b field */ + int nrActualArgs); /* The number of actual arguments */ +\end{verbatim}\end{code} + + Also, {\em always use prototypes for the external functions you are using}. +Otherwise, it will appear to Deputy that you are casting the function pointer +to various incompatible types corresponding to each use and the function will +be declared tagged (and pointers to such function to be \WILD{}). You get some +help from Deputy here because its whole-program merger will construct +prototypes for the functions that are defined somewhere in your program. But +when you use even simple things like \c{printf} you must include the proper +header files. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Global Initialization}\label{sec-globinit} +\TODO{this section} + + C has a very rich language of initializers for globals and locals. The +language is so rich that neither \c{gcc} nor MSVC implement it fully. For a +discussion of how our front-end handles initialization, please see the \ahref{../cil/index.html}{the CIL documentation}. + + Once programs are presented to Deputy all the initialization for locals is +turned into assignments, but most initialization code for globals is +preserved. However, in some cases Deputy must insert some checks related to +the initializers. These checks are placed in a special function called a {\em +global initializer}. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5 + \section{Casting Integers to Pointers}\label{sec-castint} +\TODO{this section} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Variable argument functions}\label{sec-vararg} +\TODO{this section} + + Variable-argument functions in C are inherently unsafe since there is no +language-level mechanism to ensure that the actual arguments agree in type and +number with the arguments that the function will be using. There are several +ways to implement variable argument functions in C and Deputy supports some of +them quite well: +\begin{itemize} +\item You can try to implement such function by taking the address of a formal +argument and working your way through the stack frame. If you do this we wish +you luck and perseverance and you'll need them both while trying to figure out +why your program does not behave for compilers such as \c{gcc}. Deputy +certainly cannot allow this because this is exactly the kind of operation that +viruses would want to perform. +\item A better alternative is to use the \c{\_\_builtin\_next\_arg} function on +\c{gcc} and then work your way up the stack. Deputy does not support this +low-level implementation of variable argument functions, but see next. +\item You can write your variable argument functions using the standard macros +in \c{} and \c{}. Deputy supports most such functions with +minimal programmer intervention. +\end{itemize} + + + There are two kinds of variable-argument functions in C: +\begin{itemize} +\item Those that take an arbitrary number of arguments following the last +specified formal (their function type contains \c{...} after the last formal). +We'll call these functions {\em vararg} functions. An example is \c{printf}: +\begin{code} +int printf(const char* format, ...) +\end{verbatim}\end{code} + +\item Those that take as arguments one or more pointers to lists of arguments. +We'll call these functions {\em valist} functions. An example is \c{vprintf}: +\begin{code} +int vprintf(const char* format, va_list args) +\end{verbatim}\end{code} +\end{itemize} + + Deputy supports both kinds of functions and will scan the program to find out +for each function what types of arguments are passed. In \secref{manualvararg} +we describe how the programmer can prevent this automatic inference by +specifying the set of types of arguments. + + Deputy redefines the macros in \c{} and \c{} to do +special bookkeeping. In vararg functions, the macro \c{va\_start} is used to +initialize an \c{va\_list} variable to point to the trailing arguments. Deputy +checks that the second argument is the last formal before the \c{...}. + + Both in vararg and valist functions the macro \c{va\_arg} can be used, as +follows: +\begin{code} + T x = va_arg(args, T) +\end{verbatim}\end{code} + + \c{args} must be a \c{va\_list} variable and \c{T} must be compatible after +the usual actual argument promotions (e.g. \c{char} and \c{short} to \c{int} +and \c{float} to \c{double}) with one of the types in the \c{struct} associated +with \c{args}. Deputy checks this at run-time. + + The Deputy support for variable argument functions is quite flexible. +Multiple variable argument lists can be processed in parallel, an argument +list can be re-initialized with \c{va\_start} and processed multiple times. A +function can even work with variable argument lists that have different sets +of types accepted (but for this you need to specify manually the set of types +of arguments as explained in \secref{manualvararg}). Variable argument lists +can be passed down but the regular Deputy checks for stack allocated variables +will prevent the passing of these lists up the call chain and also their +storing in the heap. + + The main thing that is not supported in Deputy is the fetching of an argument +with a different type than it was stored. It remains to be seen if this is a +problem. We have looked at several variable argument functions (including full +implementations of \c{printf} and \c{sprintf}) and so far we have found that +Deputy accepts those functions without any change except for the specification +of the \c{struct} of the accepted argument types (as explained below). + + + \subsection{Programmer control over vararg functions} + \label{sec-manualvararg} + + If you do not want Deputy to find automatically all the types that can be +passed to a function, you can specify the set of types that can be used for +arguments. Also, you should not let Deputy infer the argument types for +\c{printf}-like functions, but you should instead use the special support for +them, as explained in \secref{printf}. + + You can declare the argument types by declaring a descriptor. This is a +\c{struct} data type whose fields have the types that can be passed to the +function. The order and the names of the fields do not matter. For example, +such a struct for \c{printf} would be the following (this structure is defined +in \t{ccured.h}): +\begin{code} +struct printf_arguments { + int f_int; + double f_double; + char *f_string; +}; +\end{verbatim}\end{code} + + The simplest way to specify that such a \c{struct} describes the types of +arguments for a variable argument function is to use a pragma: +\begin{code} +#pragma ccuredvararg("myvarargfunction", sizeof(struct printf_arguments)) +\end{verbatim}\end{code} + +Notes: +\begin{itemize} +\item Since most variable argument functions are \t{printf}-like, Deputy + provides special support for them. See \secref{printf} if your function is + of this kind. + +\item Note that Deputy predefines the \c{struct printf\_arguments} so you do +not have to redefine it. + +\item Like all Deputy pragmas, you can put them anywhere in your project since +Deputy is going to merge all files into one. However, I typically prefer to +put such pragmas in header files near the prototype for the function. + +\item This method does not work for specifying pointers to variable argument + functions. You must use the attribute method described below. + +\item The \c{sizeof} operator is there because the syntax of pragmas is pretty +much that of function calls and thus we cannot use types directly. + +\item This pragma can be used with both kinds of +variable argument functions. In the case of valist functions it specifies that +{\em all} formals and locals of type \c{va\_list} can hold arguments of the +given types. +\end{itemize} + + An equivalent method is to associate the \c{\_\_DEPUTYVARARG(struct +printf\_arguments)} attribute with the type of the function +\c{myvarargfunction}: +\begin{code} +int (__DEPUTYVARARG(struct printf_arguments) myvarargfunction)(int last, ...); +\end{verbatim}\end{code} + + You have to use this method if you want to specify that a function pointer is +variable argument: +\begin{code} +int (__DEPUTYVARARG(struct printf_arguments) * myvarargptr)(int last, ...); +typedef int (_DEPUTYVARARG(struct printf_arguments) fptr)(char *format,...); +\end{verbatim}\end{code} + + A more fine-grained way to specify the same thing is to use the +\c{\_\_DEPUTYVARARG} {\em type attributes} for \c{va\_list} every time it appears. +This allows you to specify different sets of types for different locals: +\begin{code} +va_list __DEPUTYVARARG(struct printf_arguments) args1, + __DEPUTYVARARG(struct some_other_type) args2; +\end{verbatim}\end{code} + + + \subsection{Printf-like functions}\label{sec-printf} + + Since the vast majority of uses of variable argument functions if for +\c{printf}-like functions, Deputy contains special support for them. +Specifically if a vararg function is declared to be a \c{printf}-like function +then all of its invocations in which the format string is a constant will be +checked statically. For the other invocations a wrapper for printf will be +called that will check the types of the actuals against the format string +before calling the real \c{printf} function. + + To declare a function to be \c{printf}-like use the following pragma: +\begin{code} +#pragma ccuredvararg("myprintf", printf(1)) +\end{verbatim}\end{code} + + where the last argument is the index of the format argument in the argument +list (starting with 1). Note that you will get a run-time error if you try to +use the \c{va\_arg} macro in the implementation of such a function. In those +implementations you should invoke functions like \c{vprintf} and \c{vsprintf} +instead. + + GCC already has support for communicating to the compiler that a function is +\c{printf}-like. This is done as follows: +\begin{code} +int myprintf(const char* format, ...) __attribute__((format(printf, 1, 2))) +\end{verbatim}\end{code} + + where the ``1'' means that the first argument is the format string and the +``2'' means that we should start checking with the second argument. Deputy +recognizes this attribute and it considers it equivalent with the +\c{ccuredvararg} from above. Note that the second argument in the +\c{format} attribute is ignored in Deputy. + + You can use the \t{format} attribute even for function pointers: +\begin{code} +int (__attribute__((format(printf, 1, 2))) *myptr)(char *format, ...); +\end{verbatim}\end{code} + + Note that Deputy does not currently like passing pointers to \c{printf} with +the intention of printing the pointer value. You should manually cast those +pointers to \c{long} when passing them to \c{printf}-like functions. + + Also, you should not let Deputy infer automatically the descriptors for +\c{printf}-like functions. Otherwise, it is quite likely that the descriptor +that will be inferred is different than the built-in descriptor +\c{printf\_arguments} (which the runtime library is using to check the calls +to \c{printf}-like functions. Deputy will warn you about all automatically +inferred descriptors and you should manually inspect all the functions +involved. + + + As for the regular variable argument functions, the \t{pragma} works only for +named functions but not for pointers to functions. For that purpose you must +use attributes: + +\begin{code} +int (__DEPUTYFORMAT(1) * myprintf)(char *format, ...); +typedef int (_DEPUTYFORMAT(1) fptr)(char *format,...); +\end{verbatim}\end{code} + + + \subsection{Scanf-like functions}\label{sec-scanf-like} + + Since it proved too much trouble to handle \c{scanf}-like functions in a safe +yet transparent way we currently require the programmer to rewrite the +invocations to \c{scanf} using a number of functions that we provide. For +example instead of +\begin{code} + int entry; double then; char buffer[6]; + + ... fscanf(file, "Entry:%d; Then:%lf; 5 digits:%5[0-9]; useless text.", + &entry, &then, buffer) ... +\end{verbatim}\end{code} + + you should write +\begin{code} + ... (resetScanfCount(), + entry = ccured_fscanf_int(file, "Entry:%d"), + then = ccured_fscanf_double(file, "; Then:%lf"), + ccured_fscanf_string(file, "; 5 digits:%5[0-9]", buffer), + ccured_fscanf_nothing(file, "; useless text."), //advance the file pointer. + getScanfCount ()) ... +\end{verbatim}\end{code} + + The functions \c{resetScanfCount} and \c{getScanfCount} are necessary only +if you use the result of the call to \c{fscanf} in the original code. Note +that our replacement \c{scanf} functions can be used to return only one result +at a time, consequently the format string that is passed must contain only one +format specifier, possibly along with characters to be matched. + + The following are the \c{scanf}-like functions that we currently support: +\begin{code} + extern int ccured_fscanf_int(FILE *, char *format); + extern double ccured_fscanf_double(FILE *, char *format); + extern void ccured_fscanf_string(FILE *, char *format, char *string); + extern void ccured_fscanf_nothing(FILE *, char *format); +\end{verbatim}\end{code} + + If the original program uses \c{scanf}, just consider that you are using +\c{fscanf} from \c{stdin}. If instead your program contains \c{sscanf} then +you can use the function +\begin{code} +void resetSScanfCount(char *string); +\end{verbatim}\end{code} + +to dump the string to the temporary file \c{ccured\_sscanf\_file} +then use the replacement for \c{fscanf} from above. For example, + +\begin{code} + ... (resetSScanfCount(inputString), + entry = ccured_fscanf_int(ccured_sscanf_file, "Entry:%d"), + then = ccured_fscanf_double(ccured_sscanf_file, "; Then:%lf"), + ccured_fscanf_string(ccured_sscanf_file, "; 5 digits:%5[0-9]", buffer), + getScanfCount ()) ... //getScanfCount is required when using resetSScanfCount +\end{verbatim}\end{code} + + {\bf Note that the current support for \c{scanf} is far from satisfactory and + will likely change in the future} + + + \subsection{Implementation Issues} + + Almost all of the checking for variable-argument functions is done at +run-time. At the time of a call each actual argument is compared with the +types in the \c{struct} associated with the vararg function. A global data +structure is filled with the number of arguments (in the global +\c{\_\_ccured\_va\_count} and a list of indices describing for each actual +argument the index within the \c{struct} types (in \c{\_\_ccured\_va\_tags}). + + In the body of a vararg function, a data structure is allocated on the stack +to hold a copy of the global description of the arguments that was created by +the caller. The call to \c{va\_start} initializes this data structure and each +call to \c{va\_arg} checks that we are not reading past the end of the +actuals and also that the type of the fetched argument matches that of the +actual argument. + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Annotated Lengths}\label{sec-dependent} + +Programmers can annotate array pointers with length attributes. +Deputy will then use the annotated length whenever it needs to do a +bounds check on that pointer, instead of transforming the pointer into +a fat pointer. This has two advantages: +\begin{itemize} +\item Deputy will not need to change the representation of this + pointer, which improves compatibility with precompiled code. +\item Using a Deputy fat pointer to store the length of a buffer may + be redundant if the program already maintains a similar length value + near the pointer. +\end{itemize} + +Length annotations are allowed in two situations: struct fields may +have length annotations that depend on the values of other fields in +that struct, and function parameters may have lengths that depend on +other parameters in that function. (NB: but the annotations on +function parameters are not yet implemented. Coming soon ...) +% TODO: return values, constant expressions, etc. + +Only pointer types may be annotated. The annotation +\c{\_\_SIZE($exp$)} on a field means that the associated pointer is +$exp$ bytes long, where the expression $exp$ can involve integer +constants, arithmetic, \t{sizeof}, and the names of other fields in +the same struct. So \c{\_\_SIZE(1 + foo)} means that the specified +pointer has a length that's one greater than the runtime value of +field foo in the same object. + +\c{\_\_COUNT($exp$)} means that the pointer is $exp$ elements long. +So when annotating a pointer with type \c{T*}, the +annotation \c{\_\_COUNT($exp$)} is equivalent to \c{\_\_SIZE($exp$ * +sizeof(T))}. + +Any field that is referred to by a \c{\_\_SIZE} or \c{\_\_COUNT} +annotation is a {\em metadata field}. When a metadata field is +modified, any pointer fields that depend on it are set to NULL. {\em +Therefore, when writing both the metadata and pointer fields, programs +must always modify the metadata first, followed by the pointer.} + + When an annotated pointer field is read, Deputy will read any +metadata fields as well, and associate that length with the pointer. +When a pointer field is written, Deputy will check that the buffer's +length is less than or equal to the length specified by the current +value of the metadata fields. + +\begin{deputycode} +extern void* (DALLOC(sz) malloc)(int sz); + +struct bar { + int nrInts; + int *ints COUNT(nrInts); +}; + +struct foo { + int sizeBars; + struct bar * bars COUNT(sizeBars); +}; + +// Now the function that uses it + +void init(struct foo* pFoo) { + int nrBars = 5; + pFoo->sizeBars = nrBars * sizeof(* pFoo->bars); + pFoo->bars = (struct bar*)malloc(pFoo->sizeBars); +} +\end{deputycode} + + +In this code, we first overwrite the field \t{pFoo->sizeBars}, which +automatically sets the field \t{pFoo->bars} to NULL. The next step is +to write a new pointer to the \t{pFoo->bars} field. During this +write, Deputy will check that the pointer being written (in this case, +the result of \t{malloc}) is at least ``pFoo->sizeBars'' bytes long. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Memory Management}\label{sec-gc} +\TODO{this section} + + The high order bit: we use the Boehm-Weiser garbage collector. + + TODO : finish this section + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + \section{Deputy Pragmas}\label{sec-pragma} +\TODO{this section} + +% ====================================================================== +\chapter{Deputy Warnings and Errors}\label{ch-warn} +\TODO{this section} + + As you use Deputy you might encounter various kinds of problems. Most of +these are due to a combination of aggressive coding practices and Deputy being +less smart than the programmer. (Note: this section is continuously being +expanded; if you do not see the answer to your question, or if the answer is +not helpful, let us know). + + +%%%%%%%%%%%%%%%%%%%%%%% +\section{Compile-time Errors}\label{sec-warn-compile} +\begin{itemize} +\item Type mismatch: If Deputy sees an assignment where the types on the left- + and right-hand sides aren't compatible, it will print this error. Either fix + the types or insert a trusted cast by putting \c{TC(...)} around the + right-hand side. + +\item Incorrect allocation type: Deputy expects to be able to infer the type +of an allocation (e.g., \c{malloc}) from the right-hand side alone. The +argument to \c{malloc} should be of the form \c{e * sizeof(t)}, where \c{e} is +an expression containing constants, locals, *, and +. You can omit the +\c{sizeof(t)} if \c{t} is \c{char}. If \c{t} is void, you'll have to specify +\c{sizeof(void)} (which is, surprisingly enough, equal to 1). (This could be +better, I know!) \TODO{this explanation should be in memory allocators} + +\item Missing WHEN expression: If Deputy sees a union whose fields are +unannotated, it will complain. You can add \c{WHEN(e)} to each item, or you +can choose to trust the union by placing \c{TRUSTED} after the \c{union \{ ... +\}} definition. +\end{itemize} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%55 +%%%%%%%%%%%%%%%%%%%%%%%%%%% RUNNING +\section{Run-time Errors}\label{sec-warn-run} + + When you run the code you might get run-time errors. Make sure you read the +\chref{invoke} on ways to control the handling of errors. + +\begin{itemize} + +\item \TODO{The run-time errors} + +\end{itemize} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%55 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{License} + +Copyright (c) 2005-2006, +\begin{itemize} +\item Jeremy Condit +\item George Necula +\end{itemize} +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. + +\chapter{Bug reports} + + If you find a bug in Deputy, please send email to +\ahref{mailto:jcondit@cs.berkeley.edu}{Jeremy Condit}. + +\chapter{Changes}\label{sec-changes}\cutname{changes.html} + + Below are some of the changes in the Deputy system. These are in addition to +\ahref{../cil/changes.html} +{changes made to the underlying CIL infrastructure} + +\begin{itemize} +\item {\bf May 1, 2006} First version of this manual. +\end{itemize} + + + +\appendix + + + +% ========================= Regression Tester ======================== +\chapter{Using the Regression Tester}\label{ch-regtest} + + The regression tester is a program that allows you to do two things: +\begin{itemize} +\item Run a list of shell commands and capture their standard and error output + in a log file, and + +\item Analyze such log files and extract various information, among which the + most important is which test cases have succeeded and which have failed. + +\item Compare results of two runs according to many parameters, such as +whether the test succeeded or not, how much time Deputy took to process it, +how many different kinds of pointers were inferred and how fast is the +resulting program. +\end{itemize} + + Since the running of the tests and the analysis of the output is separated +you can easily do things like compare the results on multiple runs, extract +various reports from a single output (like what tests have succeeded, which +have failed, plus such information split by test groups). You can also extract +some data from each test (such as the running time) and make simple reports. + + Test cases can have comments associated with them (such as reminders of why +it fails) and can be associated with zero or more test groups. + + \section{Running the regression}\label{sec-regtest} + + The regression tester is implemented in Perl as "\t{runtests.pl}", which in +turn contains simple wrappers for functions provided by the more generic +\t{RegTest.pm}. + + The regression tester uses relative paths so it must be run in the + \t{deputy/test} directory. + + The basic command for running the tests is "\t{runtests --run}". This runs +all of the test cases, saving the log in the file "\t{runtests.log}". Before +creating this file, it renames previous versions of this file as +"\t{runtests.log.}" where n is an integer starting from 1 to a maximum number +that is configurable. + + The following command line options are useful for running the tests (see + "\t{runtests --help}" for a complete list: + +\begin{verbatim} + --one : runs only the named test + --gory : shows lots of details about the execution of the + test, such as the commands executed + --dryrun : only pretends to run the test. Useful to see what + would be run + --log : select the base name of the log file (default + "safec.log") + --logversions : keep logs up to version . Default is 5. + --noremake : runs the commands without trying to remake the safec + compiler before each test. Useful if you want to + work on the compiler while the tests are running + --safecdebug : uses the DEBUG version of the safec compiler and + uses the C compiler in debug mode. By default it + used the RELEASE version and the optimizing compiler. + + + + --group : adds all the tests in the named group to the list of + tests to be run or to participate in the analysis of + the log. (Right now we have NO groups) + If no such option is + specified then all tests are selected. Multiple such + options can be given and are cumulative. + --nogroup : excludes the tests in the named group from running + or from the analysis. Multiple such options can be + given and are cumulative. These options are + processed after all --group options have + been processed. + + --listtests : list the tests that are enabled along with their + group membership. This is useful to find out what + tests and groups exist. + + --stoponerror : stop at the first error + --showoutput : show the output on the console. Normally output is + saved in a file. +\end{verbatim} + + \section{Analyzing the results} + + The basic command for analyzing log files is "\t{runtests}". This will +prompt the user to select one of the several log files that exist in the +current directory and then (by default) it will print a list of the failed +test cases, with a short (user provided) comment and the last error message +detected in the output for that test case. + + The following commands are useful during analysis: +\begin{verbatim} + --log : select the log file (see above) + --group, --nogroup : select groups (see above) + --listtests : list tests and groups (see above) + --param= : show a report about the successes, with the columns + being the named parameters (separated by ,). Run + "testsafec --help" to see what parameters are + available. Use --param=ALL to make a report with + all available parameters. + --sort= : sorts the report by the given parameters. +\end{verbatim} + + Furthermore, the reports that are generated can be compared. To compare the + results of two runs (whose logs are say ``runtests.log.1'' and ``runtests.log.2'', + run + +\begin{verbatim} + test/compare runtests.log.2 runtests.log.1 --group=slow +\end{verbatim} + + This will compare the results of \t{runtests.log.2} using as reference the +results in log \t{runtests.log.1}. + + \section{Configuring the regression} + + + For this you have to edit runtests.pl. You will see a large section in the + middle of the file containing lines like: + +\begin{verbatim} +addDeputyTest("foo"); +\end{verbatim} + + + (check out the definition of \t{addDeputyTest} at the bottom of the file). + This adds the test named "\t{foo}", which processes \t{test/small/foo.c}. + + + To add just one test do: + +\begin{verbatim} + $TEST->newTest(Name => "mytestname", + Dir => "..", + Cmd => "make something", + Enabled => 1, + Comm => "Print this along with the test name", + Group => ["mygroup"], + Patterns => \%mypatterns); +\end{verbatim} % $ + Sometimes you might want to add just a comment or to add one group to a + certain test. Use the following simple functions: + + There are some wrappers defined at the end of runtests.pl: + +\begin{verbatim} + addBadComment("li-box", "bug in box.ml"); +\end{verbatim}%$ + + +% ------------------------ automatic tester ------------------ +\section{The Automated Regression Tester} + + Every time you commit a change to the DEPUTY repositories you trigger a + regression test and you should be receiving email with the results. If you +don't then it must be that the automated regression tester is not running or +it has encountered a problem that it cannot fix. + + The automated regression tester is implemented as a script \t{mk-reports.pl} +and lives in the home directory of user \t{regtest} on \t{manju}. To see +whether the tester is running run \t{ps -Af} and look for a line \t{perl +mk-reports.pl -daemon}. If you do not see any let me know. + + Here are the operations that are performed by the tester: + +\begin{enumerate} +\item A new directory is created under \t{/home/regtest/deputy.nightly}. The name +of the directory encodes the time of the commit (e.g. +\t{2001-12-07\_17\_50\_-0800.dir} is the directory for the commit at 17:50 on +07/12/2001 in the timezone that is 8 hours behind UTC). +\item A complete copy of DEPUTY is checked out in that directory and +\t{make} is run in there. +\item Then in the \t{test} directory we run \t{runtests} but only on the +groups that are known to terminate quickly. This run takes about 3 minutes. A +copy of the \t{runtests.log} file generated is saved as \t{/home/regtest/deputy.nightly/2001-12-07\_17\_50\_-0800.runtests.quick.log}. +\item Then we run \t{runtests} again to produce a report with all available +parameters. This report is saved as +\t{/home/regtest/deputy.nightly/2001-12-07\_17\_50\_-0800.report.quick.txt}. In the +event that any of the previous steps fail this file will be created but with +zero length. +\item Then we compare this report both with the previous commit and with a +reference report and a message is sent to the user who performed the commit. +This report is also saved as \t{/home/regtest/deputy.nightly/2001-12-07\_17\_50\_-0800.msg.quick.txt}. +\end{enumerate} + +%%%%%%%%%%%%%%%%% +\chapter{Debugging support}\label{sec-debugger} + + 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 Deputy that arises out +of the following command: +\begin{verbatim} +ccured --separate -c hello.c +\end{verbatim} + + You must follow the installation \ahref{../ccured/setup.html}{instructions} +to install the Elist support files for ocaml and to extend your .emacs +appropriately. Then from within Emacs you do +\begin{verbatim} +ALT-X my-camldebug +\end{verbatim} + + This will ask you for the command to use for running the Ocaml debugger +(initially the default will be ``ocamldebug'' or the last command you +introduced). You use the following command: +\begin{verbatim} +ccured --ocamldebug -c hello.c +\end{verbatim} + + This will run \t{ccured} 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. + + For the \t{make}-based interface to our regression tests you can pass the +argument \t{OCAMLDEBUG=1} to \t{make} to achieve the same effect. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Experimental Features} + +\end{document} + + +% LocalWords: unannotated memset diff --git a/doc/deputycode.pl b/doc/deputycode.pl new file mode 100755 index 0000000..f76dd34 --- /dev/null +++ b/doc/deputycode.pl @@ -0,0 +1,127 @@ +# +# Preprocesses a text and it changes +# \begin{deputycode}[comma_separated_options] +# ... +# \end{deputycode} +# +# The following options are supported: +# local - the code is generated inside a "main" function. By default the +# code goes at global scope +# fails - the processing is expected to fail +# norun - show just the code, not the Deputy output +# +# into the verbatim environment and add the option to see the Deputy output for +# it. +# Invoke: deputycode.pl in.tex out.tex +use strict; +use Data::Dumper; +use File::Copy; + +open(IN, "<$ARGV[0]") || (&help(), die "Cannot open file \"$ARGV[0]\""); +open(OUT, ">$ARGV[1]") || (&help(), die "Cannot open file \"$ARGV[1]\""); +sub help { + print "Invoke deputycode.pl in.tex out.tex"; +} + +my $doexamples = ! defined($ENV{'NO_EXAMPLES'}); + +my $testnr = 1; +my $tmpdir = "deputycode.tmp"; +my $htmloutdir = "examples"; +my $outdir = "html/deputy/$htmloutdir"; + +my @ccured = ('perl', '../bin/deputy', '--deputyopt=3', '--noPrintLn', + '--save-temps'); + +my $preambleLocal = <) { + # Strip extra \n\r at the end + if($_ =~ m|^([^\n\r]*)[\n\r]*|) { + $_ = "$1\n"; # And add one + } + $lineno ++; + if(! $incode && $_ =~ m|^\\begin{deputycode}(\[(.*)\])?|) { + @opt = split(/[ ,]/, $2); # The options + $incode = 1; + print STDERR "\n***Found Deputy code (ex$testnr) at line $lineno, with options=", + join(',',@opt), "\n"; + if(! grep(/norun/, @opt)) { + open(TSTSRC, ">$tmpdir/ex$testnr.c") + || die "Cannot create source $testnr"; + if(grep(/local/, @opt)) { + print TSTSRC $preambleLocal; + } else { + print TSTSRC $preambleGlobal; + } + } + print OUT "\\begin{code}\n"; + next; + } + if($incode && $_ =~ m|^\\end{deputycode}|) { + $incode = 0; + print OUT "\n\\end{verbatim}\\end{code}\n"; + if(! grep(/norun/, @opt)) { + if(grep(/local/, @opt)) { + print TSTSRC $postambleLocal; + } else { + print TSTSRC $postambleGlobal; + } + close(TSTSRC); + if($doexamples) { + print OUT "The \\ahref{$htmloutdir/ex${testnr}.deputy.txt}{Deputy output} for this code fragment\n"; + + # Now run ccured. Pass all the options that start with -- + my @ccuredOpt = grep(/^--/, @opt); + my $fails = + 0 != + system(@ccured, @ccuredOpt, + '-c', "$tmpdir/ex$testnr.c", + '-o', "$tmpdir/ex$testnr.o", + "--save-temps=$tmpdir"); + my $shouldfail = 0 != grep(/fails/, @opt); + if($fails != $shouldfail) { + die "Error running Deputy for $tmpdir/ex$testnr.c (fails=$fails, shouldfail=$shouldfail)"; + } + # Now copy the CCured file + my $cilfile = "$tmpdir/ex$testnr.cil.c"; + my $exfile = "$outdir/ex$testnr.deputy.txt"; + if(! File::Copy::copy($cilfile, $exfile)) { + die "Cannot copy $cilfile to $exfile"; + } + # And copy the browser directory + # system("cp -r $tmpdir/ex$testnr.browser $outdir"); + } + } else { + print OUT "(Code generation was turned off for this document)\n"; + } + $testnr ++; + next; + } + if($incode) { + print TSTSRC $_; + } + print OUT $_; +} + + diff --git a/doc/fullpage.sty b/doc/fullpage.sty new file mode 100755 index 0000000..67824e3 --- /dev/null +++ b/doc/fullpage.sty @@ -0,0 +1,29 @@ +% This is FULLPAGE.STY by H.Partl, Version 2 as of 15 Dec 1988. +% Document Style Option to fill the paper just like Plain TeX. + +\typeout{Style Option FULLPAGE Version 2 as of 15 Dec 1988} + +\topmargin 0pt +\advance \topmargin by -\headheight +\advance \topmargin by -\headsep + +\textheight 8.9in + +\oddsidemargin 0pt +\evensidemargin \oddsidemargin +\marginparwidth 0.5in + +\textwidth 6.5in + + +% For users of A4 paper: The above values are suited for american 8.5x11in +% paper. If your output driver performs a conversion for A4 paper, keep +% those values. If your output driver conforms to the TeX standard (1in/1in), +% then you should add the following commands to center the text on A4 paper: + +% \advance\hoffset by -3mm % A4 is narrower. +% \advance\voffset by 8mm % A4 is taller. + +\endinput + + diff --git a/doc/header.html.in b/doc/header.html.in new file mode 100755 index 0000000..abcb952 --- /dev/null +++ b/doc/header.html.in @@ -0,0 +1,16 @@ + + + + + +Deputy Documentation (v. @DEPUTY_VERSION@) + + + + + +

Deputy - Cool Stuff (v. @DEPUTY_VERSION@)

+ + + + diff --git a/doc/hevea.sty b/doc/hevea.sty new file mode 100755 index 0000000..8363b53 --- /dev/null +++ b/doc/hevea.sty @@ -0,0 +1,86 @@ +% hevea : hevea.sty +% This is a very basic style file for latex document to be processed +% with hevea. It contains definitions of LaTeX environment which are +% processed in a special way by the translator. +% Mostly : +% - latexonly, not processed by hevea, processed by latex. +% - htmlonly , the reverse. +% - rawhtml, to include raw HTML in hevea output. +% - toimage, to send text to the image file. +% The package also provides hevea logos, html related commands (ahref +% etc.), void cutting and image commands. +\NeedsTeXFormat{LaTeX2e} +\ProvidesPackage{hevea}[2002/01/11] +\RequirePackage{comment} +\newif\ifhevea\heveafalse +\@ifundefined{ifimagen}{\newif\ifimagen\imagenfalse} +\makeatletter% +\newcommand{\heveasmup}[2]{% +\raise #1\hbox{$\m@th$% + \csname S@\f@size\endcsname + \fontsize\sf@size 0% + \math@fontsfalse\selectfont +#2% +}}% +\DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}% +\DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}% +\DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}} +%%%%%%%%% Hyperlinks hevea style +\newcommand{\ahref}[2]{{#2}} +\newcommand{\ahrefloc}[2]{{#2}} +\newcommand{\aname}[2]{{#2}} +\newcommand{\ahrefurl}[1]{\texttt{#1}} +\newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}} +\newcommand{\mailto}[1]{\texttt{#1}} +\newcommand{\imgsrc}[2][]{} +\newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1} +\AtBeginDocument +{\@ifundefined{url} +{%url package is not loaded +\let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref} +{}} +%% Void cutting instructions +\newcounter{cuttingdepth} +\newcommand{\tocnumber}{} +\newcommand{\notocnumber}{} +\newcommand{\cuttingunit}{} +\newcommand{\cutdef}[2][]{} +\newcommand{\cuthere}[2]{} +\newcommand{\cutend}{} +\newcommand{\htmlhead}[1]{} +\newcommand{\htmlfoot}[1]{} +\newcommand{\htmlprefix}[1]{} +\newenvironment{cutflow}[1]{}{} +\newcommand{\cutname}[1]{} +\newcommand{\toplinks}[3]{} +%%%% Html only +\excludecomment{rawhtml} +\newcommand{\rawhtmlinput}[1]{} +\excludecomment{htmlonly} +%%%% Latex only +\newenvironment{latexonly}{}{} +\newenvironment{verblatex}{}{} +%%%% Image file stuff +\def\toimage{\endgroup} +\def\endtoimage{\begingroup\def\@currenvir{toimage}} +\def\verbimage{\endgroup} +\def\endverbimage{\begingroup\def\@currenvir{verbimage}} +\newcommand{\imageflush}[1][]{} +%%% Bgcolor definition +\newsavebox{\@bgcolorbin} +\newenvironment{bgcolor}[2][] + {\newcommand{\@mycolor}{#2}\begin{lrbox}{\@bgcolorbin}\vbox\bgroup} + {\egroup\end{lrbox}% + \begin{flushleft}% + \colorbox{\@mycolor}{\usebox{\@bgcolorbin}}% + \end{flushleft}} +%%% Style sheets macros, defined as no-ops +\newcommand{\newstyle}[2]{} +\newcommand{\addstyle}[1]{} +\newcommand{\setenvclass}[2]{} +\newcommand{\getenvclass}[1]{} +\newcommand{\loadcssfile}[1]{} +\newenvironment{divstyle}[1]{}{} +\newenvironment{cellstyle}[2]{}{} +%%% Postlude +\makeatother diff --git a/doc/html/.cvsignore b/doc/html/.cvsignore new file mode 100755 index 0000000..1952e39 --- /dev/null +++ b/doc/html/.cvsignore @@ -0,0 +1 @@ +deputy diff --git a/doc/index.html.in b/doc/index.html.in new file mode 100755 index 0000000..0be5bce --- /dev/null +++ b/doc/index.html.in @@ -0,0 +1,24 @@ + + + + +Deputy Documentation (v. @DEPUTY_VERSION@) + + + + + + + + + + <body> + + <p>This page uses frames, but your browser doesn't support them.</p> + + </body> + + + + \ No newline at end of file diff --git a/doc/www/bnd-be-nt.png b/doc/www/bnd-be-nt.png new file mode 100644 index 0000000000000000000000000000000000000000..613bbb4df9f0faad5a9815b0e977f317d563d626 GIT binary patch literal 693 zcmeAS@N?(olHy`uVBq!ia0y~yVEhbZ2XZh2$&W?*HGouafKP}k8ylN|fB+*SBT#^o zlaqskLqbBrz`#IROIt%nS3yC+!oosBLqk_ZK~F=~!^0yYBErGJAs`?iv$U+fzCIx# zp`xOqpr9ZlBcn1iar*S>^XJcRZ*TAK?_a-u{qp6@w{PFRfB*jVm#*%9@c91y`^S$T zzkdDt`Sa&5zkd7v!0OMJ4!?i@{`>du&!0d4|NsBh`MQ}vcQBR&`2{mLJiCzw;v{*y zyD)UH%6foYSl|&^%)r2R1cVuck1({2Ghm!=PYa7*#QO~_h&!d z_sZ>Mza>!LOyl%(cjg$GF9);c0EO1|?#xa;cV~}5`ni~TQDeJ*(@nnxnS0f%&Xl`u z_7%i>%3bwldES(NUE*J^_}|s|J5}$+#^t*Le`&{D2=*^s{3U$bg5w|y)@L~S*Iw>El1kZd*N>xBlCXTYqcA<-Qlk+O7M%r*uVZ`P;gwb)P5YRi3nqe_Ocq z_wMJa)pzDhe^m-{9mq`}$L&-8oSJ-WkN#)Z8s52;F`w(-ikc z;XVN}>d*g~vZ+|I?esIn?=|vMkH5^fUGC@t1bnmYpWn~4WpZ=g4~#zsPgg&ebxsLQ E09~X+MgRZ+ literal 0 HcmV?d00001 diff --git a/doc/www/bnd-be.png b/doc/www/bnd-be.png new file mode 100644 index 0000000000000000000000000000000000000000..d04341121a98e2b4f8337c3777edde9f42033f17 GIT binary patch literal 604 zcmeAS@N?(olHy`uVBq!ia0y~yVAKJ!LpYd$B>&Q1@j$9Kz$e6&jg3t}K!A~v5h%dP z$;rXNAt51QU|^uErLCc(tDvA@VPT=6p`ojypr@hg;o%Vx5#iwA5D*ZMSz1X?_wfUrhg6t)pzOL-o8RbL`rSfMBQ~>pOc)B=-RNQ)d zb7S5i0}<8>7tD9eP5gFA_5c6YwIX7xmdr@{H0RYFMi&v)@Zm4+H zeVzA(@BS_MOBdHjALIBvxB1QHq&w+N2dWO{b2h3fDJhj*F8i4K7pR<-TTCZn1A_7N zoA&AYU#aiaBEQ$JijU>Hw)b?(-S0c=R5Ke-UufQXalM*ufo#==ZNH{2Vbycyzvi}o z)|LaMFAm;%6+TI92aj!p^xv#YOxLZ-o^ks4&)-jN&VRobwf_3=J@@{GsoUG# z7AlUO1>qvB#dL_Q>}!#;JAE!ceHZ=u>piRa*LU9s28f{GPw#yU$I2(q?Ob3H0}N&c MPgg&ebxsLQ09I=X&j0`b literal 0 HcmV?d00001 diff --git a/doc/www/count-5.png b/doc/www/count-5.png new file mode 100644 index 0000000000000000000000000000000000000000..3e7e991f377703ac8b05141e83b50e5b0b70eba8 GIT binary patch literal 461 zcmeAS@N?(olHy`uVBq!ia0vp^_klQ=gBeI_gevU?QoR8_A+Bs}YytuTjEsyx0ZvX% z4h{|p2?+xO17$634INzt1qBNW3k?koT@?jA4OI^hkBEo}2M33MfPl=>vikb^goK2O zii(1Qf{cue%FM*+)2Gj$Kfk@by}!SI{rdIGmoMMGef$3X``2H(y8FT7`}gl3KYslB z_3P))pTGS2?fV0(KVLfh{{8#!-@iY9{`~*{|5xYhW&+*8SQ6wH%;50sMjD8duieqD8NU)-mL_uqZ) zKX2?m|Mz=8d&axZ#=kzVXSp2q!S#MM_YW1%PqMv0Z^1x*YW(Z}>$im5zgJuRtwHxY z)7{O_t=W0zy_Yel+?Rad#m_#*&Cj);#vPyachBnA8|;qF`e$Q@0rsu0z5U>Q_x6+L fZ+EG9YJX?B5tkRNkQKQS=m`c-S3j3^P6#^ek;1lAitD+zvAi&7T$i~LT z$;rvV!66|bVPIgOtfj4?qpP5xU}0gQp`ig(uBV~u;o%Vx5#iwA5D*ZMSz1)^mS#w&L}5pV0qF! zZ|Bw)&oW?WFN{9T_9P?B#Xs#2gJ4k)#M~{L&)eGOgVo|6FgJU^0eofr2$<@num{LwcK!HmYi+;{s|>Xxm)vwr@)HC_6;^<-8@ zvt6_9zWlRKaVxqvwHdfUATD^l(K**lDu?w|j+Xzv96#Cwt<{If$&JY8mE z(DThwtT1HHzT9<_QV!~-8>CcDF|QZx_f|6Xn>fdPL-LH|L+}0xyS+cqiB|5eMX&MkTyoEBZhSG{zWuC8n2#cB1)5!+S&p9_2N@K5ove+D;%t)rtp z@3y^IQ`b?_ndp~+}?6`iqtK`FG>9O9V2dY uozV>y-M0IsRkOqWPsKNwKz^xUuV;v#`84<0w? + + +Deputy + + + + +
+ +

Deputy

+ +
+ +

What is Deputy?

+ +

Deputy is a C compiler that is capable of preventing common C +programming errors, including out-of-bounds memory accesses as well as +many other common type-safety errors. It is designed to work on +real-world code, up to and including the Linux kernel itself.

+ +

Deputy allows C programmers to provide simple type annotations that +describe pointer bounds and other important program invariants. Deputy +verifies that your program adheres to these invariants through a +combination of compile-time and run-time checking.

+ +

Unlike other tools for checking C code, Deputy provides a flexible +annotation language that allows you to describe many common programming +idioms without changing your data structures. As a result, using Deputy +requires less programmer effort than other tools. In fact, code compiled +with Deputy can be linked directly with code compiled by other C +compilers, so you can choose exactly when and where to use Deputy within +your C project.

+ +

Deputy is implemented using the CIL infrastructure for C +program analysis and transformation.

+ +
+ +

Download

+ +

Deputy is currently available as a Debian package, an RPM, or a source +distribution:

+ + + +

If you choose to download the source distribution, you will need the OCaml compiler to build Deputy.

+ +

Deputy is currently being developed for Linux and Cygwin on x86 +processors. Other platforms and processors should work as well but may +require additional effort to build. (Please feel free to submit comments and/or +patches for other platforms!)

+ +
+ +

Documentation

+ + + +
+ +

Papers

+ +

Further information about Deputy and its uses can be found in the +following papers:

+ +
    + +
  • Feng Zhou, Jeremy Condit, Zachary Anderson, Ilya Bagrak, Rob Ennals, +Matthew Harren, George Necula, and Eric Brewer. SafeDrive: Safe and +Recoverable Extensions Using Language-Based Techniques. OSDI 2006. +[pdf]
    • + +
  • Jeremy Condit, Matthew Harren, Zachary Anderson, David Gay, and George +Necula. Dependent Types for Low-Level Programming. ESOP 2007. +[pdf]
    • + +
  • Jeremy Condit, Matthew Harren, Zachary Anderson, David Gay, and George +Necula. Dependent Types for Low-Level Programming. UC Berkeley +Technical Report EECS-2006-129. [pdf]
    • + +
+ +
+ +

Contact

+ +

Please send questions and feedback to the Deputy team at deputy@deputy.cs.berkeley.edu. +We welcome any comments you have about your experience using Deputy and +your suggestions for improving it!

+ +

Deputy was written by Jeremy Condit, Matt Harren, Zach Anderson, and +George Necula. Many thanks to Feng Zhou, Rob Ennals, David Gay, Ilya +Bagrak, Bill McCloskey, and Eric Brewer for valuable discussions and +feedback.

+ +
+ + + diff --git a/doc/www/manual.html b/doc/www/manual.html new file mode 100644 index 0000000..2ade478 --- /dev/null +++ b/doc/www/manual.html @@ -0,0 +1,815 @@ + + + + +Deputy Manual + + + + +
+ +

Deputy Manual

+ +
+ +

Contents

+ + + +
+ + +

1. What is Deputy?

+ +

Deputy is a C compiler that enforces a stricter typing discipline on +your C programs. Among other things, it verifies that pointers stay +within their designated bounds, and it ensures that union fields are used +safely.

+ +

In order to compile your C program with Deputy, you must first supply +some lightweight type annotations. For the most part, these annotations +are required on function arguments and return values, structure fields, +and global variables--that is, the interfaces to each source file. +Deputy's annotations are designed to reflect common programming idioms; +for example, you can easily say that a pointer p points to an +array of length n, where n is another variable in the +program. Deputy then verifies your program through a combination of +compile-time and run-time checking. This approach allows us to verify a +wide range of real-world programs (even Linux device drivers!) in return +for a slight performance penalty.

+ +

Deputy differs from previous tools for safe C compilation in that it +allows the programmer to specify pointer bounds and union tags using +dependent types--that is, using annotations that depend on other +variables or fields in your program. As a result, Deputy requires fewer +modifications to the original program and makes less invasive changes to +the program during compilation. Deputy produces object files that can be +linked directly to object files produced by other compilers; thus, the +programmer can choose to enable Deputy on a file-by-file basis, and +programs compiled with Deputy can be linked directly with existing C +libraries.

+ +

Deputy is implemented as a drop-in replacement for existing compilers +such as gcc, and it is therefore easy to integrate Deputy into +your existing build process. In addition, Deputy uses gcc as a +back-end, which means that all of the optimizations provided by +gcc are still available to your code. Read on to learn how to +get started!

+ +
+ + +

2. Getting Deputy

+ +

Deputy can be obtained via the download links at the main page, as a Debian package, +an RPM, or a source tarball. For access to the Subversion repository, +send email to Jeremy +Condit.

+ +
    + +

  • Debian:

    +
    % dpkg -i deputy_1.1-1_i386.deb
    • + +

  • Red Hat / Fedora:

    +
    % rpm -i deputy-1.1-1.i386.rpm
    • + +

  • Source tarball:

    +
    % tar zxvf deputy-1.1.tar.gz +% cd deputy-1.1 +% ./configure +% make +% make quicktest +% make install +
    +
    • + +
+ +

You're all set!

+ +
+ + +

3. Basic Usage

+ + +

3.1. Invoking Deputy

+ +

Deputy is implemented as a drop-in replacement for gcc, so you +can invoke it in exactly the same way you would invoke gcc. For +example, if you want to compile the C source file foo.c to the +object file foo.o, you can use the following command:

+ +
% deputy -c -o foo.o foo.c +
+ +

If you're using Deputy on an existing C project, all you need to do is +to set the CC variable in your Makefile to the +deputy executable.

+ +

The object files produced by Deputy are compatible with object files +produced by gcc, so you can link them with the standard linker. +However, Deputy-generated object files need to eventually be linked with +Deputy's runtime library, which has code to handle run-time failures. If +you use deputy as your linker (much as gcc is often used +as the linker), the runtime library will automatically be linked when an +executable is created. For example, to link foo.o and +bar.o to create an executable foobar, you can use the +following command:

+ +
% deputy -o foobar foo.o bar.o +
+ + +

3.2. Edit, Compile, Debug

+ +

Using Deputy is much like the familiar edit-compile-debug cycle for any +other compiler. When you run Deputy on a C file, it will emit a number of +warnings and errors that either suggest annotations or indicate errors. +Your job as the programmer is to address these warnings and errors by +adding annotations or changing code.

+ +

For example, consider the following code:

+ +
int sum(int *data, int length) { + int i, sum = 0; + for (i = 0; i <= length; i++) { + sum += data[i]; + } + return sum; +} +
+ +

Assuming this code is in a file called sum.c, we could compile +it as follows:

+ +
% deputy -c -o sum.o sum.c +sum.c:1: Warning: Type "int *" in formal "data" of sum needs a bound annotation. +
+ +

We got a warning, but it compiled. Now let's build a program that +calls the sum() function with an array of length 5.

+ +
% gcc -c -o test-sum.o test-sum.c +% deputy -o test-sum test-sum.o sum.o +
+ +

Note that we compiled the test code with gcc, since the +resulting object files can be linked directly with the ones produced by +deputy. Note also that we linked with deputy so that we +get Deputy's runtime library.

+ +

Now let's run this program:

+ +
% ./test-sum +sum.c:4: sum: Assertion failed in upper bound check: + data + i + 1 <= data + 1 (with no overflow) +Execution aborted. +
+ +

The reason for this assertion is that Deputy assumed that the +data argument to sum() pointed to a single integer, not +an array of integers. When the sum() function attempted to +access integers beyond the first element of this array, a Deputy run-time +error was triggered. Note that the warning provided by Deputy at compile +time indicated that something about this code was fishy.

+ +

We can fix this error by adding an annotation to the int* +type, as follows:

+ +
int sum(int * COUNT(length) data, int length) { + int i, sum = 0; + for (i = 0; i <= length; i++) { + sum += data[i]; + } + return sum; +} +
+ +

This annotation tells Deputy that length stores the length of +data. Now if we compile and run the above program, we will see +no warnings or errors:

+ +
% deputy -c -o sum.o sum.c +% gcc -c -o test-sum.o test-sum.c +% deputy -o test-sum test-sum.o sum.o +% ./test-sum +
+ +

Deputy provides many such annotations to describe common programming +idioms. In the following sections, we will discuss Deputy's pointer +annotations in detail.

+ +
+ + +

4. Pointer Bounds Annotations

+ + +

4.1. Syntax

+ +

Most Deputy annotations are written as type annotations that are +written immediately after the type to which they are attached. For +example:

+ +
int * SAFE p;
+ +

This code declares a variable p of type int * SAFE. +In this example, SAFE is a Deputy annotation attached to the +pointer type int *. In general, any annotations appearing after +a * apply to that pointer type.

+ +

Here is another example:

+ +
int main(int argc, char * NTS * NT COUNT(argc) argv);
+ +

This example shows the Deputy annotations for main. The +NTS annotation applies to the first pointer (the inner char +*), and the NT and COUNT(argc) annotations apply to +the second pointer (the outer char **). Overall, this annotation +says that argv is a null-terminated sequence with a minimum +length of argc. Each element of this sequence is a +null-terminated string. (These annotations will be discussed in detail +below!)

+ + +

4.2. Safe Pointers

+ +

The first Deputy annotation that we will introduce is the "safe" +pointer. Safe pointers are possibly-null pointers to a single object of +their base type. For example:

+ +
struct foo * SAFE p;
+ +

This code declares a pointer p that is either null or points +to a single object of type struct foo.

+ +

Safe pointers are typically used much like Java references: they can be +passed around and dereferenced, but they are not used in pointer +arithmetic. Such pointers are by far the most common kind of pointers in +C programs.

+ +

When you dereference a safe pointer, Deputy will insert a null check +(or its equivalent). However, if your code has already checked this +pointer to ensure that it is non-null, Deputy's optimizer will most likely +remove the Deputy-inserted null check. Deputy's will also issue +compile-time errors for obviously-incorrect code such as p[1].

+ +

If you are sure that the pointer is never null, you can add the +NONNULL annotation. For example:

+ +
struct foo * SAFE NONNULL p;
+ +

Since this pointer is annotated as both SAFE and +NONNULL, it can typically be dereferenced at zero run-time +cost.

+ + +

4.3. Count Pointers

+ +

Of course, many C programs use pointers to point to arrays of +objects. Such pointers can be annotated as "count" pointers:

+ +
struct foo * COUNT(5) p;
+ +

This annotation says that p is either null or it points to an +array of five valid objects of type struct foo. For the visually +inclined, the memory layout is as follows, where each blue box represents +an object of type struct foo:

+ +
+ +
+ +

Note that the SAFE annotation introduced earlier is actually +equivalent to COUNT(1). Also note that this annotation can be +written as CT instead of COUNT if you prefer terse +annotations.

+ +

In addition to using the count annotation with constants, the count +annotation can also refer to other variables in the same +scope or to more complex expressions. For example:

+ +
int n, m; +struct foo * COUNT(n * m) p; +
+ +

Here, we've declared that p is a pointer to an array of n +* m objects of type struct foo (a two-dimensional array, +perhaps). Visually, we have the following memory layout:

+ +
+ +
+ +

If we refer to an element p[i] of this array, Deputy +will verify that p is non-null and that 0 <= i < n * +m. + +

When count annotations refer to variables, they may refer only to +variables in the immediately enclosing scope. For example, annotations on +local variables may only refer to other local variables, and annotations +on structure fields may only refer to other structure fields. +Furthermore, these annotations may not include memory dereferences or +function calls. These restrictions allow Deputy to efficiently verify +that a variable's type annotation is valid for the duration of that +variable's lifetime.

+ +

Finally, note that count annotations (and indeed, all Deputy +annotations) must be valid throughout the variable's lifetime. Thus, in +the previous example, Deputy will prevent you from incrementing n +or m, since this change might invalidate the annotation on +p. Furthermore, p cannot be incremented, because then +p would no longer point to an array of n * m elements. +(If you're worried that this sounds too restrictive, bear with me until +the section on automatic bounds!)

+ + +

4.4. General Bounded Pointers

+ +

The most general annotation provided by Deputy is the "bound" +annotation, which is written as follows:

+ +
struct foo * BOUND(b, e) p;
+ +

This annotation says that p is either null or points into +an array of objects of type struct foo with bounds b and +e. All of these pointers (p, b, and +e) must be aligned with respect to the size of struct +foo. Visually, the memory layout is:

+ +
+ +
+ +

As with the count annotation, the arguments b and e +can actually be expressions that refer to other variables or fields in the +same scope. The same restrictions that apply to count pointers apply here +as well. As with the count annotation, you can write BND as the +terse form of BOUND.

+ +

In this annotation, the expressions b and e can make use of +the special variable __this, which refers to the variable, field, +or expression to which this type is attached. So, for example, the +annotation BOUND(__this, __this + n) says that the bounds of the +associated pointer are the pointer itself and the pointer plus n +elements. In fact, this is precisely how COUNT(n) is +defined!

+ + +

4.5. Sentinel Pointers

+ +

One final pointer annotation to be discussed is the sentinel pointer. +In Deputy, the sentinel annotation, written SNT, indicates that a +pointer is used only for comparisons and not for dereference. Such +pointers are useful mainly for indicating the bounds of other pointers. +They are also useful for C idioms where the program computes the address +of the end of an array.

+ +

In terms of the general bounded pointer, a sentinel pointer is +equivalent to BOUND(__this, __this)--that is, the pointer is both +its upper and lower bound.

+ + +

4.6. Null-Terminated Pointers

+ +

The annotations introduced thus far allow you to specify pointer bounds +by referring to other nearby variables. However, bounds for arrays are +sometimes indicated using null termination instead.

+ +

Deputy handles null-termination with an additional annotation, +NT, that can be used in addition to the +previously-discussed bounds annotations. In other words, you have the +option of specifying NT in addition to BOUND or one of its +shorthands (SAFE, COUNT, and SNT).

+ +

The meaning of this annotation is that the upper bound given +by the BOUND annotation is the beginning of a null-terminated +sequence. So, the annotation NT COUNT(5) describes an array of +five elements followed by a null-terminated sequence (or, in other words, +a null-terminated sequence of at least five elements). This annotation +allows the null element to be read but not overwritten with a non-zero +value. A sequence with no known bounds (e.g., a standard C string) is +written as NT COUNT(0), which can be abbreviated as +NTS.

+ +

In its most general form, the annotation NT BOUND(b, e) +corresponds to the following memory layout:

+ +
+ +
+ +

Note that the initial portion of the array is laid out in the same way +as BOUND(b, e); the only difference is that we have a +null-terminated sequence (shown as the pink boxes) at the end.

+ +

This hybrid design is important in ensuring that bounded sequences and +null-terminated sequences interact cleanly. For example, C programs often +have stack-allocated arrays that have a known size and are +null-terminated. If we did not mark it as null-terminated, we would not +be able to call strlen() and its like on this buffer. If we +marked it as null-terminated only, then we would not be able to insert +null elements in this buffer without cutting off access to the remainder +of the buffer.

+ +

Note that it is always legal to cast away the NT flag; for +example, a NT COUNT(5) sequence can safely be considered to be a +COUNT(5) sequence, although you lose access to the +null-terminated portion of the array. This operation can be performed +with the NTDROP(e) function.

+ +

One complication with NTDROP is that you lose a lot of bounds +information. For example, strings are typically annotated char * +NTS, and calling NTDROP on such a value results in a value +of type char * COUNT(0), which is not very useful. Thus, we also +provide NTEXPAND(e), which expands the bounds of the expression +e dynamically. So, NTDROP(NTEXPAND(e)) yields a +non-null-terminated type with the largest legal bounds.

+ + +

4.7. Casts

+ +

Deputy has stricter checking of type casts than C itself. First, +Deputy checks to make sure that the bounds of the type being cast are +correct. For example, a COUNT(5) pointer could be cast to a +COUNT(4) pointer, but not the other way around. When necessary, +Deputy will insert run-time checks to verify that such casts are safe. +Since all the bounds annotations are special cases of BOUND, they +can all be cast freely from one to the other.

+ +

Deputy also ensures that the NT flag is either present or +absent on both sides of the cast. (In fact, Deputy infers the NT +flag in these situations, as we will discuss in the next section.) The +only way to drop the NT flag is to use the NTDROP +function discussed above. The NT flag can never be added by a +cast; it must be present from the point of allocation forward.

+ +

Finally, Deputy checks the base types of pointers involved in a cast. +For example, you are not allowed to blindly cast an int ** to an +int *, since otherwise you could overwrite a pointer with an +integer. Similarly, you are not allowed to cast a non-pointer type to a +pointer. However, when casting between pointers to non-pointer data +(e.g., int * to char *), Deputy will allow the cast.

+ + +

4.8. Trusted Code

+ +

If you must use a cast that Deputy doesn't like, you can use the +TC(e) function to perform a trusted cast from an expression +e to some new type. For example, the following cast will be +accepted by Deputy:

+ +
int * SAFE * SAFE pp = ...; +int * SAFE p = (int * SAFE) TC(pp); +
+ +

Alternatively, any pointer can be labelled as trusted by using the +TRUSTED annotations. Trusted pointers can be cast to any other +pointer without compile-time or run-time checks. Similarly, these +pointers can be incremented or decremented without restriction. (In fact, +the TC operation is implemented as a cast to a TRUSTED +pointer of the same type.)

+ +
+ + +

5. Inference

+ +

Deputy has several inference features that reduce the number of +annotations required for type checking. Most of these features operate +behind the scenes, but it is important for the programmer to be aware of +what they do.

+ + +

5.1. Default Annotations

+ +

Any types that may be visible by code outside the current compilation +unit are given the default annotation of SAFE. These types +include the types of global variables, function arguments, function return +values, structure fields, and the base types of other pointers. This +annotation is correct in the vast majority of cases, so it is quite useful +for the programmer to be able to omit it.

+ +

However, it is important to note that this assumption is not +safe and is provided only for convenience. For example, imagine that your +code calls a function foo(char *p) in another module. If this +function expects a null-terminated string and we assume a SAFE +annotation, then Deputy would allow you to pass a pointer to a single +character when a string was expected. Fortunately, such errors will be +detected when running Deputy on the code for foo() itself; +furthermore, header files for standard libraries should soon be fully +annotated. In the near future, we will include an option to warn the +programmer about such assumptions.

+ + +

5.2. Automatic Bounds

+ +

For the types of local variables and types appearing in casts, Deputy +can do a bit more to help the programmer. In these situations, Deputy +assumes that unannotated types have the annotation BOUND(__auto, +__auto). In this context, __auto is a special keyword that +instructs Deputy to generate a new variable to hold and track the +appropriate bound. For example, say we have the following +declaration:

+ +
int a[10]; +int * BOUND(__auto, __auto) p; +p = a; +
+ +

After preprocessing, this code becomes:

+ +
int a[10]; +int * SNT pb; +int * SNT pe; +int * BOUND(pb, pe) p; +pb = a; +pe = a + 10; +p = a; +
+ +

Note that we have introduced two new bounds variables to track the +bounds of p, and we updated these bounds variables when +p was updated.

+ +

These automatic bounds variables are very useful beyond their ability +to reduce the annotation burden. In many cases, programmers wish to +explicitly introduce new bounds variables when existing code is not +amenable to annotation. As mentioned earlier, COUNT pointers +cannot be incremented; however, if you copy a COUNT pointer into +an unannotated pointer, then this unannotated pointer can be incremented, +since its bounds are stored in two fresh variables.

+ + +

5.3. NT Inference

+ +

In addition to the above inference, Deputy also infers NT +annotations using somewhat more traditional means. Essentially, any +pointer that is casted to/from or assigned to/from an NT pointer +becomes NT itself. Of course, this inference algorithm +understands the NTDROP function and does not propagate +NT across this operation.

+ +

This feature reduces the burden of NT annotation dramatically, +but it can also infer unintended NT annotations. In most cases, +this problem results from a common function like memset(). If an +NT pointer is inadvertendly passed to memset() without +using NTDROP, the NT flag will be propagated to +memset()'s argument and from there to all other pointers passed +to memset(), most of which are not NT. To solve this +problem, search for common functions like memset() and make sure +to use NTDROP when appropriate.

+ +
+ + +

6. Union Annotations

+ + +

6.1. Tagged Unions

+ +

In addition to pointer bounds errors, unions provide another source of +unsafety in C programs. As with pointer bounds, Deputy provides a way to +annotate common idioms used to ensure the safety of unions.

+ +

In Deputy, each union field must be annotated with a predicate +indicating the condition that must hold when that field of the union is +currently active. For example, consider the following annotated C +code:

+ +
struct foo { + int tag; + union { + int n WHEN(tag == 1); + int *p WHEN(tag == 2); + } u; +} +
+ +

Without any checking, this union is potentially unsafe, because a +program could write an aribtary integer to the field u.n and then +read it out as a pointer by reading u.p. The WHEN +annotations indicate that the n field can only be accessed when +tag is 1, and the p field can only be accessed when +tag is 2. When changing the tag, the contents of the union must +be zero, which is assumed to be a valid value for all data types.

+ +

There are a few differences between the usage of this annotation and +the usage of the pointer bounds annotations. First, if the WHEN +fields refer to variables, they must be variables in the same scope as the +union, not fields of the union itself. (In the above example, we refer to +tag as opposed to n and p.) Second, these +annotations are placed on the union fields themselves, not on their +types--that is, they appear after the field name. The reason for +these differences is that the WHEN fields are conceptually +annotations on the union type, not on the fields of the union.

+ + +

6.2. Trusted Unions

+ +

As with bounded pointers, unions can be trusted when the tag +annotations are insufficient. To do so, simply place the TRUSTED +annotation on the union itself. For example:

+ +
union { + int n; + int *p; +} TRUSTED u; +
+ +
+ + +

7. Polymorphism

+ +

C programmers typically use void * in cases where a number of +different types may be used. However, casts to and from this void +* are not checked for safety. Deputy provides parametric +polymorphism to handle some of these cases.

+ + +

7.1. Polymorphism in Functions

+ +

Function arguments can be treated as polymorphic. Instead of writing +void *, use the type TV(t), which stands for "type +variable named t". Any occurrences of this type that have the +same name t must be the same type for any particular call to this +function. For example:

+ +
void apply(void (*fn)(TV(t) data), TV(t) data); +void callback_int(int data); +void callback_ptr(int *data); + +int i; +apply(callback_int, i); // TV(t) == int +apply(callback_ptr, &i); // TV(t) == int * +
+ +

In Deputy, the above code is well-typed. Note that apply can safely be +instantiated on two different types, but those types must be used +consistently for any particular call to apply. Note also that +you can use several distinct type variables if you give them different +names (i.e., change t to something else).

+ +

For practical reasons, Deputy requires that TV(t) is only +instantiated to types that can fit in a machine word, like an integer or +pointer--basically, anything that you were previously casting to/from a +void *.

+ +

Within a polymorphic function, you may not make any assumptions about +data whose type is a type variable. All you can do is copy this data to +other variables with the same type variable type. The body of +apply would look like this:

+ +
void apply(void (*fn)(TV(t) data), TV(t) data) { + fn(data); +} +
+ +

This call to fn is only legal because data and the +first argument to fn both have type TV(t).

+ + +

7.2. Polymorphic Structures

+ +

You can also use polymorphism within a structure. In our current +implementation, structures may only have one type variable, which must be +named t. (These restrictions will be lifted in a future +version.) When using such a structure, you must use the annotation +TP to specify the type on which it is instantiated. For +example:

+ +
struct list { + TV(t) data; + struct list TP(TV(t)) *next; +}; + +struct list TP(int) *int_list; +struct list TP(int *) *ptr_list; + +int i; +int_list->next->data = i; // data has type int +ptr_list->next->data = &i; // data has type int * +
+ +

Here we declare two lists, one a list of int and one a list +of int *, as specified by TP. Within the declaration of +struct list, we say that this type is the type of the +data element, and that the next pointer points to +another list cell that is instantiated on the same type.

+ +

Note that the TP annotation goes on the structure type itself, +not the pointer; therefore, it appears before the * when +declaring a pointer to a polymorphic structure.

+ +
+ + +

8. Special Functions

+ +

Several standard C functions require special handling. This section +discusses the annotations used to identify those functions.

+ + +

8.1. Allocators

+ +

Deputy requires the programmer to annotate any functions that behave as +allocators or deallocators. These annotations identify arguments that +hold the size of the requested block as well as arguments that are +(directly) deallocated by the function. These annotations allow Deputy to +make sense of the void * types typically used for allocator +results and deallocator arguments.

+ +

The standard allocation functions are annotated as follows:

+ +
void * (DALLOC(size) malloc)(int size); +void * (DREALLOC(p, size) realloc)(void *p, int size); +void (DFREE(p) free)(void *p); +
+ +

First note that these annotations are placed on the function type using +the parenthetical syntax shown above. The DALLOC annotation takes +an expression indicating the size of the allocated block. (This argument +is a full expression, so calloc can be annotated by multiplying +the two arguments.) The DREALLOC annotations indicates the name +of the argument that is freed as well as the size of the reallocated +block, as above. The DFREE annotation indicates the name of the +argument that is freed.

+ +

Deputy currently does not ensure that the allocated block is zeroed. +This feature will soon be implemented for malloc, but it is +difficult to implement for realloc, since Deputy does not know +the size of the original allocated block. Changing the implementations of +malloc and realloc may be appropriate in the long +run.

+ + +

8.2. Memset and Friends

+ +

Functions such as memset, memcmp, and memcpy +have annotations similar to the allocator annotations above. Deputy has +special handling for these functions that allows many different types to +be used with the void * arguments as long as they are used +appropriately.

+ +

These annotations are subject to change soon and are therefore not +documented here. Examples can be found in the header files!

+ +
+ + +

9. Contact Information

+ +

We welcome any and all feedback regarding Deputy. If you have any +comments, suggestions, or bug reports, please send them to the Deputy team. + +

+ + diff --git a/doc/www/quickref.html b/doc/www/quickref.html new file mode 100644 index 0000000..04a5d1c --- /dev/null +++ b/doc/www/quickref.html @@ -0,0 +1,322 @@ + + + +Deputy Quick Reference + + + + +
+ +

Deputy Quick Reference

+ +
+ +

Getting Started

+ +

Download and install one of the available packages. If you get the +source distribution, do the usual ./configure, make, and +make install. (Try running make quicktest +to verify that the build succeeded.) You can now run the deputy +executable, which uses the same command-line options as gcc.

+ +

Run deputy on a C file in place of gcc. (In many +cases, this is as simple as changing CC in your makefile.) You +will probably see a number of type errors, beginning with a series of +warnings that suggest annotations. You can fix these errors by inserting +annotations listed below. Hairier parts of the code can be skipped using +the "trusted" annotations below. Once your file compiles, you'll need to +use deputy for the linker as well so that Deputy can link in its +(small) runtime library.

+ +

Now run and test your program. You will probably see some run-time +errors due to insufficient or incorrect annotations. Fix these errors and +you're good to go!

+ +
+ +

Pointer and Array Bounds

+ +

Pointer annotations are placed after the * in the pointer +type. Array annotations are placed immediately before the name of the +array, using parentheses. For example, the COUNT(42) annotation +can be placed as follows:

+ +
int * COUNT(42) ptr; +int (COUNT(42) array)[]: +
+ +

The basic Deputy bounds annotations are given in the following table. +The type checker assumes that every pointer and array in the program is +annotated with one of these annotations. Deputy will provide a suitable +default for each unannotated pointer.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
BOUND(b, e)
+BND(b, e)		The pointer is either null or it points to an array of objects of the +base type with bounds given by the local expressions b and +e. This pointer must be aligned with respect to both b +and e. The keyword __this refers to the variable or +expression to which this type is attached. To use automatic bounds, +specify __auto in place of b and/or e.
COUNT(n) +CT(n)The pointer is either null or it points to an array of n +objects of the base type. Equivalent to BOUND(__this, __this + +n). This annotation is the default for arrays with declared size +n.
SAFEThe pointer is either null or it bounds to a single object of the base +type. Equivalent to COUNT(1) and BOUND(__this, __this + +1). This annotation is the default for global variables, structure +fields, and function arguments and return values.
SNTThis pointer is used only for comparison and never for dereference. +Mostly equivalent to COUNT(0) and BOUND(__this, __this), +but currently carries an extra attribute that allows it to be incremented +and decremented freely.
SEQA shorthand for BOUND(__auto, __auto). Deputy will insert +automatic bounds variables for both bounds. Note that this annotation +must be used with care on any externally-visible data! This annotation is +the default for local variables.
FSEQA shorthand for BOUND(__this, __auto). Deputy will insert +an automatic bounds variable for the upper bound, and the lower bound is +assumed to be the pointer itself. As with SEQ, this annotation +must be used with care on any externally-visible data!
+ +

You may also indicate whether a pointer is non-null with the following +annotations:

+ + + + + + + + + + + + + +
NONNULLIndicates that a pointer must be non-null.
OPTIndicates that a pointer may be null. This annotation is the default +on all pointers.
+ +
+ +

Null-Terminated Pointers and Arrays

+ +

In addition to the bounds annotations provided above, you may also +indicate that a pointer or array is null-terminated by using one of the +following annotations:

+ + + + + + + + + + + + + +
NTIndicates that the upper bound of the pointer (as given by +BOUND or one of its relatives) is the beginning of a +null-terminated sequence of elements.
NTSA shorthand for NT COUNT(0)--think "null-terminated string". +This annotation is often used for char * pointers that represent +null-terminated strings. Note that because it includes a COUNT +annotation, it is provided in place of (rather than in addition to) the +bounds annotations in the previous section.
+ +

There are two operations that allow you to convert between +null-terminated and regular pointers:

+ + + + + + + + + + + + + +
NTDROP(e)Converts a null-terminated pointer e with type NT BOUND(b, +e) into a standard pointer with bounds BOUND(b, e). Because +the null terminator lies outside of the specified bounds, this operation +is safe; however, the null element (and any other elements outside the +specified bounds) may no longer be accessible.
NTEXPAND(e)Expands the upper bound of e up to the null element. For +example, if e has type NT COUNT(0) but points to a +string with 5 characters (plus a null character), then +NTEXPAND(e) will have type NT COUNT(5). This operation +is often used immediately before an NTDROP in order to preserve +access to all elements except for the null terminator itself.
+ +
+ +

Union Annotations

+ +

Unions are annotated by indicating when each field is active. For +example:

+ +
struct foo { + int tag; + union foo { + int *p WHEN(tag == 0); + int n WHEN(tag == 1); + } u; +}; +
+ +

Note that the annotation is placed after the name of each field, not on +the type of each field. The annotation is defined as follows:

+ + + + + + + + +
WHEN(e)Indicates that the associated union field is selected when the local +expression e evaluates to a non-zero value. The expression +e is local with respect to the union itself, so it can refer to +other names at the same level as the union. At most one field may be +selected at any given time.
+ +
+ +

Special Function Annotations

+ +

Deputy provides annotations that identify several common C functions +that require special treatment. These annotations are placed on the +function type by writing them before the name of the function, in +parentheses. For example:

+ +

void * (DALLOC(sz) malloc)(size_t sz);

+ +

These annotations are as follows:

+ + + + + + + + + + + + + + + + + + + + + + + +
DALLOC(e)This annotation indicates a function that acts as an allocator. The +expression e indicates the size of the allocated block (in bytes) +in terms of the function's formal parameters. The type of the allocation +is determined by the pointer to which the result of this call is assigned, +and the size is used to check (or set, in the case of automatic bounds) +the bounds of the resulting pointer.
DFREE(p)This annotation indicates a function that frees memory. The argument +p is the name of the formal parameter for the pointer being +freed.
DREALLOC(p, e)This annotation indicates a function that acts as a reallocator; the +arguments p and e function as specified in the previous +two annotations. Note that newly-allocated portions of the array are +not automatically zeroed by Deputy.
+DMEMCPY(x, y, z)
+DMEMSET(x, y, z)
+DMEMCMP(x, y, z) +		These annotations specify that the function behaves like +memcpy, memset, or memcmp. The three arguments +x, y, and z are meant to indicate the indices +of the arguments that behave like the corresponding arguments for the +original function; however, they are ignored by the current +implementation. When Deputy sees a call to a function with one of these +annotations, it verifies the bounds of the pointers passed to these +functions, and when data is being written, it verifies that the data +written has the correct type. In the case of memset, we allow +arrays containing pointers to be initialized to zero (assuming, of course, +that those pointers are not non-null).
+ +
+ +

Trusted Annotations

+ +

Deputy allows the user to trust code in cases where Deputy annotations +cannot easily be provided. There are several ways to indicate trusted +code:

+ +

First, you may specify trusted blocks of code. If you place +TRUSTEDBLOCK after the opening brace of a block, Deputy will not +attempt to check any code contained therein. If this block reads +variables with automatic bounds, Deputy will adjust the code as necessary +to allow the read to occur. However, writes to variables with automatic +bounds are not allowed.

+ +

Second, you may use the TRUSTED annotation, which can appear +in three places:

+ +
    + +
  • On a pointer, the TRUSTED annotation causes Deputy to trust +any casts into or out of that pointer as well as any arithmetic operations +on that pointer. When casting from a trusted pointer to a non-trusted +pointer, the bounds on the non-trusted pointer must be given explicitly. +(Automatic bounds can still be used as long as they are explicitly +requested with an annotation such as SEQ.)
    • + +
  • On a union, the TRUSTED annotation causes Deputy to suppress +any tag checks assocated with that union. This annotation can be placed +after the union keyword or after the closing brace of the +union.
    • + +
  • On a function, the TRUSTED annotation tells Deputy not to +process the local variables or the function body. As with +TRUSTEDBLOCK, Deputy will adjust reads of variables with +automatic bounds appropriately but will disallow writes to such +variables.
    • + +
+ +

For convenience, you can use the macro TC(e) to convert a +pointer expression e to a trusted version of the same pointer. +This macro is very useful for performing trusted casts from one pointer +type to another.

+ +
+ + diff --git a/include/.cvsignore b/include/.cvsignore new file mode 100755 index 0000000..9a8f837 --- /dev/null +++ b/include/.cvsignore @@ -0,0 +1 @@ +gcc_* \ No newline at end of file diff --git a/include/ccuredport.h b/include/ccuredport.h new file mode 100755 index 0000000..5da5515 --- /dev/null +++ b/include/ccuredport.h @@ -0,0 +1,26 @@ +//Use this file with "ccured --listnonsafe" to hide Deputy's annotations +//from CCured. +// "ANNOTATED" means that "ccured --listnonsafe" should suppress the warning, +// since this code is already Deputy-ready. + +#ifdef CCURED +# define ANNOTATED __attribute__((annotated)) +# define BND(b,e) ANNOTATED +# define COUNT(c) ANNOTATED __COUNT(c) +# define SIZE(c) ANNOTATED +# define SAFE ANNOTATED __SAFE +# define SNT ANNOTATED +# define NT ANNOTATED +# define NTS ANNOTATED +# define NULLTERM ANNOTATED +# define POLY ANNOTATED +# define TRUSTED ANNOTATED +# define TC(x) __trusted_cast(x) +# define WHEN(c) ANNOTATED + +# define DMEMSET(x,y,z) +# define DMEMCPY(x,y,z) +# define DMEMCMP(x,y,z) +# define DALLOC(x) +#endif //ndef DEPUTY + diff --git a/include/deputy/annots.h b/include/deputy/annots.h new file mode 100644 index 0000000..5b6f71a --- /dev/null +++ b/include/deputy/annots.h @@ -0,0 +1,73 @@ +#ifndef ANNOT_H +#define ANNOT_H + +#define DEPUTY 1 + +#define BOUND(lo, hi) __attribute__((bounds((lo),(hi)))) +#define COUNT(n) BND(__this, __this + (n)) +#define SIZE(n) COUNT(n) +#define SAFE COUNT(1) +#define SNT COUNT(0) __attribute__((sentinel)) + +#define BND(lo, hi) BOUND(lo, hi) +#define CT(n) COUNT(n) +#define SZ(n) SIZE(n) + +#define EFAT BND(__this, __auto) +#define FAT BND(__auto, __auto) + +#define NULLTERM __attribute__((nullterm)) +#define NT NULLTERM +#define NTS NULLTERM COUNT(0) +#define NTC(n) NULLTERM COUNT(n-1) + +#define NTDROPATTR __attribute__((ntdrop)) +#define NTEXPANDATTR __attribute__((ntexpand)) + +#define NULLABLE +#define OPT NULLABLE +#define NONNULL __attribute__((nonnull)) + +#define TRUSTED __attribute__((trusted)) +#define TRUSTEDBLOCK __blockattribute__((trusted)) + +#define POLY TRUSTED + +#define COPYTYPE __attribute__((copytype)) + +//specifies that Deputy's typechecker (but not optimizer) should assume +//that this lvalue is constant. (unsound) +#define ASSUMECONST __attribute__((assumeconst)) + +#define WHEN(e) __attribute__((when(e))) + +#define DMEMCPY(x, y, z) __attribute__((dmemcpy((x),(y),(z)))) +#define DMEMSET(x, y, z) __attribute__((dmemset((x),(y),(z)))) +#define DMEMCMP(x, y, z) __attribute__((dmemcmp((x),(y),(z)))) + +#define DALLOC(x) __attribute__((dalloc(x))) +#define DREALLOC(x, y) __attribute__((drealloc((x), (y)))) +#define DFREE(x) __attribute__((dfree(x))) + +#define DVARARG(x) __attribute__((dvararg(x))) +#define DPRINTF(x) DVARARG(printf(x)) + +#define NTDROP(x) ((void * COUNT(0) NTDROPATTR COPYTYPE)(x)) +#define NTEXPAND(x) ((void * COUNT(0) NTEXPANDATTR COPYTYPE)(x)) + +#define TC(x) ((void * TRUSTED COPYTYPE)(x)) + +#define TVATTR(x) __attribute__((tyvar(x))) +#define TPATTR(x) __attribute__((typaram(sizeof(x)))) + +#define TV(x) void * TVATTR(x) +#define TP(x) TPATTR(x) + +//Deputy will replace this with the number of checks that were inserted into +//the file. Small regression tests use this to ensure that all checks that +//that should be optimized away actually are. Since we regularly change the +//way checks are implemented, this is really only useful for small tests with +//few or no checks added. +extern const int DEPUTY_NUM_CHECKS_ADDED; + +#endif // ANNOT_H diff --git a/include/deputy/checks.h b/include/deputy/checks.h new file mode 100755 index 0000000..14a921a --- /dev/null +++ b/include/deputy/checks.h @@ -0,0 +1,291 @@ +// Runtime checks for Deputy programs. + +// This file is included in deputy_lib and also at the start of every +// Deputy output file. Before this file is included you must define +// DEPUTY_ALWAYS_STOP_ON_ERROR if you want to optimize the checks. + +// Note "volatile": We currently use volatile everywhere so that these +// checks work on any kind of pointer. In the future, we may want to +// investigate the performance impact of this annotation in the common +// (non-volatile) case. + +// Use inline even when not optimizing for speed, since it prevents +// warnings that would occur due to unused static functions. +#ifdef DEPUTY_ALWAYS_STOP_ON_ERROR + #define INLINE inline __attribute__((always_inline)) +#else + #define INLINE inline +#endif + +#define __LOCATION__ __FILE__, __LINE__, __FUNCTION__ +#define __LOCATION__FORMALS const char* file, int line, const char* func +#define __LOCATION__ACTUALS file, line, func + +#ifndef asmlinkage +#define asmlinkage __attribute__((regparm(0))) +#endif + +#ifndef noreturn +#define noreturn __attribute__((noreturn)) +#endif + +#if defined(__KERNEL__) && defined(DEPUTY_KERNEL_COVERAGE) +INLINE static +unsigned int read_pc() +TRUSTED { + unsigned int pc; + + asm("movl %%ebp, %0" : "=r"(pc)); + + return *((unsigned int *)pc + 1); +} + +extern void checkBitArrayAdd(unsigned int addr); +#endif + +extern asmlinkage +void deputy_fail_mayreturn(const char *check, const char *text, + __LOCATION__FORMALS); + +extern asmlinkage noreturn +void deputy_fail_noreturn(const char *check, const char *text, + __LOCATION__FORMALS); + +extern asmlinkage noreturn +void deputy_fail_noreturn_fast(void); + +/* Search for a NULL starting at e and return its index */ +extern asmlinkage +int deputy_findnull(const void *e1, unsigned int sz); + +//Define deputy_memset, which we use to initialize locals +//FIXME: We should set __deputy_memset = __builtin_memset to take advantage +//of optimizations. How do we do that in a portable way? +#if defined(memset) && !defined(IN_DEPUTY_LIBRARY) +#define __deputy_memset memset +#else +extern asmlinkage +void *__deputy_memset(void *s, int c, unsigned int n); +#endif + +#if defined(DEPUTY_FAST_CHECKS) + #define deputy_fail(x, y, z) deputy_fail_noreturn_fast() +#elif defined(DEPUTY_ALWAYS_STOP_ON_ERROR) + #define deputy_fail deputy_fail_noreturn +#else + #define deputy_fail deputy_fail_mayreturn +#endif + + +/* Check that there is no NULL between e .. e+len-1. "bytes" is the size of + * an element */ +INLINE static asmlinkage +int deputy_nullcheck(const volatile void *e, unsigned int len, + unsigned int bytes) { +#define NULLCHECK(type) \ + do { \ + type *p1 = (type*) e; \ + type *p2 = ((type*) e) + len; \ + while (p1 < p2 && *p1 != 0) { \ + p1++; \ + } \ + success = (p1 >= p2); \ + } while (0) + + int success = 0; + + switch (bytes) { + case 1: + NULLCHECK(char); + break; + case 2: + NULLCHECK(short); + break; + case 4: + NULLCHECK(long); + break; + default: + deputy_fail("Bug: Invalid byte size for nullcheck.\n", + "", __LOCATION__); + } + return success; +#undef NULLCHECK +} + +#if defined(__KERNEL__) && defined(KRECOVER) && !defined(NO_INJECTION) +extern int kr_failure_injected(void); +#define INJECTED_FAILURE() (kr_failure_injected()) +#else +#define INJECTED_FAILURE() 0 +#endif + +// what : a boolean that ought to be true +// checkName: the name of the check +// checkWhat: a string that explains what goes wrong +#if defined(__KERNEL__) && defined(DEPUTY_KERNEL_COVERAGE) +#define DEPUTY_ASSERT_TEXT(what,text,checkName)\ + checkBitArrayAdd(read_pc());\ + if (!(what) || INJECTED_FAILURE()) { \ + deputy_fail(checkName, text, __LOCATION__ACTUALS); \ + } + +#define DEPUTY_ASSERT(what, checkName) \ + checkBitArrayAdd(read_pc());\ + DEPUTY_ASSERT_TEXT(what, text, checkName) +#else +#define DEPUTY_ASSERT_TEXT(what, text, checkName) \ + if (!(what) || INJECTED_FAILURE()) { \ + deputy_fail(checkName, text, __LOCATION__ACTUALS); \ + } + +#define DEPUTY_ASSERT(what, checkName) \ + DEPUTY_ASSERT_TEXT(what, text, checkName) +#endif + +INLINE static void CNonNull(const volatile void* p, + const char *text, __LOCATION__FORMALS) { + DEPUTY_ASSERT(p != 0, "non-null check"); +} + +INLINE static void CEq(const volatile void* e1, const volatile void* e2, + const char *why, + const char *text, __LOCATION__FORMALS) { + DEPUTY_ASSERT(e1 == e2, why); +} + +INLINE static void CMult(int i1, int i2, + const char *text, __LOCATION__FORMALS) { + DEPUTY_ASSERT((i2 % i1) == 0, "alignment check"); +} + +/* Check that p + sz * e does not overflow that remains within [lo..hi). It + * is guaranteed on input that lo <= p <= hi, with p and h aligned w.r.t. lo + * and size sz. */ +INLINE static void CPtrArith(const volatile void* lo, const volatile void* hi, + const volatile void* p, int e, unsigned int sz, + const char *textlo, const char *texthi, + __LOCATION__FORMALS) { + if (e >= 0) { + DEPUTY_ASSERT_TEXT(e <= (hi - p) / sz, texthi, "upper bound check"); + } else { + DEPUTY_ASSERT_TEXT(-e <= (p - lo) / sz, textlo, "lower bound check"); + } +} + +INLINE static void CPtrArithNT(const volatile void* lo, const volatile void* hi, + const volatile void* p, int e, unsigned int sz, + const char *textlo, const char *texthi, + __LOCATION__FORMALS) { + if (e >= 0) { + unsigned int len = (hi - p) / sz; + if (e > len) { + DEPUTY_ASSERT_TEXT(deputy_nullcheck(hi, e - len, sz), + texthi, "nullterm upper bound check"); + } + } else { + DEPUTY_ASSERT_TEXT(-e <= (p - lo) / sz, textlo, "lower bound check"); + } +} + +INLINE static void CPtrArithAccess(const volatile void* lo, + const volatile void* hi, + const volatile void* p, + int e, unsigned int sz, + const char* textlo, const char *texthi, + __LOCATION__FORMALS) { + if (e >= 0) { + DEPUTY_ASSERT_TEXT(e + 1 <= (hi - p) / sz, texthi, "upper bound check"); + } else { + DEPUTY_ASSERT_TEXT(-e <= (p - lo) / sz, textlo, "lower bound check"); + } +} + +INLINE static void CLeqInt(unsigned int e1, unsigned int e2, + const char* why, + const char* text, __LOCATION__FORMALS) { + DEPUTY_ASSERT(e1 <= e2, why); +} + +INLINE static void CLeq(const volatile void* e1, const volatile void* e2, + const char* why, + const char* text, __LOCATION__FORMALS) { + DEPUTY_ASSERT(e1 <= e2, why); +} + +/* Used to set the upped bounds of an NT string to e1, when we know that e2 + * is a safe upper bound. Test that e1 <= e2 OR there is no NULL between + * e2...e1-1. */ +INLINE static void CLeqNT(const volatile void* e1, const volatile void* e2, + unsigned int sz, const char* why, + const char* text, __LOCATION__FORMALS) { + if (e1 > e2) { + DEPUTY_ASSERT(deputy_nullcheck(e2, (e1 - e2) / sz, sz), why); + } +} + +INLINE static void CNullOrLeq(const volatile void* e, + const volatile void* e1, const volatile void* e2, + const char* why, + const char* text, __LOCATION__FORMALS) { + if (e) { + DEPUTY_ASSERT(e1 <= e2, why); + } +} + +/* Check that e is NULL, or e1 <= e2, or there is no NULL from e2 to e1 */ +INLINE static void CNullOrLeqNT(const volatile void* e, + const volatile void* e1, + const volatile void* e2, + unsigned int sz, const char* why, + const char* text, __LOCATION__FORMALS) { + if (e && e1 > e2) { + DEPUTY_ASSERT(deputy_nullcheck(e2, (e1 - e2) / sz, sz), why); + } +} + + +INLINE static void CWriteNT(const volatile void* p, + const volatile void* hi, + int what, unsigned int sz, + const char* text, __LOCATION__FORMALS) { + if (p == hi) { + int isNull = 0; + switch (sz) { + case 1: isNull = (*((const volatile char *) p) == 0); break; + case 2: isNull = (*((const volatile short *) p) == 0); break; + case 4: isNull = (*((const volatile int *) p) == 0); break; + } + DEPUTY_ASSERT(!isNull || what == 0, "nullterm write check"); + } +} + +INLINE static void CNullUnionOrSelected(const volatile void* p, + unsigned int size, + int sameFieldSelected, + const char* text, __LOCATION__FORMALS) { + if (!sameFieldSelected) { + const volatile char* pp = (const volatile char*)p; + const volatile char* pend = pp + size; + while (pp < pend) { + DEPUTY_ASSERT(0 == *pp++, "null union check"); + } + } +} + +INLINE static void CSelected(int what, + const char* text, __LOCATION__FORMALS) { + if (!(what)) { + deputy_fail("check that union field is selected", + text, __LOCATION__ACTUALS); } +} + +INLINE static void CNotSelected(int what, + const char* text, __LOCATION__FORMALS) { + if ((what)) { + deputy_fail("check that union field is not selected", + text, __LOCATION__ACTUALS); } +} + +#define deputy_max(x, y) ((x) > (y) ? (x) : (y)) + +#undef DEPUTY_ASSERT diff --git a/include/deputy/itaint.patch.h b/include/deputy/itaint.patch.h new file mode 100644 index 0000000..1cbc700 --- /dev/null +++ b/include/deputy/itaint.patch.h @@ -0,0 +1,10 @@ +__inline static int atoi(char const *__nptr) __attribute__((CTaint(*$1,$0))); +long atol(const char *nptr) __attribute__((CTaint(*$1,$0))); +long long atoll(const char *nptr) __attribute__((CTaint(*$1,$0))); +long long atoq(const char *nptr) __attribute__((CTaint(*$1,$0))); +int fscanf(void *, const char *, ...) __attribute__((ScanTaint(2))); +int scanf(const char *, ...) __attribute__((ScanTaint(1))); +int _IO_getc(void *) __attribute__((Taint($0,1,1))); +int fgetc(void *) __attribute__((Taint($0,1,1))); +char fgets(char *,int,void *) __attribute__((Taint(*$1,1,$2))); +unsigned int read(int,void *,unsigned int) __attribute__((Taint(*$2,1,$3))); diff --git a/include/deputy/lwcalls.h b/include/deputy/lwcalls.h new file mode 100644 index 0000000..c4abcc0 --- /dev/null +++ b/include/deputy/lwcalls.h @@ -0,0 +1,81 @@ +/* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh + * Jagannathan, and Stephen Weeks. + * + * MLton is released under a BSD-style license. + * See the file MLton-LICENSE for details. + */ + +/* Can't use _TYPES_H_ because MSVCRT uses it. So, we use _MLTON_TYPES_H_. */ + +#ifndef _MLTON_TYPES_H_ +#define _MLTON_TYPES_H_ + +/* We need these because in header files for exported SML functions, types.h is + * included without platform.h. + */ +#ifndef _ISOC99_SOURCE +#define _ISOC99_SOURCE +#endif +#if defined(_AIX) || (defined(__hpux__) || defined (__OpenBSD__)) +#include +#elif (defined (__sun__)) +#include +#else +#include +#endif + +typedef int8_t Int8; +typedef int16_t Int16; +typedef int32_t Int32; +typedef int64_t Int64; +typedef char *Pointer; +typedef Pointer pointer; +typedef float Real32; +typedef double Real64; +typedef uint8_t Word8; +typedef uint16_t Word16; +typedef uint32_t Word32; +typedef uint64_t Word64; + +typedef Int8 WordS8; +typedef Int16 WordS16; +typedef Int32 WordS32; +typedef Int64 WordS64; + +typedef Word8 WordU8; +typedef Word16 WordU16; +typedef Word32 WordU32; +typedef Word64 WordU64; + +/* !!! this stuff is all wrong: */ +typedef Int32 Int; +typedef Real64 Real; +typedef Word8 Char; +typedef Word32 Word; +typedef Int64 Position; + +typedef Int Bool; +typedef Word Cpointer; +typedef Word Cstring; +typedef Word CstringArray; +typedef Word Dirstream; +typedef Int Fd; +typedef Word Flag; +typedef Word Gid; +typedef Word Mode; +typedef Word NullString; +typedef Int Pid; +typedef Int Resource; +typedef Word Rlimit; +typedef Int Signal; +typedef Int Size; +typedef Int Speed; +typedef Int Ssize; +typedef Int Status; +typedef Int Syserror; +typedef Pointer Thread; +typedef Word Uid; + +#endif /* _MLTON_TYPES_H_ */ + +void process_instrs (Pointer x0, Int32 x1, Int32 x2); diff --git a/include/deputy/sml_instrumenter.h b/include/deputy/sml_instrumenter.h new file mode 100644 index 0000000..0daa90f --- /dev/null +++ b/include/deputy/sml_instrumenter.h @@ -0,0 +1,516 @@ + +#ifndef _SML_INSTRUMENTER_H_ +#define _SML_INSTRUMENTER_H_ + +#include + +typedef unsigned int u32; + + +/* XXX: Add codes for each instr type, interpret in SML code */ +#define INSTR_WIDTH 15 +#define INSTR_MAX 2200000 + +#define ASSIGNBASIC 0 +#define ASSIGNBOP 10 +#define ASSIGNUOP 20 +#define ASSIGNCAST 30 +#define RETBASIC 40 +#define RETBOP 50 +#define RETUOP 60 +#define RETVOID 70 +#define IFBASIC 80 +#define IFBOP 90 +#define IFUOP 100 +#define SWITCHBASIC 110 +#define SWITCHBOP 120 +#define SWITCHUOP 130 + +#define PUSHARG 140 +#define POPARG 150 +#define FUNSTART 160 +#define RETPOP 170 +#define RETNORET 180 + +#define UNREGLOCAL 190 + +#define TAINT 200 +#define CONDT 210 + +#define CLEQCODE 220 + +#define CLEQSUM 230 +#define CSUMLEQ 240 + +struct funInstrList { + u32 *instrs; + u32 next; + u32 max; +}; + +#define BOP_PLUSA 0 +#define BOP_PLUSPI 1 +#define BOP_INDEXPI 2 +#define BOP_MINUSA 3 +#define BOP_MINUSPI 4 +#define BOP_MINUSPP 5 +#define BOP_MULT 6 +#define BOP_DIV 7 +#define BOP_MOD 8 +#define BOP_SHIFTL 9 +#define BOP_SHIFTR 10 +#define BOP_LT 11 +#define BOP_GT 12 +#define BOP_LE 13 +#define BOP_GE 14 +#define BOP_EQ 15 +#define BOP_NE 16 +#define BOP_BAND 17 +#define BOP_BXOR 18 +#define BOP_BOR 19 +#define BOP_LAND 20 +#define BOP_LOR 21 + +#define UOP_NEG 0 +#define UOP_BNOT 1 +#define UOP_LNOT 2 + + +#ifndef IN_GLOB_STATE_C + +#define NULL (void *)0; +#define INLINE inline __attribute__((always_inline)) +//#define INLINE + +extern struct funInstrList fil; + +#define APPARGS1 u32 a1 +#define APPARGS2 APPARGS1, u32 a2 +#define APPARGS3 APPARGS2, u32 a3 +#define APPARGS4 APPARGS3, u32 a4 +#define APPARGS5 APPARGS4, u32 a5 +#define APPARGS6 APPARGS5, u32 a6 +#define APPARGS7 APPARGS6, u32 a7 +#define APPARGS8 APPARGS7, u32 a8 +#define APPARGS9 APPARGS8, u32 a9 +#define APPARGS10 APPARGS9, u32 a10 +#define APPARGS11 APPARGS10, u32 a11 +#define APPARGS12 APPARGS11, u32 a12 +#define APPARGS13 APPARGS12, u32 a13 +#define APPARGS14 APPARGS13, u32 a14 +#define APPARGS15 APPARGS14, u32 a15 + +#define FILLINSTR1 fil.instrs[ri] = a1 +#define FILLINSTR2 FILLINSTR1; fil.instrs[ri+1] = a2 +#define FILLINSTR3 FILLINSTR2; fil.instrs[ri+2] = a3 +#define FILLINSTR4 FILLINSTR3; fil.instrs[ri+3] = a4 +#define FILLINSTR5 FILLINSTR4; fil.instrs[ri+4] = a5 +#define FILLINSTR6 FILLINSTR5; fil.instrs[ri+5] = a6 +#define FILLINSTR7 FILLINSTR6; fil.instrs[ri+6] = a7 +#define FILLINSTR8 FILLINSTR7; fil.instrs[ri+7] = a8 +#define FILLINSTR9 FILLINSTR8; fil.instrs[ri+8] = a9 +#define FILLINSTR10 FILLINSTR9; fil.instrs[ri+9] = a10 +#define FILLINSTR11 FILLINSTR10; fil.instrs[ri+10] = a11 +#define FILLINSTR12 FILLINSTR11; fil.instrs[ri+11] = a12 +#define FILLINSTR13 FILLINSTR12; fil.instrs[ri+12] = a13 +#define FILLINSTR14 FILLINSTR13; fil.instrs[ri+13] = a14 +#define FILLINSTR15 FILLINSTR14; fil.instrs[ri+14] = a15 + +#define FUNINSTRLISTAPP(N) \ +INLINE static void funInstrListApp##N(APPARGS##N)\ +{\ + int ri;\ + if (fil.next == fil.max) {\ + process_instrs(fil.instrs,fil.max,INSTR_WIDTH);\ + fil.next = 0;\ + }\ + ri = fil.next * INSTR_WIDTH;\ + FILLINSTR##N;\ + fil.next++;\ + return;\ +} + +FUNINSTRLISTAPP(1); +FUNINSTRLISTAPP(2); +FUNINSTRLISTAPP(3); +FUNINSTRLISTAPP(4); +FUNINSTRLISTAPP(5); +FUNINSTRLISTAPP(6); +FUNINSTRLISTAPP(7); +FUNINSTRLISTAPP(8); +FUNINSTRLISTAPP(9); +FUNINSTRLISTAPP(10); +FUNINSTRLISTAPP(11); +FUNINSTRLISTAPP(12); +FUNINSTRLISTAPP(13); +FUNINSTRLISTAPP(14); +FUNINSTRLISTAPP(15); + +/* +INLINE static void +funInstrListPush() +{ + struct funInstrList *new = malloc(sizeof(struct funInstrList)); + new->instrs = malloc(100000 * sizeof(u32) * INSTR_WIDTH); + new->max = 100000; + new->next = 0; + new->lnext = fil_stack; + fil_stack = new; + return; +} + +INLINE static void +funInstrListPop() +{ + struct funInstrList *tmp = fil_stack; + if (tmp) { + if (tmp->instrs) { + process_instrs(tmp->instrs, tmp->next, INSTR_WIDTH); + free(tmp->instrs); + } + fil_stack = tmp->lnext; + free(tmp); + } + return; +} +*/ + +#define BOP_PLUSA 0 +#define BOP_PLUSPI 1 +#define BOP_INDEXPI 2 +#define BOP_MINUSA 3 +#define BOP_MINUSPI 4 +#define BOP_MINUSPP 5 +#define BOP_MULT 6 +#define BOP_DIV 7 +#define BOP_MOD 8 +#define BOP_SHIFTL 9 +#define BOP_SHIFTR 10 +#define BOP_LT 11 +#define BOP_GT 12 +#define BOP_LE 13 +#define BOP_GE 14 +#define BOP_EQ 15 +#define BOP_NE 16 +#define BOP_BAND 17 +#define BOP_BXOR 18 +#define BOP_BOR 19 +#define BOP_LAND 20 +#define BOP_LOR 21 + +#define UOP_NEG 0 +#define UOP_BNOT 1 +#define UOP_LNOT 2 + +/************** Printing */ + +static void print_bop(unsigned int bop) +{ + switch(bop) { + case BOP_PLUSA: + case BOP_PLUSPI: + case BOP_INDEXPI: printf(" + "); break; + case BOP_MINUSA: + case BOP_MINUSPI: + case BOP_MINUSPP: printf(" - "); break; + case BOP_MULT: printf(" * "); break; + case BOP_DIV: printf(" / "); break; + case BOP_MOD: printf(" \% "); break; + case BOP_SHIFTL: printf(" << "); break; + case BOP_SHIFTR: printf(" >> "); break; + case BOP_LT: printf(" < "); break; + case BOP_GT: printf(" > "); break; + case BOP_LE: printf(" <= "); break; + case BOP_GE: printf(" >= "); break; + case BOP_EQ: printf(" == "); break; + case BOP_NE: printf(" != "); break; + case BOP_BAND: printf(" & "); break; + case BOP_BXOR: printf(" ^ "); break; + case BOP_BOR: printf(" | "); break; + case BOP_LAND: printf(" && "); break; + case BOP_LOR: printf(" || "); break; + default: printf(" ?? "); break; + } +} + +static void print_uop(unsigned int uop) +{ + switch(uop) { + case UOP_NEG: printf(" - "); break; + case UOP_BNOT: printf(" ~ "); break; + case UOP_LNOT: printf(" ! "); break; + default: printf(" ?? "); break; + } +} + + +#define VOIDARGS0 +#define VOIDARGS1 unsigned int a1 +#define VOIDARGS2 VOIDARGS1, unsigned int a2 +#define VOIDARGS3 VOIDARGS2, unsigned int a3 +#define VOIDARGS4 VOIDARGS3, unsigned int a4 +#define VOIDARGS5 VOIDARGS4, unsigned int a5 +#define VOIDARGS6 VOIDARGS5, unsigned int a6 +#define VOIDARGS7 VOIDARGS6, unsigned int a7 +#define VOIDARGS8 VOIDARGS7, unsigned int a8 +#define VOIDARGS9 VOIDARGS8, unsigned int a9 +#define VOIDARGS10 VOIDARGS9, unsigned int a10 +#define VOIDARGS11 VOIDARGS10, unsigned int a11 +#define VOIDARGS12 VOIDARGS11, unsigned int a12 +#define VOIDARGS13 VOIDARGS12, unsigned int a13 +#define VOIDARGS14 VOIDARGS13, unsigned int a14 +#define VOIDARGS15 VOIDARGS14, unsigned int a15 +#define VOIDARGS16 VOIDARGS15, unsigned int a16 +#define VOIDARGS17 VOIDARGS16, unsigned int a17 + +#define DINSTRFun(name, args) INLINE static void DINSTR_##name(VOIDARGS##args) + +INLINE static unsigned int +negate_bop(unsigned int bop) +{ + switch(bop) { + case BOP_LT: return BOP_GE; + case BOP_GT: return BOP_LE; + case BOP_LE: return BOP_GT; + case BOP_GE: return BOP_LT; + default: return bop; + } +} + + +/* +INLINE static in isNeg(struct exp *e) +{ + return (e != NULL) && (e->type == BASICTYP) && (e->e.basic->neg == 1); +} +*/ + +DINSTRFun(Assign,5) +{ + + funInstrListApp6(ASSIGNBASIC,a1,a2,a3,a4,a5); + return; +} + + +DINSTRFun(Bop,10) +{ + funInstrListApp11(ASSIGNBOP,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10); + return; +} + +DINSTRFun(Uop,6) +{ + funInstrListApp7(ASSIGNUOP,a1,a2,a3,a4,a5,a6); + return; +} + + +DINSTRFun(PushArg,4) +{ + funInstrListApp5(PUSHARG,a1,a2,a3,a4); + return; +} + +DINSTRFun(PopArg,1) +{ + funInstrListApp2(POPARG,a1); + return; +} + +DINSTRFun(UnRegLocal,3) +{ + funInstrListApp4(UNREGLOCAL,a1,a2,a3); + return; +} + +DINSTRFun(FunStart,1) +{ + funInstrListApp2(FUNSTART,a1); + return; +} + +/* a1 - symbolic op + * a2 - type(pointer/scalar) + * a3 - size + */ +DINSTRFun(RegisterField, 3) +{ + return; +} + +/* make sure memory range [p,p+sz] is all zero */ +INLINE static unsigned int +DINSTR_IsNull(unsigned int p, unsigned int sz) +{ + char *c = (char *)p; + int i = 0; + while(c < p + sz) { + if(*c) return 0; + c++; + } + return 1; +} + +/* + * a1 - start address + * a2 - element size + * a3 - number of elements. -1 => Nullterm + * a4 - pointer to element registration function + */ +DINSTRFun(RegisterArray, 4) +{ + return; +} + +DINSTRFun(Cast,5) +{ + funInstrListApp6(ASSIGNCAST,a1,a2,a3,a4,a5); + return; +} + +DINSTRFun(RetBasic,4) +{ + funInstrListApp5(RETBASIC,a1,a2,a3,a4); + return; +} + +DINSTRFun(RetBop,9) +{ + funInstrListApp10(RETBOP,a1,a2,a3,a4,a5,a6,a7,a8,a9); + return; +} + +DINSTRFun(RetUop,5) +{ + funInstrListApp6(RETUOP,a1,a2,a3,a4,a5); + return; +} + +DINSTRFun(RetVoid,0) +{ + funInstrListApp1(RETVOID); + return; +} + + +DINSTRFun(RetPop,5) +{ + funInstrListApp6(RETPOP,a1,a2,a3,a4,a5); + return; +} + +DINSTRFun(RetNoRet,1) +{ + funInstrListApp2(RETNORET,a1); + return; +} + +DINSTRFun(IfBasic,6) +{ + funInstrListApp7(IFBASIC,a1,a2,a3,a4,a5,a6); + return; +} + +DINSTRFun(IfBop,11) +{ + funInstrListApp12(IFBOP,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11); + return; +} + +DINSTRFun(IfUop,7) +{ + funInstrListApp8(IFUOP,a1,a2,a3,a4,a5,a6,a7); + return; +} + +DINSTRFun(SwitchBasic,5) +{ + funInstrListApp6(SWITCHBASIC,a1,a2,a3,a4,a5); + return; +} + +DINSTRFun(SwitchBop,10) +{ + funInstrListApp11(SWITCHBOP,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10); + return; +} + +DINSTRFun(SwitchUop,6) +{ + funInstrListApp7(SWITCHUOP,a1,a2,a3,a4,a5,a6); + return; +} + +DINSTRFun(CNonNull,4) {return;} +DINSTRFun(CEq,8) {return;} +DINSTRFun(CMult,8) {return;} +DINSTRFun(CPtrArith,17){return;} +DINSTRFun(CPtrArithNT,17) {return;} +DINSTRFun(CPtrArithAccess,17) {return;} +DINSTRFun(CLeqInt,8) {return;} +DINSTRFun(CLeq,10) +{ + funInstrListApp11(CLEQCODE,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10); + return; +} + +DINSTRFun(CLeqSum,14) +{ + funInstrListApp15(CLEQSUM,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14); + return; +} +DINSTRFun(CSumLeq,14) +{ + funInstrListApp15(CSUMLEQ,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14); + return; +} +DINSTRFun(CLeqNT,9) {return;} +DINSTRFun(CNullOrLeq,12) {return;} +DINSTRFun(CNullOrLeqNT,13) {return;} +DINSTRFun(CWriteNT,13) {return;} +DINSTRFun(CNullUnionOrSelected,8) {return;} +DINSTRFun(CSelected,4) {return;} +DINSTRFun(CNotSelected,4) {return;} + +DINSTRFun(taint,5) +{ + funInstrListApp6(TAINT,a1,a2,a3,a4,a5); + return; +} + +DINSTRFun(ctaint,8) +{ + funInstrListApp9(CONDT,a1,a2,a3,a4,a5,a6,a7,a8); + return; +} + +DINSTRFun(Argv,4) +{ + int argc = a1, i; + char **argv = a2; + + for(i = 0; i < argc; i++) + funInstrListApp6(TAINT,argv[i],1,strlen(argv[i])+1,a3,a4); + + return; +} + +INLINE static void DINSTR_init() +{ + fil.instrs = malloc(INSTR_MAX * sizeof(u32) * INSTR_WIDTH); + fil.max = INSTR_MAX; + fil.next = 0; + return; +} + +INLINE static void DINSTR_end() +{ + process_instrs(fil.instrs,fil.next,INSTR_WIDTH); + free(fil.instrs); + return; +} +INLINE static void DINSTR_nop() { return; } + +#endif +#endif /* _SML_INSTRUMENTER_H_ */ diff --git a/include/libc_patch.h b/include/libc_patch.h new file mode 100644 index 0000000..eed78be --- /dev/null +++ b/include/libc_patch.h @@ -0,0 +1,563 @@ +// glibc_patch.h +// +// This file contains the libc patch for Deputy. Annotations on the +// functions below will be patched into the libc headers when Deputy runs. +// In this file, void types are treated as wildcards, so any types that +// are irrelevant to the patch can be changed to void. + +// Typedefs for types that appear below but are irrelevant to the patch. + +typedef void __gid_t; +typedef void __uid_t; +typedef unsigned long size_t; +typedef signed long ssize_t; +typedef void socklen_t; +typedef void __socklen_t; +typedef void mode_t; +typedef void dev_t; +typedef void time_t; +typedef void FILE; +typedef void DIR; +typedef void __gnuc_va_list; + +#define __SSIZE_T ssize_t +#define __SIZE_T size_t +#define __SOCKLEN_T socklen_t +#define __MODE_T mode_t +#define __DEV_T dev_t + +#define __SOCKADDR_ARG struct sockaddr * +#define __CONST_SOCKADDR_ARG struct sockaddr * + +// Some handy macros for the types below. + +#define OPTSTRING char * NTS OPT +#define STRING char * NTS NONNULL +#define STRINGBUF(n) char * NT COUNT(n) NONNULL + +// assert.h + +void __assert_fail(const STRING __assertion, const STRING __file, + unsigned int __line, const STRING __function); + +#if __GNUC__ < 4 +void __assert(const STRING what, int exp, const STRING extra); +#endif + +// Darwin +void __assert_rtn(const char * NTS, const char * NTS, int, const char * NTS); +void __eprintf(const char * NTS, const char * NTS, unsigned, const char * NTS); + +// crypt.h + +STRING crypt(const STRING key, const char * COUNT(2) NONNULL salt); +void setkey(STRING key); + +// ctype.h + +// gcc 3.4.4 +extern const char (COUNT(256) _ctype_)[256]; + +// gcc 4 +const unsigned short * COUNT(256) * __ctype_b_loc(); +const signed int * COUNT(256) * __ctype_tolower_loc(); +const signed int * COUNT(256) * __ctype_toupper_loc(); + +// fcntl.h + +int open(const STRING file, int mode, ...); +int create(const STRING file, mode_t mode); + +// glob.h + +typedef struct { + char * NTS * COUNT(gl_pathc) NT gl_pathv; +} glob_t; + +int glob(const char * NTS pattern, int flags, + int errfunc(const char * NTS epath, int eerrno), + glob_t * SAFE pglob); + +// grp.h + +struct group { + char * NTS NONNULL gr_name; + char * NTS NONNULL gr_passwd; + char * NTS * NTS gr_mem; +}; + +struct group * SAFE getgrnam(const STRING name); +int initgroups(char * NTS __user, __gid_t __group); +int getgrouplist(char * NTS __user, __gid_t __group, __gid_t *__groups, + int *__ngroups); + +// malloc.h + +void * OPT (DALLOC(size) malloc)(int size); +void * OPT (DALLOC(nmemb * size) calloc)(size_t nmemb, size_t size); +void * OPT (DREALLOC(p, size) realloc)(void *p, size_t size); +void (DFREE(p) free)(void *p); + +// netdb.h + +struct hostent { + const char * NTS h_name; + char * NTS * NTS h_aliases; + // We ought to say h_length instead of 4 there + char * COUNT(4) * NTS h_addr_list; +}; + +struct netent { + char * NTS n_name; + char * NTS * NTS n_aliases; +}; + +struct servent { + char * NTS s_name; + char * NTS * NTS s_aliases; + char * NTS s_proto; +}; + +struct protoent { + char * NTS p_name; + char * NTS * NTS p_aliases; +}; + +struct rpcent { + char * NTS r_name; + char * NTS * NTS r_aliases; +}; + +struct sockaddr_un { + char (NT sun_path)[108]; +}; + +struct hostent *gethostbyaddr(const void * COUNT(__len), + __socklen_t __len, int); + +int gethostbyaddr_r(void * COUNT(__len) __addr, __socklen_t __len, + int __type, struct hostent *__result_buf, + char * COUNT(__buflen) __buf, size_t __buflen, + struct hostent * SAFE * SAFE __result, int *__h_errnop); + +struct hostent *gethostbyname(const STRING); +int gethostbyname_r(char * NTS __name, struct hostent *__result_buf, + char * COUNT(__buflen) __buf, size_t __buflen, + struct hostent * SAFE * SAFE __restrict, int *__h_errnop); + +struct netent *getnetbyname(const STRING); +struct protoent *getprotobyname(const STRING); + +struct servent *getservbyname (const STRING, const STRING); +struct servent *getservbyport (int, const STRING); + +int getservent_r(struct servent *__result_buf, + char * COUNT(__buflen) __buf, size_t __buflen, + struct servent **__result); + +int getservbyname_r(const STRING __name, const STRING __proto, + struct servent *__result_buf, + char * COUNT(__buflen) __buf, size_t __buflen, + struct servent **__result); + +int getservbyport_r(int __port, const STRING __proto, + struct servent *__result_buf, + char * COUNT(__buflne) __buf, size_t __buflen, + struct servent **__result); + +struct rpcent *getrpcbyname(const STRING); + +void herror(const STRING); + +int getaddrinfo(char * NTS __name, char * NTS __service, + struct addrinfo *__req, struct addrinfo **__pai); + +int getnameinfo(struct sockaddr *__sa, socklen_t __salen, + char * NT COUNT(__hostlen - 1) __host, socklen_t __hostlen, + char * NT COUNT(__servlen-1) __serv, + socklen_t __servlen, unsigned int __flags); + +// pwd.h + +struct passwd { + char * NTS NONNULL pw_name; + char * NTS NONNULL pw_passwd; + char * NTS NONNULL pw_comment; + char * NTS NONNULL pw_class; + char * NTS NONNULL pw_gecos; + char * NTS NONNULL pw_dir; + char * NTS NONNULL pw_shell; +}; + +struct passwd *getpwnam(const STRING); + +// socket.h + +int setsockopt(int __s, int __level, int __optname, + void const * COUNT(__optlen) optval, __SOCKLEN_T __optlen); + +// TODO: Indicate that optval is as big as *__optlen. +// TODO: Say something about __addrlen. +int getsockopt(int s, int level, int optname, + void* optval, __SOCKLEN_T * __optlen); +int bind(int sockfd, __CONST_SOCKADDR_ARG __my_addr, __SOCKLEN_T __addrlen); +int connect(int sockfd, __CONST_SOCKADDR_ARG __my_addr, __SOCKLEN_T __addrlen); +int accept(int s, __SOCKADDR_ARG __peer, __SOCKLEN_T *addrlen); +int getpeername(int s, __SOCKADDR_ARG __peer, __SOCKLEN_T *namelen); +int getsockname(int s, __SOCKADDR_ARG name, __SOCKLEN_T *namelen); + +__SSIZE_T sendto(int s, const void * NONNULL COUNT(len) msg, + __SIZE_T len, int flags, + __CONST_SOCKADDR_ARG __addr, __SOCKLEN_T __addr_len); + +__SSIZE_T recvfrom(int s, void * NONNULL COUNT(__n) buf, + __SIZE_T __n, int flags, + __SOCKADDR_ARG __addr, __SOCKLEN_T * __addr_len); + +__SSIZE_T recv(int s, void * NONNULL COUNT(__n) buf, + __SIZE_T __n, int flags); + +__SSIZE_T send(int s, const void * NONNULL COUNT(__n) msg, + __SIZE_T __n, int flags); + +// stat.h + +int chmod(const STRING __path, __MODE_T __mode); +int mkdir(const STRING __path, __MODE_T __mode); +int mkfifo(const STRING __path, __MODE_T __mode); +int stat(const STRING __path, struct stat * SAFE NONNULL __sbuf); + +int lstat(const STRING __path, struct stat * SAFE NONNULL __sbuf); +int _stat(const STRING __path, struct stat * SAFE NONNULL __sbuf); + +int __xstat(int __ver, const STRING __path, struct stat * SAFE NONNULL __sbuff); +int __lxstat(int __ver, const STRING __path, struct stat * SAFE NONNULL __sbuf); + +int mknod(const STRING __path, __MODE_T __mode, __DEV_T __dev); + +// stdio.h + +int (DPRINTF(2) fprintf) (FILE * SAFE __stream, char * NTS __format, ...); +int (DPRINTF(1) printf) (char * NTS __format, ...); +int (DPRINTF(2) sprintf) (char * TRUSTED __s, char * NTS __format, ...); +int (DPRINTF(3) snprintf)(char * NT COUNT(__maxlen-1) __s, size_t __maxlen, + char * NTS __restrict __format, ...); +int (DPRINTF(2) vfprintf)(FILE * SAFE __s, char * NTS __format, + __gnuc_va_list __arg); +int (DPRINTF(1) vprintf) (char * NTS __format, __gnuc_va_list __arg); +int (DPRINTF(2) vsprintf)(char * TRUSTED __s, __const char * NTS __format, + __gnuc_va_list __arg); + +int fscanf(FILE * SAFE NONNULL, const char * NTS, ...); +int scanf(const char * NTS, ...); +int sscanf(const char * TRUSTED, const char * NTS, ...); + +char * NTS fgets(char * NT COUNT(__n-1) NONNULL __s, int __n, + FILE * NONNULL __stream); + +FILE * fdopen(int filedes, const char * NTS NONNULL mode); + +int fputs(const char * NTS NONNULL s, FILE * SAFE NONNULL fl); +int puts(const char* NTS NONNULL s); + +size_t fread(void * COUNT(_size * _n) NONNULL, size_t _size, + size_t _n, FILE * SAFE NONNULL); +size_t fwrite(const void * COUNT(_size *_n) NONNULL, + size_t _size, size_t _n, FILE * SAFE NONNULL); + +extern void perror(const char * NTS NONNULL); + +FILE * SAFE NULLABLE fopen(const char * NTS NONNULL _name, + const char * NTS NONNULL _type); + +int fseek(FILE * SAFE NONNULL, long, int); + +int remove(const char * NTS NONNULL); +int rename(const char * NTS NONNULL, const char * NTS NONNULL); + +// Darwin +extern FILE (COUNT(3) __sF)[]; + +// stdlib.h + +double atof(char * NTS); +int atoi(char * NTS); +long int atol(char * NTS); +long long atoll(char * NTS); + +double __strtod_internal (char * NTS, char * NTS *, int); +float __strtof_internal (char * NTS, char * NTS *, int); +long double __strtold_internal(char * NTS, char * NTS *, int); +long int __strtol_internal (char * NTS, char * NTS *, int, int); +long long int __strtoll_internal (char * NTS, char * NTS *, int, int); + +double strtod(const STRING str, OPTSTRING * SAFE endptr); +long strtol(const STRING str, OPTSTRING * SAFE endptr, int base); +long long strtoll(const STRING str, OPTSTRING * SAFE endptr, int base); + +OPTSTRING getenv(const STRING str); +int putenv(char *NTS); +int unsetenv(char *NTS); + +int system(const OPTSTRING str); + +// string.h + +unsigned int strlen(const STRING s); + +void * (DMEMSET(1, 2, 3) memset)(void* p, int what, size_t sz); +int (DMEMCMP(1, 2, 3) memcmp)(void* s1, void* s2, size_t sz); +void * (DMEMCPY(1, 2, 3) memcpy)(void* dst, void* src, size_t sz); +void * (DMEMCPY(1, 2, 3) memmove)(void *dst, void* src, size_t sz); + +void bzero(void * COUNT(size) buff, unsigned int size); + +STRING strncpy(STRINGBUF(n) dest, const STRING src, size_t n); +STRING __builtin_strncpy(STRINGBUF(n) dest, const STRING src, size_t n); + +int strcmp(const STRING s1, const STRING s2); +int __builtin_strcmp(const STRING s1, const STRING s2); + +int strncmp(const STRING s1, const STRING s2, size_t n); +int __builtin_strncmp(const STRING s1, const STRING s2, size_t n); + +size_t strlcpy(STRINGBUF(siz-1) dst, const STRING src, size_t siz); + +STRING strncat(STRINGBUF(n) dest, const STRING src, size_t n); +STRING __builtin_strncat(STRINGBUF(n) dest, const STRING src, size_t n); + +size_t strlcat(STRINGBUF(n-1) dest, const STRING src, size_t n); + +OPTSTRING strchr(const STRING s, int chr); +OPTSTRING __builtin_strchr(const STRING s, int chr); + +OPTSTRING strrchr(const STRING s, int chr); +OPTSTRING strdup(const STRING s); +OPTSTRING __strdup(const STRING s); +OPTSTRING strpbrk(const STRING str, const STRING accept_arg); +OPTSTRING __builtin_strpbrk(const STRING str, const STRING accept_arg); +OPTSTRING __strpbrk_c2 (__const STRING str, int __accept1, int __accept2); +OPTSTRING strsep(char * NTS * NT stringp, const STRING delim); + +size_t strspn(const STRING str, const STRING charset); +size_t __builtin_strspn(const STRING str, const STRING charset); + +size_t __strspn_c1(const STRING str, int accept1); +size_t __strspn_c2(const STRING str, int accept1, int accept2); +size_t __strspn_c3(const STRING str, int accept1, int accept2, int accept3); + +size_t strcspn(const STRING str, const STRING charset); +size_t __builtin_strcspn(const STRING str, const STRING charset); + +size_t __strcspn_c1(const STRING str, int reject1); +size_t __strcspn_c2(const STRING str, int reject1, int reject2); +size_t __strcspn_c3(const STRING str, int reject1, int reject2, int reject3); + +int strcasecmp(const STRING s1, const STRING s2); +int strncasecmp(const STRING s1, const STRING s2, size_t n); + +OPTSTRING strtok(OPTSTRING str, const STRING delim); + +OPTSTRING strerror(int errnum); +OPTSTRING strstr(const STRING __haystack, const STRING __needle); + +// time.h + +extern STRING ctime(const time_t *timer); +extern STRING asctime(const struct tm *timep); + +//similar to gethostname - null term is not guarenteed to exist + +size_t strftime(char * NONNULL COUNT(max) s, size_t max, const STRING format, + const struct tm * SAFE tm); + + +// sys/uio.h + +struct iovec { + void * COUNT(iov_len) iov_base; + size_t iov_len; +}; + +int readv(int fd, const struct iovec * COUNT(__count), int __count); +int writev(int fd, const struct iovec * COUNT(__count), int __count); + +// unistd.h + +void read (int __fd, void * COUNT(__nbytes) __buf, void __nbytes); +void write (int __fd, const void * COUNT(__n) __buf, void __n); + +int access(const char * NTS path, int amode); +int execv(const char * NTS NONNULL path, char * NTS * NTS argv); +int execvp(const char * NTS NONNULL path, char * NTS * NTS argv); +int execve(const char * NTS NONNULL path, char * NTS * NTS argv, + char * NTS * NTS envp); + +char * NTS getlogin(void); +char * NTS ttyname(int filedes); + +int getopt(int argc, char * NTS * NT COUNT(argc) argv, + const char * NTS optstring); + +extern char *NTS optarg; + +char * NTS getusershell(void); + +int chdir(const char * NTS NONNULL); +int unlink(const char * NTS NONNULL __path); +int rmdir(char * NTS __path); + +//modified as not guarenteed to be NT +//this function is not type-safe per se +//We need to wrap around it +int gethostname (char * NONNULL COUNT(__len) __name, size_t __len); + +int chown(char * NTS __file, __uid_t __owner, __gid_t __group); +int link(char * NTS __from, char * NTS __to); +int chroot(char * NTS __path); + +int readlink (char *NTS, char *NTS, size_t); + +OPTSTRING getcwd (STRINGBUF(__size) __buf, size_t __size); + +// reent.h + +#ifdef __CYGWIN__ +// Take care of the union in reent.h (on cygwin) +// This union is not actually used, so we can use WHEN +// clauses to enable only the used field. +struct _reent { + union { + void _reent WHEN(1); + void _unused WHEN(0); + } _new; +}; +#endif + +// siginfo.h + +// Trust the sigval union--there is no way to know what it is (in bits). +typedef union TRUSTED sigval { + int sival_int; + void *sival_ptr; +} sigval_t; + +#define SIGILL 4 +#define SIGBUS 7 +#define SIGFPE 8 +#define SIGKILL 9 +#define SIGSEGV 11 +#define SIGALRM 14 +#define SIGCHLD 17 +#define SIGPOLL SIGIO +#define SIGIO 29 + +struct siginfo { + union { + void _kill WHEN(si_signo == SIGKILL); + void _timer WHEN(si_signo == SIGALRM); + void _rt WHEN(0); // TODO: When is this used? + void _sigchld WHEN(si_signo == SIGCHLD); + void _sigfault WHEN(si_signo == SIGILL || si_signo == SIGFPE || + si_signo == SIGSEGV || si_signo == SIGBUS); + void _sigpoll WHEN(si_signo == SIGPOLL); + } _sifields; +}; + +// sigaction.h + +#define SA_SIGINFO 4 + +typedef void __sighandler_t; +typedef void siginfo_t; + +struct sigaction { + union { + /* Used if SA_SIGINFO is not set. */ + __sighandler_t sa_handler + WHEN (!(sa_flags & SA_SIGINFO)); + /* Used if SA_SIGINFO is set. */ + void (*sa_sigaction)(int, siginfo_t *, void *) + WHEN(sa_flags & SA_SIGINFO); + } __sigaction_handler; +}; + +// syslog.h + +void openlog(char *NTS, int, int); +void syslog(int, char * NTS, ...); + +// resolv.h + +struct __res_state { + char *NTS (NT dnsrch)[0]; + char (NT defdname)[0]; + union { + void pad WHEN(0); + void _ext WHEN(1); + } _u; +}; + +// sys/utsname.h + +struct utsname { + char (NT sysname)[0]; + char (NT nodename)[0]; + char (NT release)[0]; + char (NT version)[0]; + char (NT machine)[0]; + char (NT domainname)[0]; + char (NT __domainname)[0]; +}; + +// net/if.h + +struct ifreq { + union { + char (NT ifrn_name)[0]; + } ifr_ifrn; + union TRUSTED { + } ifr_ifru; +}; + +struct ifconf { + union TRUSTED { + char * NTS ifcu_buf; + } ifc_ifcu; +}; + +// sys/statfs.h + +int statvfs(char * NTS, struct statvfs *); +int statvfs64(char * NTS, struct statvfs64 *); +int statfs(char * NTS, struct statfs *); +int statfs64(char * NTS, struct statfs64 *); + +// db.h + +typedef void DB_ENV; +typedef void DB_INFO; +typedef void DBTYPE; +typedef void DB; +typedef unsigned int u_int32_t; + +int db_appinit(const char * NTS, char * NTS const *, DB_ENV *, u_int32_t); +int db_appexit(DB_ENV *); +int db_jump_set(void *, int); +int db_open(const char * NTS, DBTYPE, u_int32_t, int, + DB_ENV *, DB_INFO *, DB **); +int db_value_set(int, int); +char *db_version(int *, int *, int *); +int db_xa_open(const char * NTS, DBTYPE, u_int32_t, int, DB_INFO *, DB **); + +// dirent.h + +struct dirent { + char (NT d_name)[256]; +}; + +struct dirent64 { + char (NT d_name)[256]; +}; + +DIR *opendir(char * NTS); diff --git a/install-sh b/install-sh new file mode 100644 index 0000000..e9de238 --- /dev/null +++ b/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/lib/Deputy.pm b/lib/Deputy.pm new file mode 100644 index 0000000..cb6f86f --- /dev/null +++ b/lib/Deputy.pm @@ -0,0 +1,276 @@ +# +# +# Copyright (c) 2001-2002, +# George C. Necula +# Scott McPeak +# Wes Weimer +# 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 package is used from an environment when CilConfig.pm has been loaded +package Deputy; +use strict; + +use Cilly; + +# NOTE: If perl chokes, complaining about 'our', or +# "Array found where operator expected", it's because +# you need perl version 5.6.0 or later. +our @ISA = qw(Cilly); + +sub new { + my ($proto, @args) = @_; + my $class = ref($proto) || $proto; + my $self = Cilly->new(@args); + + # Select the directory containing Deputy's executables. We look in + # both places in order to accomodate the build and distribution + # directory layouts. + my $bin; + my $lib; + if (-x "$::deputyhome/obj/$::archos/deputy.asm.exe") { + $bin = "$::deputyhome/obj/$::archos"; + $lib = "$::deputyhome/obj/$::archos"; + } elsif (-x "$::deputyhome/bin/deputy.asm.exe") { + $bin = "$::deputyhome/bin"; + $lib = "$::deputyhome/lib"; + } else { + die "Couldn't find directory containing Deputy executables.\n" . + "Please ensure that Deputy is compiled and installed properly.\n"; + } + + # Select the most recent executable + my $mtime_asm = int((stat("$bin/deputy.asm.exe"))[9]); + my $mtime_byte = int((stat("$bin/deputy.byte.exe"))[9]); + my $use_debug = + grep(/--bytecode/, @args) || + grep(/--ocamldebug/, @args) || + ($mtime_asm < $mtime_byte); + if ($use_debug) { + $ENV{"OCAMLRUNPARAM"} = "b" . $ENV{"OCAMLRUNPARAM"}; # Print back trace + } + + # New variables for Deputy + $self->{COMPILER} = "$bin/deputy" . ($use_debug ? ".byte.exe" : ".asm.exe"); + $self->{LIBBASE} = $lib; + + # Override Cilly's default + $self->{SEPARATE} = 1; + + bless $self, $class; +} + +# Use the debug library if necessary +sub deputyLib { + my ($self) = @_; + return ("$self->{LIBBASE}/deputy_" . + ($self->{LINUX} ? "linux" : "libc") . + ".$self->{OBJEXT}"); +} + +sub instrLib { + my ($self) = @_; + return ("$::deputyhome/lib/lwcalls.mlb", + "$self->{LIBBASE}/instr_glob_state.$self->{OBJEXT}") +} + +sub instrLink { + my ($self) = @_; + return ("-lm","-lcurses","-lpthread"); +} + +sub setDefaultArguments { + my ($self) = @_; + $self->{TRACE_COMMANDS} = 0; + return $self->SUPER::setDefaultArguments; +} + +sub collectOneArgument { + my ($self, $arg, $pargs) = @_; + my $res = 1; + if ($self->compilerArgument($self->{OPTIONS}, $arg, $pargs)) { + # do nothing + } elsif ($arg eq "--help" || $arg eq "-help") { + $self->printVersion(); + $self->printHelp(); + exit 0; + } elsif ($arg eq "--version" || $arg eq "-version") { + $self->printVersion(); + exit 0; + } elsif ($arg eq "--linux") { + $self->{LINUX} = 1; + } elsif ($arg eq "--trace") { + $self->{TRACE_COMMANDS} = 1; + } elsif ($arg eq "--nolib") { + $self->{NOLIB} = 1; + } elsif ($arg eq "--bytecode") { + $self->{NATIVECAML} = 0; + } elsif ($arg =~ m|--save-temps=(.+)$|) { + if (! -d $1) { + die "Cannot find directory $1"; + } + $self->{SAVE_TEMPS} = $1; + } elsif ($arg eq '--save-temps') { + $self->{SAVE_TEMPS} = '.'; + } elsif ($arg =~ m|--includedir=(.+)$|) { + push @{$self->{INCLUDEDIR}}, $1; + } elsif ($arg =~ m|^--out=(\S+)$|) { + # Intercept the --out argument + $self->{CILLY_OUT} = $1; + push @{$self->{CILARGS}}, "--out", $1; + } elsif ($arg eq "--instrument") { + $self->{INSTRUMENT} = 1; + push @{$self->{CILARGS}}, "--instrument"; + } elsif ($arg =~ m|^--|) { + # All other arguments starting with -- are passed to CIL + # Split the == + if ($arg =~ m|^(--\S+)=(.+)$|) { + push @{$self->{CILARGS}}, $1, $2; + } else { + push @{$self->{CILARGS}}, $arg; + } + } else { + # We fail! + $res = 0; + } + return $res; +} + +sub preprocess_before_cil { + my($self, $src, $dest, $ppargs) = @_; + my @args = @{$ppargs}; + unshift @args, + $self->forceIncludeArg("$::deputyhome/include/deputy/annots.h"); + unshift @args, $self->{INCARG} . $::deputyhome . "/include"; + return $self->SUPER::preprocess_before_cil($src, $dest, \@args); +} + + +## We do not preprocess after CIL, to save time and files +sub preprocessAfterOutputFile { + my ($self, $src) = @_; + return $src; # Do not preprocess after CIL +} + +sub preprocess_after_cil { + my ($self, $src, $dest, $ppargs) = @_; + if($src ne $dest) { die "I thought we are not preprocessing after CIL";} + return $dest; +} + +sub compile_cil { + my ($self, $src, $dest, $ppargs, $ccargs) = @_; + my @args = @{$ppargs}; + push @args, "$self->{INCARG}$::deputyhome/include"; + return $self->SUPER::compile_cil($src, $dest, \@args, $ccargs); +} + + +sub link_after_cil { + my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_; + my @srcs = @{$psrcs}; + my @libs = @{$ldargs}; + my @cargs = @{$ccargs}; + my ($instrlibs, $instrcargs); + if (scalar @srcs == 0) { + print STDERR "deputy: no input files\n"; + return 0; + } else { + push @srcs, $self->deputyLib() unless $self->{NOLIB}; + #push @srcs, $self->instrLib() unless $self->{INSTRUMENT} != 1; + #push @libs, $self->instrLink() unless $self->{INSTRUMENT} != 1; + if ($self->{INSTRUMENT} == 1) { + $self->{LD} = ['mlton','-profile','alloc','-runtime','max-heap 1.5g','-runtime','gc-summary','-default-ann',"allowFFI true"]; + $self->{OUTEXE} = '-output'; + push @{$ccargs},("-I /usr/local/include","-I /usr/local/include/oct"); + push @libs, ("-lgmp","-loct_iag"); + unshift @srcs, $self->instrLib(); + if (scalar @{$ppargs} != 0 || scalar @{$ccargs} != 0) { + $instrcargs = join(" ",@{$ppargs},@{$ccargs}); + #$instrcargs = join(" ","-cc-opt","\"$instrcargs\""); + @cargs = ("-cc-opt",$instrcargs); + } + if (scalar @libs != 0) { + $instrlibs = join(" ",@libs); + #$instrlibs = join(" ","-link-opt","\"$instrlibs\""); + push @cargs, ("-link-opt",$instrlibs); + @libs = (); + } + $ppargs = []; + } + return $self->SUPER::link_after_cil(\@srcs, $dest, $ppargs, + \@cargs, \@libs); + } +} + +sub linktolib { + my ($self, $psrcs, $dest, $ppargs, $ccargs, $ldargs) = @_; + my @srcs = @{$psrcs}; + if (scalar @srcs == 0) { + print STDERR "deputy: no input files\n"; + return 0; + } else { + push @srcs, $self->deputyLib() unless $self->{NOLIB}; + return $self->SUPER::linktolib(\@srcs, $dest, $ppargs, + $ccargs, $ldargs); + } +} + +sub CillyCommand { + my ($self, $ppsrc, $dest) = @_; + + my @cmd = ($self->{COMPILER}); + my $aftercil = $self->cilOutputFile($dest, 'cil.c'); + return ($aftercil, @cmd, '--out', $aftercil); +} + +sub printVersion { + #system ($self->{COMPILER}, '--version'); +} + +sub printHelp { + my ($self) = @_; + my @cmd = ($self->{COMPILER}, '-help'); + $self->runShell(@cmd); + print < +#include +#include +#ifdef _GNUCC + #include /* sleep, getpid */ +#endif + +#define IN_DEPUTY_LIBRARY + +#include "deputy/checks.h" + +// If Deputy fails, it checks to see if you have specified special handling +// for failed checks. +enum handlerKind { + HANDLE_DEFAULT, // no handler specified + HANDLE_IGNORE, // ignore + HANDLE_STOP, // warn and stop + HANDLE_WARN, // warn but do not stop + HANDLE_SLEEP, // sleep and wait for the the debugger +}; + +static enum handlerKind deputyErrorHandler = HANDLE_DEFAULT; + +static int deputyInited = 0; +static void deputyInitOnFirstFailure(void) { + // Cache the result of environment lookup + char *onerror = getenv("DEPUTY_ONERROR"); + deputyErrorHandler = HANDLE_DEFAULT; + if (onerror) { + if (!strcasecmp(onerror, "stop")) { + deputyErrorHandler = HANDLE_STOP; + } else if (!strcasecmp(onerror, "ignore")) { + deputyErrorHandler = HANDLE_IGNORE; + } else if (!strcasecmp(onerror, "warn")) { + deputyErrorHandler = HANDLE_WARN; + } else if (!strcasecmp(onerror, "sleep")) { + deputyErrorHandler = HANDLE_SLEEP; + } else { + fprintf(stderr, "Unexpected value for env var DEPUTY_ONERROR\n"); + } + } +} + +// This function is called directly from the checks unless the code was +// compiled with --deputyAlwaysStopOnError . It is also called from +// deputy_fail_noreturn to do the real work. +asmlinkage +void deputy_fail_mayreturn(const char *check, const char *text, + __LOCATION__FORMALS) { + if (!deputyInited) { + deputyInitOnFirstFailure(); deputyInited = 1; + } + if (deputyErrorHandler != HANDLE_IGNORE) { + fprintf(stderr, "%s:%d: %s: Assertion failed in %s:\n %s\n", + __LOCATION__ACTUALS, check, text); + } + // Now look whether we should return or not + switch (deputyErrorHandler) { + case HANDLE_DEFAULT: + case HANDLE_STOP: + fprintf(stderr, "Execution aborted.\n"); + exit(1); + case HANDLE_SLEEP: +#if defined(_MSVC) + // On Windows, this will fire the just-in-time debugger. + _asm { int 3 } +#else + // Pause for debugging multithreaded code. + // (Trick due to Ben Liblit, via Dan Wilkerson.) + { + volatile int stopped = 1; + + fprintf(stderr, "Execution paused for debugging (pid = %d).\n", + getpid()); + fflush(stderr); + + while (stopped) { + // 1. Execution will stop here. + sleep(1); + } + + // 2. Set breakpoint here, and set stopped to 0. + // (This statement exists so we have a place to put + // that breakpoint.) + stopped ++; + } +#endif + break; + default: + break; + } +} + +// This function must NOT return. This is the function that is called +// by the checks if we compiled with --alwaysStopOnError +asmlinkage noreturn +void deputy_fail_noreturn(const char *check, const char *text, + __LOCATION__FORMALS) { + deputy_fail_mayreturn(check, text, __LOCATION__ACTUALS); + fprintf(stderr, "Deputy check failed; execution aborted.\n"); + exit(1); +} + +// This function must NOT return. This is the function that is called +// by the checks if we compiled with --alwaysStopOnError and --deputyFastChecks +asmlinkage noreturn +void deputy_fail_noreturn_fast(void) { + fprintf(stderr, "Deputy check failed; execution aborted.\n"); + fprintf(stderr, "Detailed error report suppressed (--deputyFastChecks).\n"); + exit(1); +} + +/* Search for a NULL starting at e and return its index */ +asmlinkage +int deputy_findnull(const void *e, unsigned int bytes) { +#define NULLCHECK(type) \ + do { \ + type *p = (type*) e; \ + while (*p != 0) { \ + p++; \ + } \ + length = (p - (type*) e); \ + } while (0) + + int length = 0; + + switch (bytes) { + case 1: + NULLCHECK(char); + break; + case 2: + NULLCHECK(short); + break; + case 4: + NULLCHECK(long); + break; + default: + fprintf(stderr, "Invalid byte size for nullcheck.\n"); + exit(1); + } + + return length; +#undef NULLCHECK +} + +asmlinkage +void *__deputy_memset(void *s, int c, unsigned int n) { + return memset(s, c, n); +} diff --git a/lib/deputy_linux.c b/lib/deputy_linux.c new file mode 100755 index 0000000..4d154c8 --- /dev/null +++ b/lib/deputy_linux.c @@ -0,0 +1,88 @@ +#include /* has to be first! */ +#include +#include +#ifdef CONFIG_KRECOVER +#include +#endif + +#define IN_DEPUTY_LIBRARY + +#include "deputy/checks.h" + +asmlinkage +void deputy_fail_mayreturn(const char *check, const char *text, + __LOCATION__FORMALS) { + printk(KERN_ALERT + "%s:%d: %s: Assertion failed in %s: %s\n", + __LOCATION__ACTUALS, check, text); + dump_stack(); +#ifdef CONFIG_KRECOVER + /* This will trigger real krecover recovery */ + if (kr_recovery_enabled) + kr_trigger_fault(); +#endif +} + +asmlinkage noreturn +void deputy_fail_noreturn_fast(void) { + panic("Deputy assertion failure\n"); +} + +int deputy_strlen(const char *str) { + return strlen(str); +} + +char *deputy_strcpy(char *dest, const char *src) { + char *tmp = dest; + while ((*dest++ = *src++) != '\0') { + // do nothing + } + return tmp; +} + +char *deputy_strncpy(char *dest, const char *src, size_t count) { + char *tmp = dest; + int c = count; + while (c >= 0) { + if ((*tmp = *src) != 0) src++; + tmp++; + c--; + } + return dest; +} + +/* Search for a NULL starting at e and return its index */ +int deputy_findnull(const void *e, unsigned int bytes) { +#define NULLCHECK(type) \ + do { \ + type *p = (type*) e; \ + while (*p != 0) { \ + p++; \ + } \ + length = (p - (type*) e); \ + } while (0) + + int length = 0; + + switch (bytes) { + case 1: + NULLCHECK(char); + break; + case 2: + NULLCHECK(short); + break; + case 4: + NULLCHECK(long); + break; + default: + printk(KERN_ALERT "Invalid byte size for nullcheck.\n"); + break; + } + + return length; +#undef NULLCHECK +} + +void *__deputy_memset(void *s, int c, unsigned int n) { + return memset(s, c, n); +} diff --git a/lib/instr_glob_state.c b/lib/instr_glob_state.c new file mode 100644 index 0000000..e4cd21c --- /dev/null +++ b/lib/instr_glob_state.c @@ -0,0 +1,155 @@ +/* + * instr_glob_state.c + * + * global state for the instrumenter. + * + */ + +#define IN_GLOB_STATE_C + +#include +#include + +struct funInstrList fil; + +#define CAST(t,sz,e) ((t) == 0 ? ((sz) == 8 ? ((unsigned char)e) :\ + ((sz) == -8 ? ((char)e) :\ + ((sz) == 16 ? ((unsigned short)e) :\ + ((sz) == -16 ? ((short)e) :\ + ((sz) == 32 ? ((unsigned int)e) :\ + ((sz) == -32 ? ((int)e) :\ + ((sz) == 64 ? ((unsigned long long)e) :\ + ((sz) == -64 ? ((long long)e) : (e))))))))) :\ + (e)) + +#define SCALE(sz,e) ((sz)*(e)) + +unsigned int +c_eval_bop(unsigned int bop, + unsigned int o1, unsigned int t1, unsigned int sz1, + unsigned int o2, unsigned int t2, unsigned int sz2) +{ + switch(bop) { + case BOP_PLUSA: return CAST(t1,sz1,o1) + CAST(t2,sz2,o2); + case BOP_PLUSPI: return o1 + SCALE(sz1,CAST(t2,sz2,o2)); + case BOP_INDEXPI: return o1 + SCALE(sz1,CAST(t2,sz2,o2)); + case BOP_MINUSA: return CAST(t1,sz1,o1) - CAST(t2,sz2,o2); + case BOP_MINUSPI: return o1 - SCALE(sz1,CAST(t2,sz2,o2)); + case BOP_MINUSPP: return o1 - o2; + case BOP_MULT: return CAST(t1,sz1,o1) * CAST(t2,sz2,o2); + case BOP_DIV: return CAST(t1,sz1,o1) / CAST(t2,sz2,o2); + case BOP_MOD: return CAST(t1,sz1,o1) % CAST(t2,sz2,o2); + case BOP_SHIFTL: return CAST(t1,sz1,o1) << CAST(t2,sz2,o2); + case BOP_SHIFTR: return CAST(t1,sz1,o1) >> CAST(t2,sz2,o2); + case BOP_LT: return CAST(t1,sz1,o1) < CAST(t2,sz2,o2); + case BOP_GT: return CAST(t1,sz1,o1) > CAST(t2,sz2,o2); + case BOP_LE: return CAST(t1,sz1,o1) <= CAST(t2,sz2,o2); + case BOP_GE: return CAST(t1,sz1,o1) >= CAST(t2,sz2,o2); + case BOP_EQ: return CAST(t1,sz1,o1) == CAST(t2,sz2,o2); + case BOP_NE: return CAST(t1,sz1,o1) != CAST(t2,sz2,o2); + case BOP_BAND: return CAST(t1,sz1,o1) & CAST(t2,sz2,o2); + case BOP_BXOR: return CAST(t1,sz1,o1) ^ CAST(t2,sz2,o2); + case BOP_BOR: return CAST(t1,sz1,o1) | CAST(t2,sz2,o2); + case BOP_LAND: return CAST(t1,sz1,o1) && CAST(t2,sz2,o2); + case BOP_LOR: return CAST(t1,sz1,o1) || CAST(t2,sz2,o2); + default: return -1; + } +} + +unsigned int +c_eval_uop(unsigned int uop, unsigned int op, unsigned int t, unsigned int sz) +{ + switch(uop) { + case UOP_NEG: return -CAST(t,sz,op); + case UOP_BNOT: return ~CAST(t,sz,op); + case UOP_LNOT: return !CAST(t,sz,op); + default: return -1; + } +} + +unsigned int +c_int32_hash(unsigned int w, unsigned int mask) +{ + w = (w+0x7ed55d16) + (w<<12); + w = (w^0xc761c23c) ^ (w>>19); + w = (w+0x165667b1) + (w<<5); + w = (w+0xd3a2646c) ^ (w<<9); + w = (w+0xfd7046c5) + (w<<3); + w = (w^0xb55a4f09) ^ (w>>16); + return w & mask; +} + +void +c_print_loc(const char *file, unsigned int line) +{ + printf("%s:%d",file,line); + fflush((void *)0); + return; +} + +/* From here down are wrappers for Mine's octagon library */ + +int c_oct_init() {return oct_init();} +oct_t *c_oct_empty(unsigned int n) {return oct_empty(n);} +oct_t *c_oct_universe(unsigned int n) {return oct_universe(n);} +oct_t *c_oct_copy(oct_t *o) {return oct_copy(o);} +void c_oct_print(oct_t *o) {oct_print(o);return;} +void c_oct_free(oct_t *o) {oct_free(o);return;} +unsigned int c_oct_dimension(oct_t *o) {return oct_dimension(o);} +unsigned int c_oct_is_empty(oct_t *o) {return oct_is_empty(o);} +unsigned int c_oct_is_universe(oct_t *o) {return oct_is_universe(o);} +unsigned int c_oct_is_included_in(oct_t *o1, oct_t *o2) + {return oct_is_included_in(o1,o2);} +unsigned int c_oct_is_equal(oct_t *o1, oct_t *o2) + {return oct_is_equal(o1,o2);} + +oct_t *c_oct_add_constraint(oct_t *o, unsigned int *coefs, unsigned int nb) +{ + int i; + oct_t *newo; + + num_t *ncs = new_n(num_t,nb); + num_init_n(ncs,nb); + + for (i = 0; i < nb; i++) { + num_set_int(&ncs[i],coefs[i]); + } + + newo = oct_add_constraint(o, ncs, true); + oct_mm_free(ncs); + + return newo; +} + +void c_oct_get_box(oct_t *o, int *box, int *valid) +{ + int i; + int dim = oct_dimension(o); + num_t *nbox = oct_get_box(o); + + if (!nbox) { + for (i = 0; i < 2 * dim; i++) + valid[i] = 0; + return; + } + + for (i = 0; i < 2 * dim; i++) { + if (num_fits_int(&nbox[i])) { + box[i] = num_get_int(&nbox[i]); + valid[i] = 1; + } + else + valid[i] = 0; + } + + oct_mm_free(nbox); + return; +} + +oct_t *c_oct_add_dimension(oct_t *o, unsigned int num) +{ + return oct_add_dimensions_and_embed(o, num, true); +} + + +#undef IN_GLOB_STATE_C diff --git a/lib/lwcalls.sml b/lib/lwcalls.sml new file mode 100644 index 0000000..bb7a250 --- /dev/null +++ b/lib/lwcalls.sml @@ -0,0 +1,1261 @@ +(* + * This is an SML backend for Deputy instrumentation + * + * lwcalls.sml + * + * + * + *) + +structure IHT = IntHashTable +structure HT = HashTable + + +(* Interval Map for storing taint data *) +fun interval_compare (lo1,hi1,_) (lo2,hi2,_) = + if Word.<(hi1,lo2) then LESS else + if Word.<(hi2,lo1) then GREATER else + EQUAL + +structure IntervalMap = RedBlackMapFn ( + struct + type ord_key = word * word + fun compare((lo1,hi1),(lo2,hi2)) = + interval_compare (lo1,hi1,0wx0) (lo2,hi2,0wx0) + end) + +structure LocationSet = RedBlackSetFn ( + struct + type ord_key = word * word + fun compare((f1:word,l1:word),(f2:word,l2:word)) = + if f1 < f2 orelse (f1 = f2 andalso l1 < l2) then LESS else + if f2 < f1 orelse (f1 = f2 andalso l2 < l2) then GREATER else + EQUAL + end) + +(* Expression tree data structures *) +datatype uop = + Neg + | BNot + | LNot + | UKUop + +datatype bop = + PlusA + | PlusPI + | IndexPI + | MinusA + | MinusPI + | MinusPP + | Mult + | Div + | Mod + | ShiftL + | ShiftR + | Lt + | Gt + | Le + | Ge + | Eq + | Ne + | BAnd + | BXor + | BOr + | LAnd + | LOr + | UKBop + + +fun bopToWord (b : bop) : word = case b of + PlusA => Word.fromInt 0 + | PlusPI => Word.fromInt 1 + | IndexPI => Word.fromInt 2 + | MinusA => Word.fromInt 3 + | MinusPI => Word.fromInt 4 + | MinusPP => Word.fromInt 5 + | Mult => Word.fromInt 6 + | Div => Word.fromInt 7 + | Mod => Word.fromInt 8 + | ShiftL => Word.fromInt 9 + | ShiftR => Word.fromInt 10 + | Lt => Word.fromInt 11 + | Gt => Word.fromInt 12 + | Le => Word.fromInt 13 + | Ge => Word.fromInt 14 + | Eq => Word.fromInt 15 + | Ne => Word.fromInt 16 + | BAnd => Word.fromInt 17 + | BXor => Word.fromInt 18 + | BOr => Word.fromInt 19 + | LAnd => Word.fromInt 20 + | LOr => Word.fromInt 21 + | UKBop => Word.fromInt 37 + +fun bop_eq (b1 : bop) (b2 : bop) : bool = + (bopToWord b1) = (bopToWord b2) + +fun bopToString (b : bop) : string = case b of + PlusA => "+" + | PlusPI => "+" + | IndexPI => "+" + | MinusA => "-" + | MinusPI => "-" + | MinusPP => "-" + | Mult => "*" + | Div => "/" + | Mod => "%" + | ShiftL => "<<" + | ShiftR => ">>" + | Lt => "<" + | Gt => ">" + | Le => "<=" + | Ge => ">=" + | Eq => "==" + | Ne => "!=" + | BAnd => "&" + | BXor => "^" + | BOr => "|" + | LAnd => "&&" + | LOr => "||" + | UKBop => "??" + +fun print_bop (b : bop) : unit = + print(bopToString b) + +fun negate_bop (b : bop) : bop = case b of + Lt => Ge + | Gt => Le + | Le => Gt + | Ge => Lt + | Eq => Ne + | Ne => Eq + | _ => b + +fun wordToUop (w : word) : uop = case (Word.toInt w) of + 0 => Neg + | 1 => BNot + | 2 => LNot + | _ => UKUop + +fun uopToWord (u : uop) : word = case u of + Neg => Word.fromInt 0 + | BNot => Word.fromInt 1 + | LNot => Word.fromInt 2 + | UKUop => Word.fromInt 37 + +fun uop_eq (u1 : uop) (u2 : uop) : bool = + (uopToWord u1) = (uopToWord u2) + +fun uopToString (u : uop) : string = case u of + Neg => "-" + | BNot => "~" + | LNot => "!" + | UKUop => "??" + +fun print_uop (u : uop) : unit = + print(uopToString u) + +type constdata = { + value : word, (* The bits *) + typ : word, (* The type *) + sz : word (* The size *) +} + +fun const_eq (c1 : constdata) (c2 : constdata) : bool = + (#value c1) = (#value c2) andalso + (#typ c1) = (#typ c2) andalso + (#sz c1) = (#sz c2) + +type inputdata = { + addr : word, (* The original address in memory *) + fnres : word, (* Function result address if needed *) + fnaddr : word, (* The function if needed *) + uid : word, (* unique ids to distinguish logically different inputs *) + cval : word, (* The concrete value *) + typ : word, (* The type *) + sz : word, (* The size *) + file : word, (* source file location *) + line : word (* source line number *) +} + +fun input_eq((i1 : inputdata),(i2 : inputdata)) : bool = + (#addr i1) = (#addr i2) andalso + (#fnres i1) = (#fnres i2) andalso + (#fnaddr i1) = (#fnaddr i2) andalso + (#uid i1) = (#uid i2) andalso + (#cval i1) = (#cval i2) andalso + (#typ i1) = (#typ i2) andalso + (#sz i1) = (#sz i2) + +fun input_hash (id : inputdata) : word = + Word.xorb((#addr id), + Word.xorb((#fnres id), + Word.xorb((#fnaddr id),(#uid id)))) + +fun print_input (id : inputdata) : unit = + print("Input("^(Word.toString (#addr id))^"," + ^(Word.toString (#cval id))^")") + +(* Datatype for symbolic expressions *) +datatype exp = + BinOp of bop * exp * exp + | UnOp of uop * exp + | Const of constdata + | Input of inputdata + +type int64 = Int64.int + +type canonexp = { + ct : int64, + cf : (int64 * exp) list +} + +fun mkConst(v,t,s) = Const{value=v,typ=t,sz=s} +fun mkInput(a,fr,fa,u,v,t,s,fl,ln) = + let + val id = {addr=a,fnres=fr,fnaddr=fa,uid=u,cval=v,typ=t,sz=s,file=fl,line=ln} + in + (*print_input id;*) + Input id + end + +fun print_exp (e : exp) : unit = case e of + BinOp(bop,e1,e2) => + (print("BinOp("^(bopToString bop)^","); + print_exp e1;print ",";print_exp e2;print ")") +| UnOp(uop,e) => + (print("UnOp("^(uopToString uop)^","); + print_exp e; print ")") +| Const c => (print(Word.toString (#value c))) +| Input id => print_input id + + +fun print_canexp (c : canonexp) : unit = + let + fun ppair((f,e),()) = + (print("+"^(Int64.toString f)^"*"); + print_exp e) + in + print(Int64.toString (#ct c)); + foldl ppair () (#cf c) + end + +fun exp_eq (e1 : exp) (e2 : exp) : bool = + case (e1,e2) of + (BinOp(b1,e11,e12),BinOp(b2,e21,e22)) => + (bop_eq b1 b2) andalso (exp_eq e11 e21) andalso (exp_eq e12 e22) + | (UnOp(u1,e1),UnOp(u2,e2)) => + (uop_eq u1 u2) andalso (exp_eq e1 e2) + | (Const cd1, Const cd2) => const_eq cd1 cd2 + | (Input id1, Input id2) => input_eq(id1,id2) + | _ => false + +fun wordToBop (w : word) : bop = case (Word.toInt w) of + 0 => PlusA + | 1 => PlusPI + | 2 => IndexPI + | 3 => MinusA + | 4 => MinusPI + | 5 => MinusPP + | 6 => Mult + | 7 => Div + | 8 => Mod + | 9 => ShiftL + | 10 => ShiftR + | 11 => Lt + | 12 => Gt + | 13 => Le + | 14 => Ge + | 15 => Eq + | 16 => Ne + | 17 => BAnd + | 18 => BXor + | 19 => BOr + | 20 => LAnd + | 21 => LOr + | _ => UKBop + +fun wordToUop (w : word) : uop = case (Word.toInt w) of + 0 => Neg + | 1 => BNot + | 2 => LNot + | _ => UKUop + + +fun mkCanInt (f : int64) : canonexp = {ct = f, cf = []} +fun mkCanAtomic (f : int64) (e : exp) : canonexp = + if f = 0 then {ct = 0, cf = []} + else {ct = 0, cf = [(f,e)]} +val mkCanZero = mkCanInt 0 +fun mkCanWAdd (w1 : int64) (c1 : canonexp) (cacc : canonexp) : canonexp = + let + fun insert (w : int64) (e : exp) (fel : (int64 * exp) list) = + case fel of + [] => if w = 0 then [] else [(w,e)] + | (w',e') :: rst => + if exp_eq e e' then + if w + w' = 0 then + rst + else (w + w',e') :: rst + else (w',e') :: (insert w e rst) + fun folder((w,e),acc) = insert (w1*w) e acc + in + {ct = w1 * (#ct c1) + (#ct cacc), + cf = foldl folder (#cf cacc) (#cf c1)} + end +fun mkCanAdd (c1 : canonexp) (c2 : canonexp) : canonexp = + mkCanWAdd 1 c1 c2 +fun mkCanSub (c1 : canonexp) (c2 : canonexp) : canonexp = + mkCanWAdd (~1) c2 c1 +fun mkCanMult (c : canonexp) (n : int64) : canonexp = + mkCanWAdd n c mkCanZero +fun mkCanAddConst (c : canonexp) (n : int64) : canonexp = + {ct = n + (#ct c), cf = (#cf c)} + + +fun max x y = if x > y then x else y + +fun typeOfExp (e : exp) : word * word = case e of + Const c => ((#typ c),(#sz c)) + | Input i => ((#typ i),(#sz i)) + | UnOp(_,e) => typeOfExp e + | BinOp(_,e1,e2) => + let + val (t1,sz1) = typeOfExp e1 + val (t2,sz2) = typeOfExp e2 + in + case (t1,t2) of + (0wx0,0wx0) => (0wx0,max sz1 sz2) + | (0wx1,0wx0) => (0wx1,sz1) + | (0wx0,0wx1) => (0wx1,sz2) + | (0wx1,0wx1) => (0wx1,0wx1) + | _ => (0wx1,0wx1) + end + +fun wordToInt64 (w : word) (signed : bool) : int64 = + (if signed + then (Int64.fromLarge o Word.toLargeIntX) w + else (Int64.fromLarge o Word.toLargeInt) w) + handle Overflow => + (print("wordToInt64: Overflow: "^(Word.toString w)^"\n"); + raise Overflow) + +fun int64ToInt (i : int64) : int = + ((Int.fromLarge o Int64.toLarge) i) + handle Overflow => + (print "Overflow in conversion from int64 to int\n"; + raise Overflow) + +fun canonExp (f : int64) (e : exp) : canonexp = + (case e of + Const c => mkCanInt (f * (wordToInt64 (#value c) (Word.toIntX (#sz c) < 0))) + | BinOp(PlusA,e1,e2) => + mkCanAdd (canonExp f e1) (canonExp f e2) + | BinOp(PlusPI,e1,e2) => + let + val (t1,sz1) = typeOfExp e1 + val (t2,sz2) = typeOfExp e2 + in + case (t1,t2) of + (0wx0,0wx0) => + mkCanAdd (canonExp f e1) (canonExp f e2) + | (0wx1,0wx0) => + mkCanAdd (canonExp f e1) (canonExp (f*(wordToInt64 sz1 false)) e2) + | (0wx0,0wx1) => + mkCanAdd (canonExp (f*(wordToInt64 sz2 false)) e1) (canonExp f e2) + | (0wx1,0wx1) => + mkCanAdd (canonExp f e1) (canonExp f e2) + | _ => + mkCanAdd (canonExp f e1) (canonExp f e2) + end + | BinOp(IndexPI,e1,e2) => + let + val (t1,sz1) = typeOfExp e1 + val (t2,sz2) = typeOfExp e2 + in + case (t1,t2) of + (0wx0,0wx0) => + mkCanAdd (canonExp f e1) (canonExp f e2) + | (0wx1,0wx0) => + mkCanAdd (canonExp f e1) (canonExp (f*(wordToInt64 sz1 false)) e2) + | (0wx0,0wx1) => + mkCanAdd (canonExp (f*(wordToInt64 sz2 false)) e1) (canonExp f e2) + | (0wx1,0wx1) => + mkCanAdd (canonExp f e1) (canonExp f e2) + | _ => + mkCanAdd (canonExp f e1) (canonExp f e2) + end + | BinOp(MinusA,e1,e2) => + mkCanAdd (canonExp f e1) (canonExp (~f) e2) + | BinOp(MinusPI,e1,e2) => + let + val (t1,sz1) = typeOfExp e1 + val (t2,sz2) = typeOfExp e2 + in + case (t1,t2) of + (0wx0,0wx0) => + mkCanAdd (canonExp f e1) (canonExp (~f) e2) + | (0wx1,0wx0) => + mkCanAdd (canonExp f e1) (canonExp (~f*(wordToInt64 sz1 false)) e2) + | (0wx0,0wx1) => + mkCanAdd (canonExp (f*(wordToInt64 sz2 false)) e1) (canonExp (~f) e2) + | (0wx1,0wx1) => + mkCanAdd (canonExp f e1) (canonExp (~f) e2) + | _ => + mkCanAdd (canonExp f e1) (canonExp (~f) e2) + end + | BinOp(MinusPP,e1,e2) => + mkCanAdd (canonExp f e1) (canonExp (~f) e2) + | BinOp(Mult,e1,Const c) => + mkCanAtomic (f * (wordToInt64 (#value c) (Word.toIntX (#sz c) < 0))) e1 + | BinOp(Mult,Const c, e2) => + mkCanAtomic (f * (wordToInt64 (#value c) (Word.toIntX (#sz c) < 0))) e2 + | _ => mkCanAtomic f e) + handle Overflow => + (print "canonExp: Overflow\n"; raise Overflow) + +exception Not_found + +fun incr (i : int ref) : unit = i := (!i) + 1 +fun decr (i : int ref) : unit = i := (!i) - 1 + +fun fst (a,b) = a + +type taintdata = { + uid : word, + file : word, + line : word +} + +fun mkTaint (uid : word) (file : word) (line : word) : taintdata = + {uid=uid,file=file,line=line} + +(* Functions for manipulating the taint map *) +val taintMap : taintdata IntervalMap.map ref = ref IntervalMap.empty + +fun taintSetRm (s : word) (e : word) : unit = + (taintMap := fst(IntervalMap.remove(!taintMap,(s,e)))) + handle NotFound => () + +fun taintSetAdd (s : word) (esz : word) (ecnt : word) + (file : word) (line : word) + : unit + = + let + val e = s + esz * ecnt + in + case IntervalMap.find(!taintMap,(s,e)) of + NONE => + let val td = mkTaint 0wx0 file line in + taintMap := IntervalMap.insert(!taintMap,(s,e),td) + end + | SOME td => + let val td = mkTaint ((#uid td)+0wx1) file line in + taintMap := IntervalMap.insert(!taintMap,(s,e),td) + end + end + +fun taintSetFind (s : word) (e : word) : (word * word * taintdata) option = + case IntervalMap.find(!taintMap,(s,e)) of + NONE => NONE + | SOME td => SOME(s,e,td) + + +(* Functions for manipulating the symbolic state *) +val symStateShift = Word.fromInt 18 +val symStateSize = Word.<<((Word.fromInt 1), symStateShift) +val symStateMask = symStateSize - (Word.fromInt 1) +(* Global hash table for symbolic state *) +(*WHash.mkTable(131072,Not_found)*) +val symState : exp option array = Array.array(Word.toInt symStateSize,NONE) +val c_int32_hash = _import "c_int32_hash": word * word -> int; +fun symStateHash (w : word) : int = + (*c_int32_hash(w,symStateMask)*) + Word.toInt (Word.andb(w, symStateMask)) +val collisions : int ref = ref 0 +fun symStateAdd (sop : word) (e : exp) : unit = + ((*print("Adding: "^(Word.toString sop)^" -> "); + print_exp e; print "\n";*) + (case Array.sub(symState,symStateHash sop) of + NONE => Array.update(symState, (symStateHash sop), (SOME e)) + | SOME _ => (Array.update(symState, (symStateHash sop), (SOME e))))) +fun symStateLookup (sop : word) : exp option = + Array.sub(symState, (symStateHash sop)) +fun symStateRm (sop : word) : unit = + Array.update(symState, (symStateHash sop), NONE) + +(* Stuff for maintaining a mapping from inputs to sets of locations where those + inputs are checked *) + +val c_print_loc = _import "c_print_loc": + word * word -> unit; + +val inpChecks : LocationSet.set IHT.hash_table = + IHT.mkTable (100, Not_found) + +fun addInpCheck (vid : int) (file,line) : unit = + case IHT.find inpChecks vid of + NONE => + IHT.insert inpChecks (vid,LocationSet.singleton(file,line)) + | SOME s => + IHT.insert inpChecks (vid,LocationSet.add(s,(file,line))) + +fun getInpChecks (vid : int) : LocationSet.set = + case IHT.find inpChecks vid of + NONE => LocationSet.empty + | SOME s => s + +fun printInpChecks (vid : int) : unit = + let + val set = getInpChecks vid + fun printer((file,line),()) = + c_print_loc(file,line) + in + if LocationSet.isEmpty set then + print "No Checks" + else + LocationSet.foldl printer () set + end + +(* Octagon stuff *) + +type oct_t = word + +val c_oct_init = _import "c_oct_init": + unit -> int; +val c_oct_add_constraint = _import "c_oct_add_constraint": + oct_t * int array * int -> oct_t; +val c_oct_add_dimension = _import "c_oct_add_dimension": + oct_t * word -> oct_t; +val c_oct_empty = _import "c_oct_empty": + word -> oct_t; +val c_oct_universe = _import "c_oct_universe": + word -> oct_t; +val c_oct_copy = _import "c_oct_copy": + oct_t -> oct_t; +val c_oct_print = _import "c_oct_print": + oct_t -> unit; +val c_oct_free = _import "c_oct_free": + oct_t -> unit; +val c_oct_dimension = _import "c_oct_dimension": + oct_t -> int; +val c_oct_is_empty = _import "c_oct_is_empty": + oct_t -> bool; +val c_oct_is_universe = _import "c_oct_is_universe": + oct_t -> bool; +val c_oct_is_included_in = _import "c_oct_is_included_in": + oct_t * oct_t -> bool; +val c_oct_is_equal = _import "c_oct_is_equal": + oct_t * oct_t -> bool; +val c_oct_get_box = _import "c_oct_get_box": + oct_t * int array * int array -> unit; + +type octagon = { + oct : oct_t ref, + maxvars : int ref, + numvars : int ref +} + +fun mkOct () : octagon = + {oct = ref (c_oct_universe 0wx5), maxvars = ref 5, numvars = ref 0} +fun copyOct (oct : octagon) : octagon = + {oct = ref (c_oct_copy (!(#oct oct))), + maxvars = ref (!(#maxvars oct)), + numvars = ref (!(#numvars oct))} +fun printOct (oct : octagon) : unit = + c_oct_print (!(#oct oct)) + + +val cOctagon : octagon = (ignore(c_oct_init()); mkOct()) + +val inpOVarHash : (inputdata,int) HT.hash_table = + HT.mkTable (input_hash,input_eq) (100,Not_found) +val oVarInpHash : inputdata IHT.hash_table = + IHT.mkTable (100,Not_found) + +fun addOctConstraint (oct : octagon) (cl : int array) : unit = + (#oct oct) := c_oct_add_constraint(!(#oct oct),cl,Array.length cl); +fun addOctVar (oct : octagon) (id : inputdata) : int = + (if !(#numvars oct) = !(#maxvars oct) then + ((#oct oct) := c_oct_add_dimension(!(#oct oct),0wx5); + (#maxvars oct) := !(#maxvars oct) + 5) + else (); + HT.insert inpOVarHash (id, !(#numvars oct)); + IHT.insert oVarInpHash (!(#numvars oct),id); + !(#numvars oct) before (incr (#numvars oct))) +fun getOctVar (oct : octagon) (id : inputdata) : int = + case HT.find inpOVarHash id of + NONE => addOctVar oct id + | SOME i => i + +(* Convert a canonexp into a list of coefficients and octVar IDs. + If the expression doesn't have the right form, return NONE *) +exception BadConExp +fun getCoefIdList (oct : octagon) (c : canonexp) : (int64 * int) list option = + let + fun handleTerm (f,e) : (int64 * int) = case e of + Input id => (f, getOctVar oct id) + | _ => raise BadConExp + in + ((*print "trying to add: "; + print_canexp c; print "\n";*) + SOME(map handleTerm (#cf c))(* before + print "constraint added\n"*) + ) handle BadConExp => NONE + end + +fun maxVID ipl m = case ipl of + [] => m +| (f,id) :: rst => + if id > m then maxVID rst id else maxVID rst m + +(* Adds the constraint c >= 0 to the octagon *) +fun addCEToOct (oct : octagon) (c : canonexp) + (file : word) (line : word) + : unit + = + case getCoefIdList oct c of + NONE => () + | SOME ipl => + let + val dim = c_oct_dimension (!(#oct oct)) + val coefs = Array.array ((dim + 1),0) + fun adder ((f, id),()) : unit = + (Array.update (coefs,id,int64ToInt f); + if file <> 0wx0 then addInpCheck id (file,line) else ()) + in + (foldl adder () ipl; + Array.update (coefs,dim,int64ToInt (#ct c)); + addOctConstraint oct coefs) + handle Overflow => () + | Subscript => () + end + +fun addBopToOct (oct : octagon) (b : bop) (e1 : exp) (e2 : exp) + (file : word) (line : word) + : unit + = + let + val e1 = canonExp 1 e1 + val e2 = canonExp 1 e2 + val one = mkCanInt 1 + in + case b of + Lt => addCEToOct oct (mkCanSub e2 (mkCanAdd e1 one)) file line + | Gt => addCEToOct oct (mkCanSub e1 (mkCanAdd e2 one)) file line + | Le => addCEToOct oct (mkCanSub e2 e1) file line + | Ge => addCEToOct oct (mkCanSub e1 e2) file line + | _ => () + end + +(* structures for dealing with call/return semantics *) +val call_depth = ref 0 +val arg_stack : (word * word * word * word) array = + Array.array(20,(0wx0,0wx0,0wx0,0wx0)) +val arg_stack_top = ref 0 +val ret_val : exp option ref = ref NONE + +fun arg_stack_push wt = + (Array.update(arg_stack, !arg_stack_top, wt); + incr arg_stack_top) + +fun arg_stack_pop () = + (decr arg_stack_top; + if !arg_stack_top < 0 then + (arg_stack_top := 0; NONE) + else let val res = Array.sub(arg_stack,!arg_stack_top) in + SOME res + end) + +(* Functions for handling two-dimensional C arrays *) +type cArray = { + arr : MLton.Pointer.t, + cols : int, + rows : int +} + +fun cArray2Sub (iaa : cArray) (m : int) (n : int) : Word32.word = + let val rowstart = m*(#cols iaa) in + MLton.Pointer.getWord32 (#arr iaa, rowstart + n) + end + +(* This is used for pattern matching all the different Pluses and Minuses. + Ocaml is much better in this regard *) +datatype stupidBop = Plus | Minus | Normal of bop + +fun bopToSBop bop = case bop of + PlusA => Plus +| PlusPI => Plus +| IndexPI => Plus +| MinusA => Minus +| MinusPI => Minus +| MinusPP => Minus +| _ => Normal bop + +datatype visitAction = DoChildren | ChangeTo of exp + +fun visitExp (f : exp -> visitAction) (e : exp) : exp = + let + fun visitChildren (e : exp) : exp = case e of + BinOp(bop,e1,e2) => BinOp(bop,visitExp f e1, visitExp f e2) + | UnOp(bop,e) => UnOp(bop,visitExp f e) + | _ => e + in + case f e of + DoChildren => visitChildren e + | ChangeTo e => e + end + +fun symResolve (cop : word) (sop : word) (typ : word) (sz : word) : exp = + if sop = 0wx0 then mkConst(cop,typ,sz) else + case (symStateLookup sop, taintSetFind sop sop) of + (NONE, NONE) => mkConst(cop,typ,sz) + | (NONE, SOME(_,_,{uid,file,line})) => + mkInput(sop,0wx0,0wx0,uid,cop,typ,sz,file,line) + | (SOME e,_) => e + +(* Functions imported from C *) +val cMain = _import "cMain": int * string vector -> int; + +val c_eval_bop = _import "c_eval_bop": + word * word * word * word * word * word * word + -> word; + +val c_eval_uop = _import "c_eval_uop": + word * word * word * word + -> word; + +fun assignBasic (dest : word) + (cop : word) (sop : word) (typ : word) (sz : word) + : unit + = + if sop = 0wx0 + then symStateRm dest + else case symStateLookup sop of + NONE => (symStateRm dest; + case taintSetFind sop sop of + NONE => () + | SOME(l,h,{uid,file,line}) => + symStateAdd dest (mkInput(sop,0wx0,0wx0,uid,cop,typ,sz,file,line))) + | SOME e => symStateAdd dest e + +datatype side = Left | Right + +fun assocConst (ib : bop) (ob : bop) (e1 : exp) (e2 : exp) + (cop,sop,typ,sz) (s : side) + : exp + = + case (bopToSBop ib, bopToSBop ob, e1, e2) of + (Plus, Plus, _, Const{value=cop2,typ=typ2,sz=sz2}) => + let val c = c_eval_bop(bopToWord ob,cop2,typ2,sz2,cop,typ,sz) in + BinOp(ib,e1,mkConst(c,typ2,sz2)) + end + | (Plus, Plus, Const{value=cop1,typ=typ1,sz=sz1}, _) => + let val c = c_eval_bop(bopToWord ob,cop1,typ1,sz1,cop,typ,sz) in + BinOp(ib,mkConst(c,typ1,sz1),e2) + end + | (Minus, Minus, _, Const{value=cop2,typ=typ2,sz=sz2}) => + let val c = c_eval_bop(bopToWord PlusA,cop2,typ2,sz2,cop,typ,sz) in + case s of + Right => BinOp(ib,e1,mkConst(c,typ2,sz2)) + | Left => BinOp(ib,mkConst(c,typ2,sz2),e1) + end + | (Normal(Mult), Normal(Mult), _, Const{value=cop2,typ=typ2,sz=sz2}) => + let val c = c_eval_bop(bopToWord ob,cop2,typ2,sz2,cop,typ,sz) in + BinOp(ib,e1,mkConst(c,typ2,sz2)) + end + | (Normal(Mult), Normal(Mult), Const{value=cop1,typ=typ1,sz=sz1}, _) => + let val c = c_eval_bop(bopToWord ob,cop1,typ1,sz1,cop,typ,sz) in + BinOp(ib,mkConst(c,typ1,sz1),e2) + end + | (Plus, Normal(Mult), Const{value=cop1,typ=typ1,sz=sz1}, _) => + let val c = c_eval_bop(bopToWord ob,cop1,typ1,sz1,cop,typ,sz) in + BinOp(ib,mkConst(c,typ1,sz1), BinOp(ob,e2,mkConst(cop, typ, sz))) + end + | (Minus, Normal(Mult), Const{value=cop1,typ=typ1,sz=sz1}, _) => + let val c = c_eval_bop(bopToWord ob,cop1,typ1,sz1,cop,typ,sz) in + BinOp(ib,mkConst(c,typ1,sz1), BinOp(ob,e2,mkConst(cop, typ, sz))) + end + | (Plus, Normal(Mult), _, Const{value=cop2,typ=typ2,sz=sz2}) => + let val c = c_eval_bop(bopToWord ob,cop2,typ2,sz2,cop,typ,sz) in + BinOp(ib,BinOp(ob,e1,mkConst(cop, typ, sz)), mkConst(c,typ2,sz2)) + end + | (Minus, Normal(Mult), _, Const{value=cop2,typ=typ2,sz=sz2}) => + let val c = c_eval_bop(bopToWord ob,cop2,typ2,sz2,cop,typ,sz) in + BinOp(ib,BinOp(ob,e1,mkConst(cop, typ, sz)),mkConst(c,typ2,sz2)) + end + | (_, _, _, _) => + ( + case s of + Right => BinOp(ob,BinOp(ib,e1,e2),mkConst(cop, typ, sz)) + | Left => BinOp(ob,mkConst(cop, typ, sz),BinOp(ib,e1,e2))) + +fun simplBop (b : bop) + (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + : exp option + = + case (symStateLookup sop1, symStateLookup sop2) of + (NONE, NONE) => + (case (taintSetFind sop1 sop1, taintSetFind sop2 sop2) of + (NONE,NONE) => NONE + | (SOME(_,_,{uid,file,line}),NONE) => + SOME(BinOp(b,mkInput(sop1,0wx0,0wx0,uid,cop1,typ1,sz1,file,line), + mkConst(cop2,typ2,sz2))) + | (NONE,SOME(_,_,{uid,file,line})) => + SOME(BinOp(b,mkConst(cop1,typ1,sz1), + mkInput(sop2,0wx0,0wx0,uid,cop2,typ2,sz2,file,line))) + | (SOME(_,_,{uid=i1,file=f1,line=l1}),SOME(_,_,{uid=i2,file=f2,line=l2})) => + SOME(BinOp(b,mkInput(sop1,0wx0,0wx0,i1,cop1,typ1,sz1,f1,l1), + mkInput(sop2,0wx0,0wx0,i2,cop2,typ2,sz2,f2,l2)))) + | (SOME(oe1 as BinOp(ib,e1,e2)), NONE) => + (case taintSetFind sop2 sop2 of + NONE => + SOME(assocConst ib b e1 e2 (cop2,sop2,typ2,sz2) Right) + | SOME(_,_,{uid,file,line}) => + SOME(BinOp(b,oe1,mkInput(sop2,0wx0,0wx0,uid,cop2,typ2,sz2,file,line)))) + | (SOME e, NONE) => + (case taintSetFind sop2 sop2 of + NONE => + SOME(BinOp(b,e,mkConst(cop2,typ2,sz2))) + | SOME(_,_,{uid,file,line}) => + SOME(BinOp(b,e,mkInput(sop2,0wx0,0wx0,uid,cop2,typ2,sz2,file,line)))) + | (NONE, SOME(oe2 as BinOp(ib,e1,e2))) => + (case taintSetFind sop1 sop1 of + NONE => + SOME(assocConst ib b e1 e2 (cop1,sop1,typ1,sz1) Left) + | SOME(_,_,{uid,file,line}) => + SOME(BinOp(b,mkInput(sop1,0wx0,0wx0,uid,cop1,typ1,sz1,file,line),oe2))) + | (NONE, SOME e) => + (case taintSetFind sop1 sop1 of + NONE => + SOME(BinOp(b,mkConst(cop1,typ1,sz1),e)) + | SOME(_,_,{uid,file,line}) => + SOME(BinOp(b,mkInput(sop1,0wx0,0wx0,uid,cop1,typ1,sz1,file,line),e))) + (*| (SOME(BinOp(ib1,e11,e12)), SOME(BinOp(ib1,e21,e22))) =>*) + | (SOME e1, SOME e2) => SOME(BinOp(b,e1,e2)) + +fun assignBop (dest : word) (bop : word) + (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + : unit + = + if sop1 = (Word.fromInt 0) andalso sop2 = (Word.fromInt 0) + then symStateRm dest + else let + val res = simplBop (wordToBop bop) cop1 sop1 typ1 sz1 cop2 sop2 typ2 sz2 + in + case res of + NONE => symStateRm dest + | SOME res => symStateAdd dest res + end + +fun simplUop (u : uop) + (cop : word) (sop : word) (typ : word) (sz : word) + : exp option + = + case symStateLookup sop of + NONE => NONE + | SOME e => SOME(UnOp(u,e)) + +fun assignUop (dest : word) (uop : word) + (cop : word) (sop : word) (typ : word) (sz : word) + : unit + = + if sop = (Word.fromInt 0) + then symStateRm dest + else let + val res = simplUop (wordToUop uop) cop sop typ sz + in + case res of + NONE => symStateRm dest + | SOME res => symStateAdd dest res + end + +fun assignCast (dest : word) + (cop : word) (sop : word) (typ : word) (sz : word) + : unit + = assignBasic dest cop sop typ sz + +(*fun forget_locals () : unit = + let + fun forget (sop,_) : unit = + (symStateRm sop; + if taintSetExists sop sop then taintSetRm sop sop else ()) + in + (case (!locals_stack) of + [] => () + | x :: rst => (foldl forget () x; + locals_stack := rst)) + end*) + +fun retBasic (cop : word) (sop : word) (typ : word) (sz : word) : unit = + case symStateLookup sop of + NONE => + (case taintSetFind sop sop of + NONE => ret_val := NONE + | SOME(l,h,{uid,file,line}) => + (print "retBasic: making Input\n"; + ret_val := SOME(mkInput(sop,0wx0,0wx0,uid,cop,typ,sz,file,line)))) + | SOME e => ret_val := SOME e + +fun retBop (bop : word) + (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + : unit + = + case simplBop (wordToBop bop) cop1 sop1 typ1 sz1 cop2 sop2 typ2 sz2 of + NONE => + ret_val := NONE + | SOME e => ret_val := SOME e + +fun retUop (uop : word) + (cop : word) (sop : word) (typ : word) (sz : word) + : unit + = + case simplUop (wordToUop uop) cop sop typ sz of + NONE => ret_val := NONE + | SOME e => ret_val := SOME e + +fun retVoid () : unit = () + +fun ifBasic (cop : word) (sop : word) (typ : word) (sz : word) + (file : word) (line : word) + : unit + = () + +fun ifBop (bop : word) + (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + (file : word) (line : word) + : unit + = + case simplBop (wordToBop bop) cop1 sop1 typ1 sz1 cop2 sop2 typ2 sz2 of + NONE => () + | SOME(BinOp(bop,e1,e2)) => + let val b = c_eval_bop(bopToWord bop,cop1,typ1,sz1,cop2,typ2,sz2) + val bop = if b = 0wx0 then negate_bop bop else bop in + ((*print "Branch: "; + print_canexp (canonExp 1 e1); + print " "; + print_bop bop;*) + addBopToOct cOctagon bop e1 e2 file line(*; + print " "; + print_canexp (canonExp 1 e2); + print "\n"*)) + end + | SOME e => (print_exp e; print "\n") + +fun ifUop (uop : word) + (cop : word) (sop : word) (typ : word) (sz : word) + (file : word) (line : word) + : unit + = () + +fun switchBasic (c : word) + (cop : word) (sop : word) (typ : word) (sz : word) + : unit + = () + +fun switchBop (c : word) (bop : word) + (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + : unit + = () + +fun switchUop (c : word) (uop : word) + (cop : word) (sop : word) (typ : word) (sz : word) + : unit + = () + +fun pushArg (cop : word) (sop : word) (typ : word) (sz : word) : unit = + arg_stack_push (cop,sop,typ,sz) + +fun unRegLocal (sop : word) (typ : word) (sz : word) : unit = + symStateRm sop + +fun popArg (dest : word) : unit = + let val argo = arg_stack_pop () in + case argo of + NONE => () + | SOME(cop,sop,typ,sz) => + assignBasic dest cop sop typ sz + end + +fun funStart (nargs : word) : unit = + incr call_depth + +fun retPop (cop : word) (sop : word) (typ : word) (sz : word) (nargs : word) + : unit + = + (arg_stack_top := 0; + case !ret_val of + NONE => symStateRm sop + | SOME e => symStateAdd sop e) + +fun retNoRet (nargs : word) : unit = + (arg_stack_top := 0) + + +fun addTaint (start : word) (esz : word) (ecnt : word) + (file : word) (line : word) + : unit + = + taintSetAdd start esz ecnt file line + +fun addCondTaint (src : word) (dst : word) (f : word) + (cop : word) (typ : word) (sz : word) + (file: word) (line : word) + : unit + = + case taintSetFind src src of + NONE => + (case symStateLookup src of + SOME(Input id) => + symStateAdd dst (mkInput((#addr id),dst,f,(#uid id),cop,typ,sz,file,line)) + | _ => print("Not Adding CTaint: "^(Word.toString dst)^"\n")) + | SOME(_,_,{uid,...}) => + (print("Adding CTaint: "^(Word.toString dst)^"\n"); + symStateAdd dst (mkInput(src,dst,f,uid,cop,typ,sz,file,line))) + + +(* See if the octagon has enough information to prove that + (e1 bop e2) is true *) +fun checkAssertion (b : bop) (e1 : exp) (e2 : exp) : unit = + let + val newoct = copyOct cOctagon + in + addBopToOct newoct b e1 e2 0wx0 0wx0; + (if c_oct_is_included_in (!(#oct cOctagon),!(#oct newoct)) andalso + not(c_oct_is_empty (!(#oct newoct))) andalso + not(c_oct_is_universe (!(#oct newoct))) + then + print "program checks sufficient!\n" + else + print "program checks NOT sufficient!\n"); + c_oct_free (!(#oct newoct)) + end + +datatype cex = Lower of int | Upper of int | Both of (int * int) + +fun print_cex (bnd : cex) : unit = + case bnd of + Lower l => + print((Int.toString l)^" <= input") + | Upper u => + print("input <= "^(Int.toString u)) + | Both(l,u) => + print((Int.toString l)^" <= input <= "^(Int.toString u)) + +fun warnAboutCE (bnd : cex) (vid : int) (file : word) (line : word) : unit = + case IHT.find oVarInpHash vid of + NONE => () + | SOME id => + let + val ifile = (#file id) + val iline = (#line id) + in + print "For input from: "; + c_print_loc(ifile,iline); + print "\n"; + print "The check(s): "; + printInpChecks vid; + print "\n"; + print "Must be strengthened because the memory op at: "; + c_print_loc(file,line); + print "\n"; + print "Will fail when: "; + print_cex bnd; + print "\n" + end + +fun printCounterExample (newoct : octagon) (oldoct : octagon) + (file : word) (line : word) + : unit + = + let + val newdim = !(#maxvars newoct) + val newbox = Array.array (2*newdim, 0) + val newvalid = Array.array (2*newdim, 0) + val olddim = !(#maxvars oldoct) + val oldbox = Array.array (2*olddim, 0) + val oldvalid = Array.array (2*olddim, 0) + fun loop (i : int) : unit = + if i >= newdim then () else let + val newlowo = + if Array.sub(newvalid,2*i+1) = 0 + then NONE else + SOME(Array.sub(newbox,2*i + 1)) + val newhio = + if Array.sub(newvalid,2*i) = 0 + then NONE else + SOME(Array.sub(newbox,2*i)) + val oldlowo = + if i >= olddim orelse Array.sub(oldvalid,2*i+1) = 0 + then NONE else + SOME(Array.sub(oldbox,2*i+1)) + val oldhio = + if i >= olddim orelse Array.sub(oldvalid,2*i) = 0 + then NONE else + SOME(Array.sub(oldbox,2*i)) + in + (case (newlowo,newhio) of + (NONE, NONE) => () + | (SOME lo, NONE) => + if newlowo = oldlowo then () else + warnAboutCE (Lower (~lo)) i file line + | (NONE, SOME hi) => + if newhio = oldhio then () else + warnAboutCE (Upper hi) i file line + | (SOME lo, SOME hi) => + if newlowo = oldlowo andalso newhio = oldhio then () else + warnAboutCE (Both(~lo,hi)) i file line); + loop (i+1) + end + in + c_oct_get_box(!(#oct newoct),newbox,newvalid); + c_oct_get_box(!(#oct oldoct),oldbox,oldvalid); + (*print "Check will fail when\n";*) + (loop 0) handle Subscript => + (print "Subscript raised in printCounterExample\n"; + raise Subscript) + end + +(* Find values for inputs allowed by the octagon that + that cause (e1 bop e2) to be false *) +fun findCounterExamples (b : bop) (e1 : exp) (e2 : exp) + (file : word) (line : word) + : unit + = + let + val newoct = copyOct cOctagon + in + addBopToOct newoct (negate_bop b) e1 e2 0wx0 0wx0; + (if c_oct_is_empty (!(#oct newoct)) + then () + (*print "There are NO counterexamples!\n"*) + else + (print "There are counterexamples!\n"; + printCounterExample newoct cOctagon file line)); + c_oct_free (!(#oct newoct)) + end + + +(* Check functions! *) +fun cLeq (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + (file : word) (line : word) + : unit + = + case simplBop Le cop1 sop1 typ1 sz1 cop2 sop2 typ2 sz2 of + SOME(BinOp(bop,e1,e2)) => + ((*checkAssertion bop e1 e2;*) + findCounterExamples bop e1 e2 file line) + | _ => () + +(* assert(op1 <= op2 + op3) *) +fun cLeqSum (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + (cop3 : word) (sop3 : word) (typ3 : word) (sz3 : word) + (file : word) (line : word) + : unit + = + let + val low = symResolve cop1 sop1 typ1 sz1 + in + case simplBop PlusPI cop2 sop2 typ2 sz2 cop3 sop3 typ3 sz3 of + NONE => (case low of Const _ => () | _ => + let val c = c_eval_bop(bopToWord PlusPI,cop2,typ2,sz2,cop3,typ3,sz3) in + (*checkAssertion Le low (mkConst(c,typ2,sz2));*) + findCounterExamples Le low (mkConst(c,typ2,sz2)) file line + end) + | SOME e => + ((*checkAssertion Le low e;*) + findCounterExamples Le low e file line) + end + +(* assert(op1 + op2 <= op3) *) +fun cSumLeq (cop1 : word) (sop1 : word) (typ1 : word) (sz1 : word) + (cop2 : word) (sop2 : word) (typ2 : word) (sz2 : word) + (cop3 : word) (sop3 : word) (typ3 : word) (sz3 : word) + (file : word) (line : word) + : unit + = + let + val hi = symResolve cop3 sop3 typ3 sz3 + in + case simplBop PlusPI cop1 sop1 typ1 sz1 cop2 sop2 typ2 sz2 of + NONE => (case hi of Const _ => () | _ => + let val c = c_eval_bop(bopToWord PlusPI,cop1,typ1,sz1,cop2,typ2,sz2) in + (*checkAssertion Le (mkConst(c,typ1,sz1)) hi;*) + findCounterExamples Le (mkConst(c,typ1,sz1)) hi file line + end) + | SOME e => + ((*checkAssertion Le e hi;*) + findCounterExamples Le e hi file line) + end + +val instr_count = ref (Word64.fromInt 0) +fun instrDispatch (iaa : cArray) (row : int) : unit = + (instr_count := (Word64.fromInt 1) + (!instr_count); + let fun lu (c : int) = cArray2Sub iaa row c in + (case (Word32.toInt (lu 0)) of + 0 => assignBasic (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + | 10 => assignBop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + (lu 6) (lu 7) (lu 8) (lu 9) (lu 10) + | 20 => assignUop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) (lu 6) + | 30 => assignCast (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + | 40 => retBasic (lu 1) (lu 2) (lu 3) (lu 4) + | 50 => retBop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + (lu 6) (lu 7) (lu 8) (lu 9) + | 60 => retUop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + | 70 => retVoid () + | 80 => ifBasic (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) (lu 6) + | 90 => ifBop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + (lu 6) (lu 7) (lu 8) (lu 9) (lu 10) (lu 11) + | 100 => ifUop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) (lu 6) (lu 7) + | 110 => switchBasic (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + | 120 => switchBop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + (lu 6) (lu 7) (lu 8) (lu 9) (lu 10) + | 130 => switchUop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) (lu 6) + | 140 => pushArg (lu 1) (lu 2) (lu 3) (lu 4) + | 150 => popArg (lu 1) + | 160 => funStart (lu 1) + | 170 => retPop (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + | 180 => retNoRet (lu 1) + | 190 => unRegLocal (lu 1) (lu 2) (lu 3) + | 200 => addTaint (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + | 210 => addCondTaint (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + (lu 6) (lu 7) (lu 8) + | 220 => cLeq (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) + (lu 6) (lu 7) (lu 8) (lu 9) (lu 10) + | 230 => cLeqSum (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) (lu 6) + (lu 7) (lu 8) (lu 9) (lu 10) (lu 11) (lu 12) + (lu 13) (lu 14) + | 240 => cSumLeq (lu 1) (lu 2) (lu 3) (lu 4) (lu 5) (lu 6) + (lu 7) (lu 8) (lu 9) (lu 10) (lu 11) (lu 12) + (lu 13) (lu 14) + | _ => ()) handle Overflow => + (print("instrDispatch: Overflow\n"); + raise Overflow) + end) + + +(* Function exported to C *) +val e = _export "process_instrs": (MLton.Pointer.t * int * int -> unit) -> unit; +fun at ((iaa : MLton.Pointer.t),(m : int),(n : int)) : unit = + let val carr = {arr = iaa, cols = n, rows = m} in + let fun loop (i:int) = + if i >= m then () else + (instrDispatch carr i; + loop (i+1)) + in + (loop 0) + end + end +val _ = e at + +val arg_list = (CommandLine.name())::(CommandLine.arguments()) +val arg_list = map (fn s => s^"\000") arg_list +val arg_vec = vector arg_list +val exit_code = cMain (length (CommandLine.arguments())+1, arg_vec) diff --git a/obj/.depend/.cvsignore b/obj/.depend/.cvsignore new file mode 100644 index 0000000..72e8ffc --- /dev/null +++ b/obj/.depend/.cvsignore @@ -0,0 +1 @@ +* diff --git a/obj/x86_LINUX/.cvsignore b/obj/x86_LINUX/.cvsignore new file mode 100644 index 0000000..72e8ffc --- /dev/null +++ b/obj/x86_LINUX/.cvsignore @@ -0,0 +1 @@ +* diff --git a/obj/x86_WIN32/.cvsignore b/obj/x86_WIN32/.cvsignore new file mode 100644 index 0000000..72e8ffc --- /dev/null +++ b/obj/x86_WIN32/.cvsignore @@ -0,0 +1 @@ +* diff --git a/rpm/deputy.spec b/rpm/deputy.spec new file mode 100644 index 0000000..f740396 --- /dev/null +++ b/rpm/deputy.spec @@ -0,0 +1,43 @@ +Summary: Deputy +Name: deputy +Version: 1.1 +Release: 1 +Source0: %{name}-%{version}.tar.gz +License: BSD +Group: Development/Languages +BuildRoot: %{_tmppath}/%{name}-%{version}-%{release} +AutoReq: no +AutoProv: no +Requires: perl >= 5.6.1, perl(FindBin), gcc >= 4 +Provides: deputy = 1.1 +%description +Deputy is an advanced C compiler that enforces memory and type safety in C +programs using annotations supplied by the programmer. +%prep +%setup -q +%build +./configure +make +%install +rm -rf $RPM_BUILD_ROOT +make install DESTDIR=$RPM_BUILD_ROOT +make install-man DESTDIR=$RPM_BUILD_ROOT +%clean +rm -rf $RPM_BUILD_ROOT +%files +%defattr(-,root,root) +/usr/local/bin/deputy +/usr/local/lib/deputy/bin/deputy +/usr/local/lib/deputy/bin/deputy.asm.exe +/usr/local/lib/deputy/bin/deputy.byte.exe +/usr/local/lib/deputy/lib/CilConfig.pm +/usr/local/lib/deputy/lib/Cilly.pm +/usr/local/lib/deputy/lib/Deputy.pm +/usr/local/lib/deputy/lib/KeptFile.pm +/usr/local/lib/deputy/lib/TempFile.pm +/usr/local/lib/deputy/lib/OutputFile.pm +/usr/local/lib/deputy/lib/deputy_libc.o +/usr/local/lib/deputy/include/libc_patch.i +/usr/local/lib/deputy/include/deputy/annots.h +/usr/local/lib/deputy/include/deputy/checks.h +%doc %attr(0444,root,root) /usr/local/man/man1/deputy.1.gz diff --git a/src/dattrs.ml b/src/dattrs.ml new file mode 100755 index 0000000..eda05c2 --- /dev/null +++ b/src/dattrs.ml @@ -0,0 +1,1169 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 Expcompare +open Pretty +open Doptions +open Dutil + +module E = Errormsg +module H = Hashtbl +module IH = Inthash +module VS = Usedef.VS + +let getZeroOneAttr (names: string list) (attrs: attributes) : attribute option = + let filter = + List.filter (fun (Attr (name, _)) -> List.mem name names) attrs + in + match filter with + | [attr] -> Some attr + | [] -> None + | _ -> E.s (error "Too many attributes: %a." (docList text) names) + +let getOneAttr (names: string list) (attrs: attributes) : attribute = + match getZeroOneAttr names attrs with + | Some attr -> attr + | None -> E.s (bug "Couldn't find attribute: %a." (docList text) names) + +let isNullterm (t: typ) : bool = + match unrollType t with + | TPtr (_, a) + | TArray (_, _, a) -> hasAttribute "nullterm" a + | TInt _ -> false (* Treat integer type like void*. *) + | _ -> E.s (bug "Expected pointer type: %a" d_type t) + +let isNulltermDrop (t: typ) : bool = + match unrollType t with + | TPtr (_, a) -> hasAttribute "ntdrop" a + | _ -> false + +let isNulltermExpand (t: typ) : bool = + match unrollType t with + | TPtr (_, a) -> hasAttribute "ntexpand" a + | _ -> false + +let isSizePtr (t: typ) : bool = + match unrollType t with + | TPtr (_, a) -> hasAttribute "size" a || hasAttribute "fancysize" a + | _ -> false + +let isTrustedAttr (attr: attributes) : bool = + hasAttribute "trusted" attr + +let isTrustedType (t: typ) : bool = + isTrustedAttr (typeAttrs t) + +let isTrustedComp (ci: compinfo) : bool = + isTrustedAttr ci.cattr + +let isNonnullType (t:typ) : bool = + hasAttribute "nonnull" (typeAttrs t) + +let isHiddenVar (vi: varinfo) : bool = + vi.vdescr <> nil || + hasAttribute "hidden" vi.vattr + +let rec typeContainsNonnull (t: typ) : bool = + (isNonnullType t) || + (match t with + | TPtr _ + | TFun _ + | TBuiltin_va_list _ + | TVoid _ + | TInt _ + | TFloat _ + | TEnum _ -> false + | TArray (bt, _, _) -> typeContainsNonnull bt + | TNamed (ti, _) -> typeContainsNonnull ti.ttype + | TComp (ci, _) -> + not ci.cdefined || + List.exists (fun fld -> typeContainsNonnull fld.ftype) ci.cfields) + +(* Keyword in bounds attributes representing the current value *) +let thisKeyword = "__this" + +(* Keyword in bounds attributes representing the automatic bounds *) +let autoKeyword = "__auto" + +(* Note that we use PlusA here instead of PlusPI in order to match actual + * annotations as parsed by CIL. *) +let countAttr (a: attrparam) : attribute = + Attr ("bounds", [ACons (thisKeyword, []); + ABinOp (PlusA, ACons (thisKeyword, []), a)]) + +let count0Attr : attribute = + countAttr (AInt 0) + +let sizeAttr (a: attrparam) : attribute = + Attr ("size", [a]) + +let safeAttr : attribute = + countAttr (AInt 1) + +let nulltermAttr : attribute = + Attr ("nullterm", []) + +let autoAttr : attribute = + Attr ("bounds", [ACons (autoKeyword, []); ACons (autoKeyword, [])]) + +let autoEndAttr : attribute = + Attr ("bounds", [ACons (thisKeyword, []); ACons (autoKeyword, [])]) + +(* NTS == NULLTERM COUNT(0) *) +let stringAttrs : attributes = + addAttribute nulltermAttr [count0Attr] + +let trustedAttr : attribute = + Attr ("trusted", []) + +let sentinelAttr : attribute = + Attr ("sentinel", []) + +let hiddenAttr : attribute = + Attr ("hidden", []) + +(* SNT == COUNT(0) + the "sentinel" qualifier *) +let sentinelAttrs : attributes = + addAttribute sentinelAttr [count0Attr] + +let isSentinelType (t:typ): bool = + let res = hasAttribute "sentinel" (typeAttrs t) in + if res && not (isPointerType t) then + (error "SNT attribute on a non-pointer type %a.\n" d_type t); + res + +let isConstType (t:typ): bool = + hasAttribute "assumeconst" (typeAttrs t) + +(* This attr means that the ptr was an unannotated global/field/etc + that we assumed to be SAFE/NTS, as opposed to those that are annotated + SAFE/NTS *) +let missingAnnotAttr : attribute = Attr ("missing_annot", []) +let hasDefaultAnnot (a:attributes) : bool = + hasAttribute "missing_annot" a + +let isAllocator (t: typ) : bool = + let attrs = typeAttrs t in + hasAttribute "dalloc" attrs || hasAttribute "drealloc" attrs + +let isMemset (t: typ) : bool = + hasAttribute "dmemset" (typeAttrs t) + +let isMemcpy (t: typ) : bool = + hasAttribute "dmemcpy" (typeAttrs t) + +let isMemcmp (t: typ) : bool = + hasAttribute "dmemcmp" (typeAttrs t) + +(* Is this a function with special handling in the typechecker? *) +let isSpecialFunction (t:typ): bool = + (isAllocator t) || (isMemset t) || (isMemcpy t) || (isMemcmp t) + +(**************************************************************************) + + +let allGlobalVars : varinfo list ref = ref [] + +(** constGlobalVars is the subset of allGlobalVars which have constant + types. We allow anything to depend on these values. + FIXME: this is unsound, since const is not enforced. *) +let constGlobalVars : varinfo list ref = ref [] + +let registerGlobal (vi:varinfo): unit = + assert(vi.vglob); + allGlobalVars := vi :: !allGlobalVars; + if isConstType vi.vtype then + constGlobalVars := vi :: !constGlobalVars; + () + +let isGlobalArray (name:string): bool = + List.exists (fun vi -> vi.vname = name && isArrayType vi.vtype) + !allGlobalVars + +(* If the user passes --deputyglobaldeps to Deputy, we'll allow non-static + globals to depend on each other. This is unsound unless all files see + all relevant dependencies. *) +let globalsEnv (vi:varinfo) : varinfo list = + assert (vi.vglob); +(* if !allowAllGlobalDeps then *) + !allGlobalVars +(* else if vi.vstorage = Static then *) +(* !staticGlobalVars *) +(* else *) +(* [vi] (\* can depend only on itself *\) *) + + +(**************************************************************************) + + +(* remember complicated bounds expressions *) +let boundsTable : exp IH.t = IH.create 13 +let boundsTableCtr : int ref = ref 0 + +(* expectedType is the type of the pointer that depends on this + expression. We'll cast to this type so that pointer arithmetic works. *) +let addBoundsExp ~(expectedType:typ) (e: exp) : int = + (* First, cast the bound expression e to the expected type *) + let e': exp = + let boundType = typeOf e in + if compareTypes ~ignoreSign:false boundType expectedType + || isArrayType expectedType then + (* no cast needed *) + e + else if (isPtrOrArray boundType) && (isPointerType expectedType) then + begin + let boundBase = baseType "addBoundsExp" boundType in + let ptrBase = baseType "addBoundsExp" expectedType in + if compareTypes ~ignoreSign:false boundBase ptrBase then + (* no cast needed *) + e + else if ( (not (typeContainsPointers boundBase)) + && (not (typeContainsPointers ptrBase))) + || (bitsSizeOf boundBase) = (bitsSizeOf ptrBase) then + begin + (* Cast the bound to the pointer's type *) + mkCastT ~e:e ~oldt:boundType ~newt:expectedType + end + else begin + (* Maybe we should do this check in checkType? *) + error "The base type of a pointer differs from the base type of its bound expressions."; + e + end + end + else begin + (* Cast between an integer and a pointer. Is it okay to use + an int as the bound of a pointer? *) + mkCastT ~e:e ~oldt:boundType ~newt:expectedType + end + in + incr boundsTableCtr; + if !verbose then + E.log "%a: fancybounds(%d) = %a.\n" d_loc !currentLoc + !boundsTableCtr d_exp e'; + IH.add boundsTable !boundsTableCtr e'; + !boundsTableCtr + +let getBoundsExp (n: int) : exp = + try + IH.find boundsTable n + with Not_found -> + E.s (bug "Couldn't look up expression in bounds table") + +let clearBoundsTable () : unit = + IH.clear boundsTable; + boundsTableCtr := 0 + +type paramkind = +| PKNone +| PKThis +| PKOffset of attrparam + +let rec checkParam (ap: attrparam) : paramkind = + match ap with + | ACons (name, []) when name = thisKeyword -> PKThis + | ABinOp (PlusA, a1, a2) when checkParam a1 = PKThis -> + if a2 = AInt 0 then PKThis else PKOffset a2 + | _ -> PKNone + +class deputyPrinterClass ~(showBounds: bool) ~(enable: bool) : descriptiveCilPrinter = +object (self) + inherit descriptiveCilPrinterClass enable as super + + method pExp () (e: exp) : doc = + let truncate s = + if String.length s > 40 then + "\"" ^ String.sub s 0 36 ^ "\" ..." + else + "\"" ^ s ^ "\"" + in + match e with + | Const (CStr s) -> + text (truncate (Escape.escape_string s)) + | Const (CWStr s) -> + let s' = + List.fold_left + (fun acc elt -> + let elt' = + if (elt >= Int64.zero && + elt <= (Int64.of_int 255)) then + Escape.escape_char (Char.chr (Int64.to_int elt)) + else + Printf.sprintf "\\x%LX\" \"" elt + in acc ^ elt') + "" s + in + text ("L" ^ truncate s') + | _ -> super#pExp () e + + method pAttr (Attr (an, args) : attribute) : doc * bool = + match an, args with + | "fancybounds", [AInt i1; AInt i2] -> + if showBounds then + dprintf "BND(%a, %a)" self#pExp (getBoundsExp i1) + self#pExp (getBoundsExp i2), false + else + text "BND(...)", false + | "bounds", [a1; a2] -> + begin + match checkParam a1, checkParam a2 with + | PKThis, PKThis -> + text "COUNT(0)", false + | PKThis, PKOffset (AInt 1) -> + text "SAFE", false + | PKThis, PKOffset a -> + if showBounds then + dprintf "COUNT(%a)" self#pAttrParam a, false + else + text "COUNT(...)", false + | _ -> + if showBounds then + dprintf "BND(%a, %a)" self#pAttrParam a1 + self#pAttrParam a2, false + else + text "BND(...)", false + end + | "fancysize", [AInt i] -> + dprintf "SIZE(%a)" self#pExp (getBoundsExp i), false + | "size", [a] -> + dprintf "SIZE(%a)" self#pAttrParam a, false + | "fancywhen", [AInt i] -> + dprintf "WHEN(%a)" self#pExp (getBoundsExp i), false + | "when", [a] -> + dprintf "WHEN(%a)" self#pAttrParam a, false + | "nullterm", [] -> + text "NT", false + | "assumeconst", [] -> + text "ASSUMECONST", false + | "trusted", [] -> + text "TRUSTED", false + | "copytype", [] -> + text "COPYTYPE", false + | "typaram", [ASizeOf t] -> + dprintf "TP(%a)" (self#pType None) t, false + | "sentinel", [] -> + text "SNT", false + | "nonnull", [] -> + text "NONNULL", false + | "dalloc", [a] -> + dprintf "DALLOC(%a)" self#pAttrParam a, false + | "dmemset", [AInt i1; AInt i2; AInt i3] -> + dprintf "DMEMSET(%d, %d, %d)" i1 i2 i3, false + | "dmemcpy", [AInt i1; AInt i2; AInt i3] -> + dprintf "DMEMCPY(%d, %d, %d)" i1 i2 i3, false + | "dmemcmp", [AInt i1; AInt i2; AInt i3] -> + dprintf "DMEMCMP(%d, %d, %d)" i1 i2 i3, false + | "_ptrnode", [AInt n] -> + if !Doptions.emitGraphDetailLevel >= 3 && showBounds then + dprintf "NODE(%d)" n, false + else + nil, false + | "missing_annot", _-> (* Don't bother printing thess *) + nil, false + | "ntdrop", [] -> + text "NTDROP", false + | ("always_inline" | "section" | "format" | + "noreturn" | "regparm" | "aligned"), _ -> + nil, false + | _ -> + super#pAttr (Attr (an, args)) + + method pType (nameOpt: doc option) () (t: typ) : doc = + match unrollType t with + | TPtr (TVoid _, attrs) when hasAttribute "tyvar" attrs -> + let name = + match nameOpt with + | Some name -> text " " ++ name + | None -> nil + in + let tyvar = + match filterAttributes "tyvar" attrs with + | Attr ("tyvar", [ACons (s, [])]) :: _ -> s + | _ -> E.s (bug "Unexpected attribute.") + in + dprintf "TV(%s)%a" tyvar insert name + | _ -> + super#pType nameOpt () t +end + +let deputyFilePrinter = new deputyPrinterClass ~showBounds:true ~enable:false +let deputyPrinter = new deputyPrinterClass ~showBounds:true ~enable:true + +let dx_type () (t: typ) : doc = + deputyPrinter#pType None () t + +let dx_exp () (e: exp) : doc = + deputyPrinter#pExp () e + +let dx_lval () (lv: lval) : doc = + deputyPrinter#pLval () lv + +let dx_instr () (i : instr) : doc = + deputyPrinter#pInstr () i + +let dx_global () (g : global) : doc = + deputyPrinter#pGlobal () g + +let dx_temps () : doc = + deputyPrinter#pTemps () + +let startTemps () : unit = + deputyPrinter#startTemps () + +let stopTemps () : unit = + deputyPrinter#stopTemps () + +let deputyTypePrinter = new deputyPrinterClass ~showBounds:false ~enable:true + +let dt_type () (t: typ) : doc = + deputyTypePrinter#pType None () t + +let dt_exp () (e: exp) : doc = + deputyTypePrinter#pExp () e + +let dt_lval () (lv: lval) : doc = + deputyTypePrinter#pLval () lv + +let dt_instr () (i : instr) : doc = + deputyTypePrinter#pInstr () i + +(** Terse printing: strip some casts from the expression. + We use this to make runtime errors more legible. *) +let dc_exp () e = + dx_exp () (deputyStripCastsForPtrArith e) + + +let addTempInfoSet (vi: varinfo) (e: exp) : unit = + vi.vdescr <- (dx_exp () e); + vi.vdescrpure <- true + +let addTempInfoCall (vi: varinfo) (fn: exp) (args: exp list) : unit = + vi.vdescr <- (dprintf "%a(%a)" dx_exp fn + (docList ~sep:(text ", ") (dx_exp ())) args); + vi.vdescrpure <- false + +(* Don't print leading or trailing underscores on attributes *) +class deputyPatchPrinterClass : cilPrinter = object (self) + inherit defaultCilPrinterClass as super + + method pAttr (a: attribute) : doc * bool = + let (d, b) = super#pAttr a in + let s = sprint ~width:1000 d in + let s = if String.length s >= 2 && + String.sub s 0 2 = "__" + then String.sub s 2 ((String.length s) - 2) + else s + in + let s = if String.length s >= 2 && + String.sub s ((String.length s) - 2) 2 = "__" + then String.sub s 0 ((String.length s) - 2) + else s + in + text s, b +end + +let deputyPatchPrinter = new deputyPatchPrinterClass + +let dp_global () (g : global) : doc = + printGlobal deputyPatchPrinter () g + + + +(**************************************************************************) + + +(* remember complicated WHEN expressions. For each union in each context, + we have a whenMap, which maps fields to the expanded when condition for that + field in the context. *) +type whenMap = (fieldinfo * exp) list +let whenTable : whenMap IH.t = IH.create 13 +let whenTableCtr : int ref = ref 0 +let d_whenMap () (wm:whenMap) : doc = + Pretty.align ++ + docList ~sep:line + (fun (f,e) -> text f.fname ++ text ": " ++ dx_exp () e) + () wm + ++ Pretty.unalign + +let addWhenMap (wm:whenMap) : int = + incr whenTableCtr; + if !verbose then + E.log "%a: fancywhen(%d) = [%a].\n" d_loc !currentLoc + !whenTableCtr d_whenMap wm; + IH.add whenTable !whenTableCtr wm; + !whenTableCtr + +let getWhenMap (n: int) : whenMap = + try + IH.find whenTable n + with Not_found -> + E.s (E.bug "couldn't look up %d in when table\n" n) + +(** If possible, determine statically which field is selected by this map. *) +let getSelectedField (wm:whenMap) : fieldinfo option = + let rec loop : (fieldinfo * exp) list -> fieldinfo option = function + (f, e)::rest -> begin + match isInteger (constFold true e) with + Some 0L -> (* constant false. *) + loop rest + | Some _ -> (* constant true. If every selector in rest is false, + we've found the field we're looking for. *) + let ensureSelectorIsFalse (f',e): bool = + match isInteger (constFold true e) with + Some 0L -> true (* okay *) + | Some _ -> + (* Fields f and f' are both selected. Warn the user. + This is an error unless the union is nulled. *) + warn "Setting this tag makes two fields active: %s and %s.\n" + f'.fname f.fname; + false + | None -> + (* We don't know whether this field is selected. + Be conservative. *) + false + in + let allFalse = List.for_all ensureSelectorIsFalse rest in + if allFalse then Some f else None + | None -> None (* not a constant *) + end + | [] -> None + in + loop wm + + +(**************************************************************************) + +let rec getDeps (a: attrparam) : string list = + match a with + | AInt k -> [] + | ASizeOf t -> [] + | ASizeOfE e -> [] + | ACons(name, []) -> + if isGlobalArray name then + [] (* This is really a depenency on a static address (StartOf name), + not a runtime value *) + else if List.exists (fun vi -> vi.vname = name) !constGlobalVars then + [] (* We don't count dependencies on const locations here, + because this global need not be in the context. *) + else + [name] + | ABinOp (_, e1, e2) -> (getDeps e1) @ (getDeps e2) + | AAddrOf a -> getDeps a (* matth: this is too conservative. + &name depends on nothing, but for other + values of a there could be dependencies *) + | AIndex (a1, a2) -> (getDeps a1) @ (getDeps a2) + | AUnOp(_, e1) -> getDeps e1 + | _ -> E.s (error "Cannot get dependencies for %a" d_attrparam a) + + +(** Gets the names on which the bounds of this type depends. + The type argument is just for error reporting. *) +let rec depsOfAttrs ~(missingBoundsOkay:bool) + (t:typ) (a: attributes) : string list = + let checkrest rest = + if hasAttribute "bounds" rest || + hasAttribute "fancybounds" rest || + hasAttribute "size" rest || + hasAttribute "fancysize" rest then + E.s (error "Type has duplicate bounds attributes: \"%a\"" dx_type t) + in + match a with + | Attr ("bounds", [lo; hi]) :: rest -> + checkrest rest; + (getDeps lo) @ (getDeps hi) + | Attr ("bounds", _) :: rest -> + E.s (error "Illegal bounds annotations on \"%a\"" dx_type t) + | Attr ("fancybounds", _) :: rest -> + E.s (bug "Can't get dependencies for fancybounds annotations") + | Attr ("size", [n]) :: rest -> + checkrest rest; + getDeps n + | Attr ("size", _) :: rest -> + E.s (error "Illegal size annotation on \"%a\"" dx_type t) + | Attr ("fancysize", _) :: rest -> + E.s (bug "Can't get dependencies for fancysize annotations") + | Attr _ :: rest -> + depsOfAttrs ~missingBoundsOkay t rest + | [] -> + if missingBoundsOkay then + [] + else + E.s (bug "Missing bounds information on \"%a\"" dx_type t) + +let rec getWhen (a: attributes) : attrparam = + let checkrest rest = + if hasAttribute "when" rest then + E.s (error "Field has more than one WHEN attribute") + in + match a with + | Attr ("when", [e]) :: rest -> + checkrest rest; + e + | Attr ("when", _) :: rest -> + E.s (error "Illegal when annotations.") + | Attr _ :: rest -> + getWhen rest + | [] -> + raise Not_found + +let depsOfWhenAttrs (a: attributes) : string list = + let w = getWhen a in + getDeps w + +let depsOfField (fld: fieldinfo) : string list = + try depsOfWhenAttrs fld.fattr + with Not_found -> [] + +let depsOfType ?(missingBoundsOkay=false) (t: typ) : string list = + match unrollType t with + | TPtr (_, a) -> depsOfAttrs ~missingBoundsOkay t a + | TArray (_, _, a) when isOpenArray t -> depsOfAttrs ~missingBoundsOkay t a + | TComp (ci,_) when not ci.cstruct -> + List.fold_left + (fun acc fld -> (depsOfField fld) @ acc) + [] ci.cfields + | _ -> [] + +(* Determine whether other variables/fields depend on a given name. *) +let hasExternalDeps (lv: lval) : bool = + let hasDeps (n: string) (vars: (string * typ) list) : bool = + List.fold_left + (fun acc (name, t) -> + acc || (name <> n && List.mem n (depsOfType t))) + false + vars + in + let lv', off = removeOffsetLval lv in + match off with + | NoOffset -> + begin + match fst lv with + | Var vi -> + let env = + if not vi.vglob then + !curFunc.slocals @ !curFunc.sformals + else + globalsEnv vi + in + let vars = List.map (fun vi -> vi.vname, vi.vtype) env in + hasDeps vi.vname vars + | Mem e -> + false + end + | Field (fld, NoOffset) -> + let vars = + List.map (fun fld -> fld.fname, fld.ftype) fld.fcomp.cfields + in + hasDeps fld.fname vars + | Index (_, NoOffset) -> + (* No one depends on array elements. + FIXME: what about arrays inside null-terminated arrays? *) + false + | _ -> E.s (bug "Unexpected result from removeOffset") + +(* A context maps variable/field names to the corresponding CIL expr. + * We also add a boolean indicating whether this string corresponds + * to a temporary (for error reporting purposes). *) +type context = (string * bool * exp) list + +(* Print the names in a context, separated by commas *) +let d_ctx: unit -> context -> doc = + docList ~sep:(text ", ") (fun (s, _, _) -> text s) + +let d_ctx_simple () (ctx: context) : doc = + d_ctx () (List.filter (fun (_, b, _) -> not b) ctx) + +let formalsContext (f:fundec) : context = + List.fold_left + (fun acc v -> (v.vname, isHiddenVar v, Lval (var v)) :: acc) + [] + f.sformals + +let localsContext (f:fundec) : context = + List.fold_left + (fun acc v -> (v.vname, isHiddenVar v, Lval (var v)) :: acc) + (formalsContext f) + f.slocals + +(* A subset of localsContext. It includes only the vars in the given set. *) +let liveLocalsContext (vars: VS.t) : context = + VS.fold + (fun v acc -> (v.vname, isHiddenVar v, Lval (var v)) :: acc) + vars + [] + +let globalsContext (vi:varinfo) : context = + List.fold_left + (fun acc v -> (v.vname, isHiddenVar v, Lval (var v)) :: acc) + [] + (globalsEnv vi) + +let structContext (lv: lval) (ci: compinfo) : context = + List.fold_left + (fun acc fld -> + (fld.fname, false, Lval (addOffsetLval (Field (fld, NoOffset)) lv)) + :: acc) + [] + ci.cfields + +let allContext () : context = + List.fold_left + (fun acc v -> (v.vname, isHiddenVar v, Lval (var v)) :: acc) + [] + (!allGlobalVars @ + !curFunc.sformals @ !curFunc.slocals) + + +(**************************************************************************) + + +(** The dependent types are expressed using attributes. We compile an + * attribute given a mapping from names to lvals. Returns the names of + * meta values that this annotation depends on, and the expression. + * + * This is a helper for both fields and formals. *) +let rec compileAttribute + ?(deputyAttrsOnly=true)(* Allow only Deputy's "local" dependencies. If + false, we allow star to appear in the annotation.*) + (ctx: context) (* Should include a mapping for thisKeyword *) + (a: attrparam) + : string list * exp = + let rec compile (a: attrparam) = + match a with + AInt k -> [], integer k + | ASizeOf t -> [], SizeOf t + | ASizeOfE e -> + let _, e' = compileAttribute (allContext ()) e in + [], SizeOfE e' + | ACons(name, []) -> begin + try begin + let _, _, e = List.find (fun (n, _, _) -> n = name) ctx in + (* Perhaps this is an array name. Turn it into StartOf *) + match unrollType (typeOf e) with + | TArray (bt, _, _) -> begin + match stripNopCasts e with + Lval lv -> [name], StartOf lv + | _ -> E.s (bug "Array dependency %s (%a) is not an lval" + name dx_exp e) + end + | TPtr (TVoid _, _) -> + [name], mkCast e (TPtr (charType, sentinelAttrs)) + | _ -> [name], e + end with Not_found -> begin + if isGlobalArray name then + let vi = List.find (fun vi -> vi.vname = name) !allGlobalVars in + [], StartOf (var vi) + else if List.exists (fun vi -> vi.vname=name) !constGlobalVars then + (* a constant global. *) + let vi = List.find (fun vi -> vi.vname = name) !constGlobalVars in + [], Lval (var vi) + else + E.s (error + ("Cannot compile the dependency %a: " ^^ + "Cannot find %s in the context.") + d_attrparam a + name) + end + end + | AIndex (aa, ai) -> begin + let lva, ea = compile aa in + let lvi, ei = compile ai in + (* ea must be an array. It was turned into a StartOf *) + match ea with + StartOf lvala -> + lva @ lvi, Lval (addOffsetLval (Index(ei, NoOffset)) lvala) + | _ -> E.s (error "Cannot compile the dependency %a. Index used on a non-array" d_attrparam a) + end + + | AAddrOf aa -> begin + let lva, ea = compile aa in + match ea with + Lval lv -> lva, mkAddrOrStartOf lv + | _ -> E.s (error "Cannot compiler the dependency %a. Address-of used on a non-lvalue" d_attrparam a) + end + | ABinOp (bop, e1, e2) -> + let lv1', e1' = compile e1 in + let lv2', e2' = compile e2 in + (* now that we know the types of these expressions, + fix any MinusA/PlusA that should be pointer arithmetic. *) + let bop' = match bop, isPointer e1', isPointer e2' with + MinusA, true, true -> MinusPP + | MinusA, true, false -> MinusPI + | PlusA, true, false -> PlusPI + | _ -> bop + in + let t' = typeAddAttributes sentinelAttrs (typeOf e1') in + lv1' @ lv2', BinOp(bop', e1', e2', t') + | AUnOp (uop, e1) -> + let lv1', e1' = compile e1 in + let t = match uop with + Neg | BNot -> typeOf e1' + | LNot -> intType + in + lv1', UnOp(uop, e1', t) + | AStar(e1) when not deputyAttrsOnly -> + let lv1', e1' = compile e1 in + let res = mkMem ~addr:e1' ~off:NoOffset in + lv1', Lval(res) + | _ -> E.s (error "Cannot compile the dependency %a" d_attrparam a) + in + compile a + +(* Bounds attribute *) + +type bounds = +| BSimple of attrparam * attrparam +| BFancy of exp * exp + +let rec getBounds (a: attributes) : bounds = + let checkrest rest = + if hasAttribute "bounds" rest || + hasAttribute "fancybounds" rest then + E.s (error "Type has duplicate bounds attributes: %a" d_attrlist a) + in + match a with + | Attr ("bounds", [lo; hi]) :: rest -> + checkrest rest; + BSimple (lo, hi) + | Attr ("fancybounds", [AInt lo; AInt hi]) :: rest -> + checkrest rest; + BFancy (getBoundsExp lo, getBoundsExp hi) + | Attr _ :: rest -> + getBounds rest + | [] -> + E.s (bug "Missing bounds information") + +let boundsOfAttrs (ctx: context) (a: attributes) : exp * exp = + match getBounds a with + | BSimple (lo, hi) -> + (* Compile lo, hi into expressions *) + let lodeps, lo' = compileAttribute ctx lo in + let hideps, hi' = compileAttribute ctx hi in + lo', hi' + | BFancy _ -> + E.s (error "Found fancybounds instead of bounds annotations") + +let fancyBoundsOfAttrs (a: attributes) : exp * exp = + match getBounds a with + | BSimple (lo, hi) -> + E.s (error "Found bounds instead of fancybounds annotations") + | BFancy (lo, hi) -> + lo, hi + +let fancyBoundsOfType (t: typ) : exp * exp = + match unrollType t with + | TPtr (_, a) + | TArray (_, _, a) -> fancyBoundsOfAttrs a + | _ -> E.s (error "Expected pointer or array type") + +let makeFancyBoundsAttr ~(expectedType:typ) (lo: exp) (hi: exp) : attribute = + Attr ("fancybounds", + [AInt (addBoundsExp ~expectedType lo); AInt (addBoundsExp ~expectedType hi)]) + +let makeFancyPtrType ?(nullterm:bool=false) (bt: typ) (lo: exp) (hi: exp) + : typ = + let boundsAttr = + [makeFancyBoundsAttr ~expectedType:(TPtr (bt, sentinelAttrs)) lo hi] in + let attrs = if nullterm then + addAttribute nulltermAttr boundsAttr + else + boundsAttr + in + TPtr (bt, attrs) + +(* Size attribute *) + +type size = +| SSimple of attrparam +| SFancy of exp + +let rec getSize (a: attributes) : size = + let checkrest rest = + if hasAttribute "size" rest || + hasAttribute "fancysize" rest then + E.s (error "Type has duplicate size attributes: %a" d_attrlist a) + in + match a with + | Attr ("size", [n]) :: rest -> + checkrest rest; + SSimple n + | Attr ("fancysize", [AInt n]) :: rest -> + checkrest rest; + SFancy (getBoundsExp n) + | Attr _ :: rest -> + getSize rest + | [] -> + E.s (bug "Missing size information") + +let sizeOfAttrs (ctx: context) (a: attributes) : exp = + match getSize a with + | SSimple n -> + snd (compileAttribute ctx n) + | SFancy _ -> + E.s (error "Found fancysize instead of size annotations") + +let fancySizeOfAttrs (a: attributes) : exp = + match getSize a with + | SSimple _ -> + E.s (error "Found size instead of fancysize annotations") + | SFancy n -> + n + +let fancySizeOfType (t: typ) : exp = + match unrollType t with + | TPtr (_, a) -> fancySizeOfAttrs a + | _ -> E.s (error "Expected pointer type") + +let fancyBoundsOfSizeType (toType: typ) (fromType: typ) (e: exp) : exp * exp = + let n = fancySizeOfType fromType in + let elts = BinOp (Div, n, SizeOf (baseType "size type" toType), typeOf n) in + let toType' = + typeAddAttributes sentinelAttrs + (typeRemoveAttributes ["bounds"] toType) + in + let lo = mkCast e toType' in + let hi = BinOp (PlusPI, lo, elts, toType') in + lo, hi + +let makeFancySizeAttr ~(expectedType:typ) (n: exp) : attribute = + Attr ("fancysize", [AInt (addBoundsExp ~expectedType n)]) + +(* When attribute *) + +let whenOfAttrs (ctx: context) (a: attributes) : exp = + let w = getWhen a in + let deps, e = compileAttribute ctx w in + e + +let makeFancyWhenAttr (wm: whenMap) : attribute = + Attr ("fancywhen", [AInt (addWhenMap wm)]) + +let fancyWhenOfType (t: typ) : whenMap = + match unrollType t with + | TComp (_, a) -> begin + match filterAttributes "fancywhen" a with + [Attr("fancywhen", [AInt i])] -> getWhenMap i + | _ -> E.s (bug "missing (or malformed) fancywhen: %a" d_attrlist a) + end + | _ -> E.s (E.bug "Expected union type") + +(* Replace the names in type t with the corresponding expressions in ctx *) +let substType (ctx: context) (t: typ) : typ = + if !verbose then + E.log "%a: substType %a\n" d_loc !currentLoc dx_type t; + match unrollType t with + | TVoid a when hasAttribute "tyvar" a -> + let tyvar = + match filterAttributes "tyvar" a with + | [Attr ("tyvar", [ACons (tyvar, [])])] -> tyvar + | [_] -> E.s (bug "Malformed tyvar attribute.") + | [] -> E.s (bug "Couldn't find tyvar attribute.") + | _ -> E.s (error "Too many tyvar attributes.") + in + begin + try + match List.find (fun (n, _, _) -> n = "'" ^ tyvar) ctx with + | _, _, SizeOf t -> t + | _ -> E.s (bug "Couldn't look up type for tyvar %s." tyvar) + with Not_found -> + t + end + | TPtr (bt, a) when hasAttribute "size" a -> + let n = sizeOfAttrs ctx a in + let a' = addAttribute (makeFancySizeAttr ~expectedType:intType n) + (dropAttribute "size" a) in + TPtr (bt, a') + | TPtr (bt, a) when hasAttribute "bounds" a -> + let lo, hi = boundsOfAttrs ctx a in + let t' = typeAddAttributes [sentinelAttr] t in + let a' = addAttribute (makeFancyBoundsAttr ~expectedType:t' lo hi) + (dropAttribute "bounds" a) in + TPtr (bt, a') + | TPtr _ -> + E.s (bug "Missing bounds information") + | TArray (bt, eo, a) when hasAttribute "bounds" a -> + let lo, hi = boundsOfAttrs ctx a in + let t' = typeAddAttributes [sentinelAttr] t in + let a' = addAttribute (makeFancyBoundsAttr ~expectedType:t' lo hi) + (dropAttribute "bounds" a) in + TArray (bt, eo, a') + | TArray _ -> + E.s (bug "Missing bounds information") + | TComp (ci, a) when not ci.cstruct && not (isTrustedComp ci) -> + (* a union. Create a fancywhen attr for the when clauses of each field.*) + let doField (acc:whenMap) (fld:fieldinfo) : whenMap = + try + let e : exp = whenOfAttrs ctx fld.fattr in (* may raise Not_found *) + (fld, e) :: acc + with Not_found -> + if typeContainsPointers fld.ftype then begin + E.s (error "Missing WHEN annotation on field %s.\n" fld.fname) + end else + (* Allow missing WHEN clauses for scalars. *) + acc + in + let wm = List.fold_left doField [] ci.cfields in + let a' = addAttribute (makeFancyWhenAttr wm) a in + TComp (ci, a') + | _ -> + t + +let emptyContext : context = [] + +(* Add to the current context a binding for "__this". + t is the static type of this location, so we'll map __this to (t)e. + This is for the sake of pointer arithmetic that uses __this. *) +let addThisBinding (ctx:context) (t:typ) (e:exp) : context = + (* First, strip dependent attributes from t. + We only care about the base type, so that pointer arithmetic + is done correctly. *) + let t = stripDepsFromType t in + let oldt = stripDepsFromType (typeOf e) in + let e' = + if isArrayType oldt || compareTypes t oldt then e + else mkCast ~e ~newt:t + in + (thisKeyword, true, e')::ctx + +let addTypeBinding (ctx:context) (name:string) (t:typ) : context = + ("'" ^ name, false, SizeOf t)::ctx + +(* Add to the current context a binding from name to e *) +let addBinding (ctx:context) (name:string) (e:exp) : context = + (name, false, e)::ctx + +(* Check whether a binding exists. *) +let hasBinding (ctx:context) (name:string) : bool = + List.exists (fun (n, _, _) -> n = name) ctx +let hasBindings (ctx:context) (names : string list) : bool = + List.for_all (hasBinding ctx) names + +(* Visitor for replacing names in bound attributes *) +let substTypeNameVisitor (map: (string * string) list) = object (self) + inherit nopCilVisitor + + method vattrparam ap = + match ap with + | ACons (name, []) when List.mem_assoc name map -> + ChangeTo (ACons (List.assoc name map, [])) + | _ -> + DoChildren +end + +(* Replace the names in type t with new names *) +let substTypeName (map: (string * string) list) (t: typ) : typ = + visitCilType (substTypeNameVisitor map) t + +(* Replace all argument types with canonical ones for the purpose of + * type comparisons. Warning: We don't update names of arguments, so + * the results of this function should only be used for type comparisons! *) +let normalizeTypeNamesVisitor = object (self) + inherit nopCilVisitor + + method vtype t = + match t with + | TFun (ret, argInfo, _, _) -> + (* TODO: Write fold_right_index instead. *) + let map = ref [] in + iter_index + (fun (aname, _, _) i -> + if aname <> "" then + map := (aname, "arg" ^ (string_of_int i)) :: !map) + (argsToList argInfo); + ChangeDoChildrenPost (substTypeName !map t, (fun t -> t)) + | _ -> DoChildren +end + +(* Runs the visitor above--see comment there. *) +let normalizeTypeNames (t: typ) : typ = + visitCilType normalizeTypeNamesVisitor t + +(* If the last field of the comp is an open array, return the field with + * its length. *) +let getOpenArrayLength (t: typ) : (fieldinfo * typ) option = + match unrollType t with + | TComp (ci, _) when List.length ci.cfields > 0 -> + let last = List.nth ci.cfields (List.length ci.cfields - 1) in + if isOpenArray last.ftype then begin + let lo, hi = + match getBounds (typeAttrs last.ftype) with + | BSimple (lo, hi) -> lo, hi + | BFancy _ -> E.s (bug "Expected simple bounds") + in + let len = + match lo, hi with + | ACons (this1, []), + ABinOp (PlusA, ACons (this2, []), ACons (name, [])) + when this1 = thisKeyword && this2 = thisKeyword -> + begin + try + List.find (fun fld -> fld.fname = name) ci.cfields + with Not_found -> + E.s (bug "Invalid field name %s" name) + end + | _ -> + E.s (error ("Open arrays must use annotations of the form " ^^ + "COUNT(n) for some variable n.")) + in + Some (len, last.ftype) + end else + None + | _ -> None + +(* We use this for isRoot in Rmtmps. We preserve anything that CIL normally + would, plus globals that are named in dependencies. *) +let treatAsRoot (f:file) : global -> bool = + let keepers = H.create 20 in + let preserveName (s: string) : unit = H.add keepers s () in + let doGlobal (g: global) : unit = + match g with + GVarDecl(vi, _) + | GVar (vi, _, _) -> + if not (isTrustedType vi.vtype) then + List.iter preserveName (depsOfType ~missingBoundsOkay:true vi.vtype); + | _ -> () + in + iterGlobals f doGlobal; + (* Also keep strncpy so that we can transform strcpy. *) + preserveName "strncpy"; + (* Now return the function that Rmtmps calls *) + (fun g -> + Rmtmps.isDefaultRoot g || + (match g with + GVarDecl(vi, _) + | GVar (vi, _, _) -> H.mem keepers vi.vname || isConstType vi.vtype + | _ -> false)) + diff --git a/src/dattrs.mli b/src/dattrs.mli new file mode 100644 index 0000000..e15b698 --- /dev/null +++ b/src/dattrs.mli @@ -0,0 +1,144 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 getZeroOneAttr : string list -> Cil.attributes -> Cil.attribute option +val getOneAttr : string list -> Cil.attributes -> Cil.attribute +val isNullterm : Cil.typ -> bool +val isNulltermDrop : Cil.typ -> bool +val isNulltermExpand : Cil.typ -> bool +val isSizePtr : Cil.typ -> bool +val isTrustedAttr : Cil.attributes -> bool +val isTrustedType : Cil.typ -> bool +val isTrustedComp : Cil.compinfo -> bool +val isNonnullType : Cil.typ -> bool +val isHiddenVar : Cil.varinfo -> bool +val typeContainsNonnull : Cil.typ -> bool +val thisKeyword : string +val autoKeyword : string +val countAttr : Cil.attrparam -> Cil.attribute +val count0Attr : Cil.attribute +val sizeAttr : Cil.attrparam -> Cil.attribute +val safeAttr : Cil.attribute +val nulltermAttr : Cil.attribute +val autoAttr : Cil.attribute +val autoEndAttr : Cil.attribute +val stringAttrs : Cil.attributes +val trustedAttr : Cil.attribute +val sentinelAttrs : Cil.attributes +val hiddenAttr : Cil.attribute +val isSentinelType : Cil.typ -> bool +val isConstType : Cil.typ -> bool +val missingAnnotAttr : Cil.attribute +val hasDefaultAnnot : Cil.attributes -> bool +val isAllocator : Cil.typ -> bool +val isMemset : Cil.typ -> bool +val isMemcpy : Cil.typ -> bool +val isMemcmp : Cil.typ -> bool +val isSpecialFunction : Cil.typ -> bool +val allGlobalVars : Cil.varinfo list ref +val registerGlobal : Cil.varinfo -> unit +val globalsEnv : Cil.varinfo -> Cil.varinfo list +val clearBoundsTable : unit -> unit +type paramkind = + PKNone + | PKThis + | PKOffset of Cil.attrparam +val checkParam : Cil.attrparam -> paramkind +class deputyPrinterClass : showBounds:bool -> enable:bool -> Cil.descriptiveCilPrinter +val deputyFilePrinter : deputyPrinterClass +val deputyPrinter : deputyPrinterClass +val dx_type : unit -> Cil.typ -> Pretty.doc +val dx_exp : unit -> Cil.exp -> Pretty.doc +val dx_lval : unit -> Cil.lval -> Pretty.doc +val dx_instr : unit -> Cil.instr -> Pretty.doc +val dx_global : unit -> Cil.global -> Pretty.doc +val dx_temps : unit -> Pretty.doc +val dc_exp : unit -> Cil.exp -> Pretty.doc +val startTemps : unit -> unit +val stopTemps : unit -> unit +val dt_type : unit -> Cil.typ -> Pretty.doc +val dt_exp : unit -> Cil.exp -> Pretty.doc +val dt_lval : unit -> Cil.lval -> Pretty.doc +val dt_instr : unit -> Cil.instr -> Pretty.doc +class deputyPatchPrinterClass : Cil.cilPrinter +val deputyPatchPrinter : deputyPatchPrinterClass +val dp_global : unit -> Cil.global -> Pretty.doc +val addTempInfoSet : Cil.varinfo -> Cil.exp -> unit +val addTempInfoCall : Cil.varinfo -> Cil.exp -> Cil.exp list -> unit +type whenMap = (Cil.fieldinfo * Cil.exp) list +val getSelectedField : whenMap -> Cil.fieldinfo option +val depsOfWhenAttrs : Cil.attributes -> string list +val depsOfType : ?missingBoundsOkay:bool -> Cil.typ -> string list +val hasExternalDeps : Cil.lval -> bool +type context = (string * bool * Cil.exp) list +val d_ctx : unit -> context -> Pretty.doc +val d_ctx_simple : unit -> context -> Pretty.doc +val formalsContext : Cil.fundec -> context +val localsContext : Cil.fundec -> context +val liveLocalsContext : Usedef.VS.t -> context +val globalsContext : Cil.varinfo -> context +val structContext : Cil.lval -> Cil.compinfo -> context +val allContext : unit -> context +val compileAttribute : ?deputyAttrsOnly:bool -> context -> Cil.attrparam -> string list * Cil.exp +type bounds = + BSimple of Cil.attrparam * Cil.attrparam + | BFancy of Cil.exp * Cil.exp +val getBounds : Cil.attributes -> bounds +val boundsOfAttrs : context -> Cil.attributes -> Cil.exp * Cil.exp +val fancyBoundsOfType : Cil.typ -> Cil.exp * Cil.exp +val makeFancyPtrType : + ?nullterm: bool -> Cil.typ -> Cil.exp -> Cil.exp -> Cil.typ +type size = + SSimple of Cil.attrparam + | SFancy of Cil.exp +val fancySizeOfType : Cil.typ -> Cil.exp +val fancyBoundsOfSizeType : Cil.typ -> Cil.typ -> Cil.exp -> Cil.exp * Cil.exp +val fancyWhenOfType : Cil.typ -> whenMap +val substType : context -> Cil.typ -> Cil.typ +val emptyContext : context +val addThisBinding : context -> Cil.typ -> Cil.exp -> context +val addTypeBinding : context -> string -> Cil.typ -> context +val addBinding : context -> string -> Cil.exp -> context +val hasBinding : context -> string -> bool +val hasBindings : context -> string list -> bool +val substTypeName : (string * string) list -> Cil.typ -> Cil.typ +val normalizeTypeNames : Cil.typ -> Cil.typ +val getOpenArrayLength : Cil.typ -> (Cil.fieldinfo * Cil.typ) option + + +(* For Rmtmps *) +val treatAsRoot: Cil.file -> Cil.global -> bool diff --git a/src/dcheck.ml b/src/dcheck.ml new file mode 100755 index 0000000..fff1c9f --- /dev/null +++ b/src/dcheck.ml @@ -0,0 +1,1603 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 Expcompare +open Pretty +open Dattrs +open Doptions +open Dutil +open Dcheckdef +open Dpoly + +module DO = Doptimmain +module E = Errormsg +module H = Hashtbl +module IH = Inthash +module S = Stats +module VS = Usedef.VS + +module DPF = Dprecfinder +module DCE = Dcanonexp + +(**************************************************************************) + + +let exemptLocalVars : varinfo list ref = ref [] + +(* Assign to each statement a unique ID. *) +let nextStmtId : int ref = ref 0 +let assignID (s:stmt) : unit = + (* Make sure that no one else has assigned ID numbers *) + if !optLevel < 2 && s.sid <> -1 then + E.s (bug "Stmt already has an sid: %a\n" d_stmt s); + s.sid <- !nextStmtId; + incr nextStmtId; + () + +(* Convert instruction lists into individual statements, and give each + stmt a unique id. *) +let rec fixStmt ?(giveID : bool = true) (s:stmt) : unit = + if giveID then assignID s; + match s.skind with + Instr [] -> () + | Instr [i] -> () + | Instr il -> (* Two or more instructions *) + let sl = List.map mkStmtOneInstr il in + List.iter fixStmt sl; + s.skind <- Block (mkBlock sl); + () + | If(_,b1,b2,_) -> + fixBlock b1; + fixBlock b2 + | Switch(_,b,_,_) -> + fixBlock b + | Loop(b,_,_,_) -> + fixBlock b + | Block b -> fixBlock b + | TryFinally(b1,b2,_) -> + fixBlock b1; + fixBlock b2 + | TryExcept(b1,_,b2,_) -> + fixBlock b1; + fixBlock b2 + | _ -> () + +and fixBlock ?(giveID : bool = true) (b : block) : unit = + List.iter (fixStmt ~giveID:giveID) b.bstmts + +(* Calls typeOf on an expression, but adds type attributes in appropriate + * cases. This allows the checker to use typeOf in a context that expects + * all types to be annotated. *) +let deputyTypeOf (e: exp) : typ = + let t = + match e with + | AddrOf _ -> typeAddAttributes [safeAttr] (typeOf e) + | Const (CStr _) + | Const (CWStr _) -> typeAddAttributes stringAttrs (typeOf e) + (* StartOf should correctly inherit the array's attributes, + so we don't need to handle it specially. *) + | _ -> typeOf e + in + if isPointerType t && not (hasAttribute "bounds" (typeAttrs t)) then + E.s (bug "deputyTypeOf did not add attrs to %a at %a" dx_type t dx_exp e); + t + +let reportPolyFieldError (lv: lval) (fi: fieldinfo) : 'a = + E.s (error ("Field \"%s\" has generic type, but its containing " ^^ + "structure has not been instantiated properly. " ^^ + "Use the TP(...) annotation on the structure's type.\n" ^^ + " struct type: %a\n" ^^ + " field type: %a\n" ^^ + " exp: %a") + fi.fname dx_type (TComp (fi.fcomp, [])) + dx_type fi.ftype dx_lval lv) + +let reportPolyArgError (aname: string) (atype: typ) (arg: exp) : 'a = + E.s (error ("Formal parameter \"%s\" has generic type, but an " ^^ + "appropriate instantiation could not be found.\n" ^^ + " formal type: %a\n" ^^ + " arg type: %a\n" ^^ + " exp: %a") + aname dx_type atype dx_type (typeOf arg) dx_exp arg) + +let reportPolyRetError (fn: exp) : 'a = + let ret = + match typeOf fn with + | TFun (ret, _, _, _) -> ret + | _ -> E.s (bug "Expected function type.") + in + E.s (error ("Return type has generic type, but an appropriate " ^^ + "instantiation could not be found.\n" ^^ + " ret type: %a\n" ^^ + " function: %a") + dx_type ret dx_exp fn) + + +(**************************************************************************) + + +(* Here we store extra instructions that have been inserted during the + * checking process. These instructions include both run-time checks + * and actual code. The allowChecks flag indicates whether checks should + * be added at this time. *) +let allowChecks : bool ref = ref false +let extraInstrs = ref [] + +let startExtraInstrs () : unit = + if !extraInstrs <> [] then + E.s (bug "Extra instruction queue is not empty!") + +let endExtraInstrs () : instr list = + let extras = !extraInstrs in + extraInstrs := []; + List.rev extras + +let addInstr (i: instr) : unit = + extraInstrs := i :: !extraInstrs + +let addTmpSet (e: exp) : varinfo = + let tmp = makeTempVar !curFunc + (typeRemoveAttributes ["nonnull"] (deputyTypeOf e)) in + addTempInfoSet tmp e; + addInstr (Set (var tmp, e, !currentLoc)); + tmp + +let addTmpCall (t: typ) (fn: exp) (args: exp list) : varinfo = + (* TODO: Derive t from type of fn? *) + let tmp = makeTempVar !curFunc + (typeRemoveAttributes ["nonnull"; "warn_unused_result"] t) in + addTempInfoCall tmp fn args; + addInstr (Call (Some (var tmp), fn, args, !currentLoc)); + tmp + +let addCheck (c: check) : unit = + if !verbose then + log "--> %a" dn_instr (checkToInstr c); + if !allowChecks then + addInstr (checkToInstr c) + +let addArithChecks (lo: exp) (ptr: exp) (off : exp) (hi : exp) : unit = + addCheck (CNonNull ptr); + let t = typeOf ptr in + let sz = baseSize t in + if isNullterm t then + addCheck (CPtrArithNT (lo, hi, ptr, off, sz)) + else + addCheck (CPtrArith (lo, hi, ptr, off, sz)) + +(* Returns ceiling(x / n) *) +let divCeiling (x:exp) (n:int) : exp = + if not (isIntegralType (typeOf x)) then + error "Expecting an integer, got %a" dt_exp x; + (* return the expression (x + n-1)/n *) + BinOp(Div, + BinOp(PlusA, x, integer (n-1), !upointType), + integer n, + !upointType) + + +let addSizeChecks (t: typ) (e: exp) (bytes: exp) : unit = + let lo, hi = fancyBoundsOfType t in + if isNullterm t then begin + (* We need to leave the type of e alone so that CPtrArithNT can + work its magic. Note that divCeiling will effectively round the + size up to the next multiple of (baseSize t). This could cause + false positives in the reletively uncommon case where bytes is + not a multiple of (baseSize t). *) + let numElements = divCeiling bytes (baseSize t) in + addArithChecks lo e numElements hi + end + else begin + (* Just treat e as a char pointer *) + let cp e = mkCast e charPtrType in + addArithChecks (cp lo) (cp e) bytes (cp hi) + end + +let addCoercionCheck (lo_from: exp) (lo_to: exp) (e: exp) + (hi_to: exp) (hi_from: exp) (tFrom: typ) : unit = + (* If the lower bound has changed, do an lbound check. + * (we already know that lo_from <= e, so if lo_from=lo_to, + * we don't have to check that lo_to <= e) + *) + if !optLevel = 0 || not (DCE.canonCompareExp(*StripCasts*) lo_from lo_to) then begin + addCheck (CNullOrLeq(e, lo_from, lo_to, "lower bound coercion")); + addCheck (CNullOrLeq(e, lo_to, e, "lower bound check")); + end; + if !optLevel = 0 || not (DCE.canonCompareExp(*StripCasts*) hi_from hi_to) then begin + addCheck (CNullOrLeq(e, e, hi_to, "upper bound check")); + if isNullterm tFrom then + addCheck (CNullOrLeqNT(e, hi_to, hi_from, baseSize tFrom, + "nullterm upper bound coercion")) + else + addCheck (CNullOrLeq(e, hi_to, hi_from, "upper bound coercion")); + end; + () + + +(**************************************************************************) + + +let rec expToAttr (e: exp) : attrparam option = + match stripNopCasts e with + | Lval (Var vi, NoOffset) -> Some (ACons (vi.vname, [])) + | Const _ -> + begin + match isInteger e with + | Some i -> Some (AInt (to_int i)) + | None -> None + end + | BinOp ((MinusA | PlusA) as op, e1, e2, _) -> + begin + match expToAttr e1, expToAttr e2 with + | Some a1, Some a2 -> Some (ABinOp (op, a1, a2)) + | _ -> None + end + | _ -> None + +(* If this function frees an argument, it returns the index of that + * argument and its type. *) +let getFreeArg (fnType: typ) : int option = + let fnAttrs = typeAttrs fnType in + match getZeroOneAttr ["drealloc"; "dfree"] fnAttrs with + | Some (Attr ("dfree", [ACons (name, [])])) + | Some (Attr ("drealloc", [ACons (name, []); _])) -> + let _, argInfo, _, _ = splitFunctionType fnType in + let rec getIndex lst index = + match lst with + | (argName, _, _) :: rest -> + if name = argName then Some index else getIndex rest (index + 1) + | [] -> None + in + getIndex (argsToList argInfo) 1 + | Some (Attr ("dfree", _)) -> E.s (error "Malformed free annotation.") + | Some (Attr ("drealloc", _)) -> E.s (error "Malformed realloc annotation.") + | Some (Attr _) -> E.s (bug "Unexpected attribute.") + | None -> None + +(* Returns an expression that evaluates to the number of objects of type + * retType that can fit in the allocated area, as well as an expression + * that evaluates to the raw number of bytes allocated. *) +let getAllocationExp (retType: typ) (fnType: typ) (args: exp list) : exp * exp = + let fnAttrs = typeAttrs fnType in + let size = + match getOneAttr ["dalloc"; "drealloc"] fnAttrs with + | Attr ("dalloc", [a]) + | Attr ("drealloc", [_; a]) -> + let formals = + match fnType with + | TFun (_, argInfo, _, _) -> argsToList argInfo + | _ -> E.s (bug "Expected function type") + in + let ctx = + List.fold_right2 + (fun (name, _, _) arg acc -> + if name <> "" then addBinding acc name arg else acc) + formals args emptyContext + in + snd (compileAttribute ctx a) + | Attr ("dalloc", _) -> E.s (error "Malformed alloc annotation.") + | Attr ("drealloc", _) -> E.s (error "Malformed realloc annotation.") + | Attr _ -> E.s (bug "Unexpected attribute.") + in + let retBaseType = + match unrollType retType with + | TPtr (bt, _) -> bt + | TInt _ -> voidType (* Treat integer types like void*. *) + | _ -> E.s (error "Left-hand side of allocation is not a pointer type.") + in + let count = + if isOpenArrayComp retBaseType then + one + else + let baseSize = + if isVoidType retBaseType then one else SizeOf retBaseType + in + let count = BinOp (Div, size, baseSize, !upointType) in + if isNullterm retType then + BinOp (MinusA, count, one, !upointType) + else + count + in + count, size + +let maxFunction = mkFun "deputy_max" !upointType [!upointType; !upointType] + +let callMax (e1: exp) (e2: exp) : exp = + let t = + typeAddAttributes (nulltermAttr :: sentinelAttrs) + (typeRemoveAttributes ["bounds"] (typeOf e1)) + in + Lval (var (addTmpCall t maxFunction [e1; e2])) + +let isUpcast (btFrom: typ) (btTo: typ) : bool = + match unrollType btFrom with + | TComp (ci, _) -> + begin + try + compareTypes (List.hd ci.cfields).ftype btTo + with Failure "hd" -> + false + end + | _ -> false + +let normalizeCompareTypes (t1: typ) (t2: typ) : bool = + compareTypes (normalizeTypeNames t1) (normalizeTypeNames t2) + +let checkUnionWhen (ctx:context) (fld:fieldinfo) : unit = + if not (isTrustedComp fld.fcomp) then + try + let deps = depsOfWhenAttrs fld.fattr in (* may raise Not_found *) + let deps' = List.filter (fun n -> n <> thisKeyword) deps in + if not (hasBindings ctx deps) then + E.s (error ("Field %s of union %s depends on names " ^^ + "that are not in scope.\n" ^^ + " dependencies: {%a}\n" ^^ + " names in scope: {%a}") + fld.fname fld.fcomp.cname + (docList ~sep:(text ", ") text) deps' + d_ctx_simple ctx) + with Not_found -> + (* Allow missing WHEN clauses for scalars. *) + if typeContainsPointers fld.ftype then + E.s (error "Missing WHEN annotation on field %s of union %s." + fld.fname fld.fcomp.cname) + +(* Determine whether a type is well-formed. + If this returns false, it's an error. So try to give a useful reason + to return false. + It's not necessary for ctx to contain __this. We'll add a binding for + __this here. *) +let rec checkType (ctx: context) (t: typ) (where: doc) : unit = + let ctx = addThisBinding ctx t zero in + let checkPtrArrayAttrs (t: typ) : unit = + (* TODO: check whether base types for bounds match? *) + let bt = + match unrollType t with + | TPtr (bt, _) + | TArray (bt, _, _) -> bt + | _ -> E.s (bug "Expected pointer or array type") + in + let deps = if isTrustedType t then [] else depsOfType t in + let deps' = List.filter (fun n -> n <> thisKeyword) deps in + if not (hasBindings ctx deps) then begin + E.s (error ("Type of %a depends on names that are not in scope.\n" ^^ + " type: %a\n" ^^ + " dependencies: {%a}\n" ^^ + " names in scope: {%a}") + insert where dx_type t + (docList ~sep:(text ", ") text) deps' d_ctx_simple ctx); + end; + checkType emptyContext bt where + in + match t with + | TPtr _ -> + checkPtrArrayAttrs t + | TArray (_, _, a) -> + if isOpenArray t then begin + if not (hasAttribute "bounds" a) && not (isTrustedAttr a) then + E.s (error "In %a, open array requires bounds information." + insert where); + if hasAttribute "nullterm" a then + E.s (error "In %a, open array cannot be nullterm." + insert where) + end; + checkPtrArrayAttrs t + | TFun (ret, argInfo, _, _) -> + let ctxFun = + List.fold_left + (fun acc (name, _, _) -> addBinding acc name zero) + emptyContext + (argsToList argInfo) + in + checkType ctxFun ret where; + List.iter + (fun (_, t, _) -> checkType ctxFun t where) + (argsToList argInfo) + | TComp (ci, _) when not ci.cstruct -> (* union *) + List.iter + (fun fld -> + (* Check union fields in the context ["__this"; fieldname]. + * These are redundant ... I'm only including the field + * name because that's how we did it in the paper. *) + let ctxField = addBinding emptyContext fld.fname zero in + checkType ctxField fld.ftype + (dprintf "field %s of union %s" fld.fname ci.cname); + (* Now check the when clause. *) + checkUnionWhen ctx fld) + ci.cfields + + (* Structs and typedefs are checked when defined. *) + | TComp _ + | TNamed _ + (* The following types are always well-formed. *) + | TVoid _ + | TInt _ + | TFloat _ + | TEnum _ + | TBuiltin_va_list _ -> () + +(* Add checks for a coercion of e from tFrom to tTo. + Both tFrom and tTo must have fancy bounds. *) +let rec coerceType (e: exp) ~(tFrom: typ) ~(tTo: typ) : unit = + if isNonnullType tTo + && not (isNonnullType tFrom) + && not (isTrustedType tFrom) then begin + addCheck (CNonNull e); + end; + match unrollType tFrom, unrollType tTo with + | t1, t2 when isTrustedType t1 || isTrustedType t2 -> + markLocationTrusted (); + () + | (TInt _ | TPtr _), (TPtr _ as t2) when isZero e || isSentinelType t2 -> + (* Coerce NULL to pointer. Do we need to do any well-formedness checks + here? *) + () + + | TPtr _, TPtr _ when isSentinelType tFrom && not (isSentinelType tTo) -> + (* Sentinel pointers need not be in bounds, so it's illegal to cast + away the sentinel qualifier. *) + errorwarn "A sentinel pointer may not be cast to an ordinary pointer." + + | TPtr _, TPtr _ when isSizePtr tFrom && isSizePtr tTo -> + let nFrom = fancySizeOfType tFrom in + let nTo = fancySizeOfType tTo in + addCheck (CLeqInt (nTo, nFrom, "pointer size coercion")) + + | TPtr (btFrom, _), TPtr _ when not (isSizePtr tFrom) && isSizePtr tTo -> + if typeContainsPointers btFrom then + errorwarn "Cast from pointer containing pointers to sized type: %a" + dx_exp e; + if typeContainsNonnull btFrom then + errorwarn "Cast from pointer containing nonnull to sized type: %a" + dx_exp e; + let n = fancySizeOfType tTo in + addSizeChecks tFrom e n + + | TPtr (btFrom, _), TPtr (btTo, _) when isSizePtr tFrom && + not (isSizePtr tTo) -> + let lo, hi = fancyBoundsOfSizeType tTo tFrom e in + let tFrom' = makeFancyPtrType btFrom lo hi in + coerceType e ~tFrom:tFrom' ~tTo + + | TPtr (bt1, _), TPtr (bt2, _) when normalizeCompareTypes bt1 bt2 -> + if isNullterm tTo && not (isNullterm tFrom) then + errorwarn "Cast from ordinary pointer to nullterm: %a" dx_exp e; + let loFrom, hiFrom = fancyBoundsOfType tFrom in + let loTo, hiTo = fancyBoundsOfType tTo in + addCoercionCheck loFrom loTo e hiTo hiFrom tFrom + + (* Allow upcasts. *) + | TPtr (bt1, _), TPtr (bt2, _) when isUpcast bt1 bt2 -> + if isNullterm tTo || isNullterm tFrom then + errorwarn "Upcasts not allowed on nullterm sequences: %a" dx_exp e; + (* Check that the source has at least one element. *) + let loFrom, hiFrom = fancyBoundsOfType tFrom in + let loTo, hiTo = loFrom, BinOp (PlusPI, loFrom, one, typeOf loFrom) in + addCoercionCheck loFrom loTo e hiTo hiFrom tFrom; + (* Check that the destination has at most one element. *) + let loTo, hiTo = fancyBoundsOfType tTo in + let loFrom, hiFrom = loTo, BinOp (PlusPI, loTo, one, typeOf loTo) in + addCoercionCheck loFrom loTo e hiTo hiFrom tTo + + (** Cast between two pointers to different base types *) + | TPtr (bt1, _), TPtr (bt2, _) when not (typeContainsPointers bt1) && + not (typeContainsPointers bt2) -> + if isNullterm tTo && not (isNullterm tFrom) then + errorwarn "Cast from ordinary pointer to nullterm: %a" dx_exp e; + + if isNullterm tTo || isNullterm tFrom then + E.s (unimp ("Nullterm cast with different base types:\n" ^^ + " from: %a\n" ^^ + " to: %a\n" ^^ + " exp: %a") + dt_type tFrom dt_type tTo dx_exp e); + let loFrom, hiFrom = fancyBoundsOfType tFrom in + let loTo, hiTo = fancyBoundsOfType tTo in + addCoercionCheck loFrom loTo e hiTo hiFrom tFrom + + (* Same as above, but for arrays--used for assigning to the length + * of an open array. *) + | TArray (bt1, _, _), TArray (bt2, _, _) when normalizeCompareTypes bt1 bt2 -> + if isNullterm tTo && not (isNullterm tFrom) then + errorwarn "Cast from ordinary pointer to nullterm: %a" dx_exp e; + let loFrom, hiFrom = fancyBoundsOfType tFrom in + let loTo, hiTo = fancyBoundsOfType tTo in + let e' = + match e with + | Lval lv -> StartOf lv + | _ -> E.s (bug "Expected lval") + in + addCoercionCheck loFrom loTo e' hiTo hiFrom tFrom + + | (TInt _ | TEnum _ | TPtr _ | TFloat _ ), (TInt _ | TEnum _) -> + (* These are all totally safe. *) + () + | (TInt _ | TFloat _ | TEnum _ ), TFloat _ -> + () + | TComp (ci, _), TComp (ci', _) when ci == ci' && not ci.cstruct -> + let whenFrom = fancyWhenOfType tFrom in + let whenTo = fancyWhenOfType tTo in + (* If the when maps differ, it's because a WHEN clause depends on + something in the context that has changed, so we should ensurer the + union has been zeroed. *) + if not (Util.equals whenFrom whenTo) then begin + let lv = match e with Lval lv -> lv + | _ -> E.s (bug "union expression must be an lval.") + in + (* Maybe we know statically that a field f will be the (only) selected + field after the coercion. If f was also selected before the + coercion, then there's been no change in the selected field, + and we don't need to check that the union is null. *) + let sameFieldIsSelected = + match getSelectedField whenTo with + Some f -> + List.assq f whenFrom + | None -> + (* No field is selected, or we don't know which field is + selected. So require that the union be filled with 0. *) + zero + in + (* Check that either sameFieldSelected is true, or that the union + is filled with zeros. *) + addCheck (CNullUnionOrSelected(lv, sameFieldIsSelected)) + end + | _ -> + if not (normalizeCompareTypes tFrom tTo) then + errorwarn ("Type mismatch in coercion:\n" ^^ + " from: %a\n" ^^ + " to: %a\n" ^^ + " exp: %a") + dt_type tFrom dt_type tTo dx_exp e + +type whyExp = +| ForInt (* This expression will be cast to an integer. *) +| ForDeref (* This expression will be dereferenced. *) +| ForAnything (* The catch-all case. *) + +type whyLval = +| ForRead (* Reading this lval. *) +| ForAddrOf (* Taking the address of this lval *) +| ForWrite of exp (* Writing the specified value. Call checkExp on + * this exp before calling checkLval *) +| ForCall (* Assigning the result of a call. + * We don't have an expression representing the new value, + * so we have to be more conservative *) + +(* Calls checkExp e, then calls coerceType to make sure that + e can be coerced to tTo. tTo must have fancy bounds. *) +let rec coerceExp (e: exp) (tTo: typ) : unit = + (* If we're casting to a sentinel type, we omit many checks. + Pretend we're casting to long instead.*) + let tTo = if isSentinelType tTo then !upointType else tTo in + (* If we're casting to an int or a sentinel, do less-strict checking of e. *) + let why = if isIntegralType tTo then ForInt else ForAnything in + + let tFrom = checkExp ~why e in + coerceType e ~tFrom ~tTo + + +and checkExp ?(why: whyExp = ForAnything) (e: exp) : typ = + match e with + | UnOp (op, e', t) -> coerceExp e' t; t + | BinOp ((PlusPI | IndexPI), + BinOp((PlusPI | IndexPI) as op2,pe,e1,t1), e2, t2) -> + (* reassociate and try again *) + let ne = BinOp(op2,pe,BinOp(PlusA,e1,e2,typeOf e1),t1) in + checkExp ~why:why ne + | BinOp (MinusPI, + BinOp((PlusPI | IndexPI) as op2,pe,e1,t1), e2, t2) -> + (* reassociate and try again *) + let ne = BinOp(op2,pe,BinOp(MinusA,e1,e2,typeOf e1),t1) in + checkExp ~why:why ne + | BinOp ((PlusPI | IndexPI), + BinOp(MinusPI,pe,e1,t1), e2,t2) -> + (* reassociate and try again *) + let ne = BinOp(MinusPI,pe,BinOp(MinusA,e1,e2,typeOf e1),t1) in + checkExp ~why:why ne + | BinOp (MinusPI, + BinOp(MinusPI,pe,e1,t1), e2, t2) -> + (* reassociate and try again *) + let ne = BinOp(MinusPI,pe,BinOp(PlusA,e1,e2,typeOf e1),t1) in + checkExp ~why:why ne + | BinOp ((PlusPI | IndexPI | MinusPI) as op, e1, e2, t) -> + let t1 = checkExp ~why e1 in + (* FIXME: __this can appear in t, so we ignore it for now. + At some point, we should check it! *) + (* coerceExp e1 (substType ... t); *) + coerceExp e2 !upointType; + if isTrustedType t1 then + markLocationTrusted () + else begin + let lo, hi = fancyBoundsOfType t1 in + let e2' = + match op with + | MinusPI -> UnOp (Neg, e2, typeOf e2) + | PlusPI | IndexPI -> e2 + | _ -> E.s (bug "Unexpected operation") + in + if why = ForInt then + (* We're casting e to a sentinel or integer. We permit + sentinels to point anywhere, so skip the bounds checks. *) + () + else if isAbstractPtr t1 then + E.s (error "Arithmetic on abstract pointer type %a." dx_type t1) + else + addArithChecks lo e1 e2' hi + end; + if isNullterm t1 then + let lo, hi = fancyBoundsOfType t1 in + let hi' = callMax e hi in + typeAddAttributes [Attr ("nullterm", [])] + (makeFancyPtrType (baseType "nullterm arith" t1) lo hi') + else + t1 + | BinOp (op, e1, e2, t) -> (* Includes MinusPP *) + ignore (checkExp e1); + ignore (checkExp e2); + t + | Lval lv -> checkLval ForRead lv + | CastE (t, e') -> + if isNulltermDrop t then + let t' = checkExp e' in + let lo, hi = fancyBoundsOfType t' in + let bt = baseType "cast to NT" t' in + makeFancyPtrType bt (mkCast lo t) (mkCast hi t) + else begin + let ctx = addThisBinding (localsContext !curFunc) t e in + let t' = substType ctx t in + coerceExp e' t'; + t' + end + | SizeOfE _ + | AlignOfE _ -> + (* We don't check the inner expr because it doesn't get executed. *) + unrollType (typeOf e) + + (* Treat "&((T* )0)->field" as an integer, and don't insert any checks. *) + | AddrOf (Mem (CastE(TPtr(bt, _), z)), off) + | StartOf (Mem (CastE(TPtr(bt, _), z)), off) when isZero z -> + !typeOfSizeOf + | AddrOf lv -> begin + (* Look first for the special case when the lv is an array element. *) + match removeOffsetLval lv with + | lv', Index (idx, NoOffset) -> + (* Turn it into StartOf array + index, so the we account for the + * array bounds *) + checkExp ~why (BinOp (PlusPI, StartOf lv', idx, typeOf (StartOf lv'))) + | _ -> begin + (* There should be some shared code in checking the StartOf and + * AddrOf *) + ignore (checkLval ForAddrOf lv); + let bt = typeOfLval lv in + if List.exists (fun n -> n <> thisKeyword) (depsOfType bt) then + error "Cannot take address of lval (%a) that has dependencies" d_lval lv; + if hasExternalDeps lv then + error "Cannot take address of lval (%a) with external dependencies" d_lval lv; + (* If this is the address of an element inside an array, then take the + * whole array as the bounds *) + let lo = mkAddrOrStartOf lv in + let hi = BinOp (PlusPI, lo, one, typeOf lo) in + makeFancyPtrType bt lo hi + end + end + | StartOf lv -> + let whyLval = + match why with + | ForDeref -> ForRead + | _ -> ForAddrOf + in + let bt, attrs = + match checkLval whyLval lv with + | TArray (bt, _, attrs) -> bt, attrs + | _ -> E.s (bug "Expected array type") + in + let attrs' = + List.filter + (fun (Attr (name, _)) -> + name = "fancybounds" || name = "nullterm" || name = "trusted") + attrs + in + TPtr (bt, attrs') + | Const (CStr s) -> (* String literal *) + let len = String.length s in + let lo = e in + let hi = BinOp (PlusPI, lo, integer len, typeOf lo) in + makeFancyPtrType ~nullterm:true charType lo hi + | Const _ + | SizeOf _ + | SizeOfStr _ + | AlignOf _ -> unrollType (typeOf e) + +and checkLval (why: whyLval) (lv: lval) : typ = + let lv', off = removeOffsetLval lv in + match off with + | NoOffset -> + assert (snd lv' = NoOffset); + let ctx, t = + match fst lv' with + | Mem e -> + let t = checkExp ~why:ForDeref e in + if isTrustedType t then + markLocationTrusted () + else begin + if isSizePtr t then + error "Illegal dereference of a size pointer"; + if isSentinelType t then + errorwarn "Illegal dereference of a sentinel pointer"; + let lo, hi = fancyBoundsOfType t in + addCheck (CNonNull e); + let addUBoundChecks (): unit = + (* FIXME: Add overflow checking here. *) + (* addCheck (COverflow (e, one)); *) + let ePlusOne = BinOp (PlusPI, e, one, t) in + addCheck (CLeq (ePlusOne, hi, "pointer access check")) + in + match why with + | ForRead -> + if not (isNullterm t) then + addUBoundChecks () + | ForAddrOf -> + (* check e != hi even if this is nullterm, because + * otherwise we could create a pointer with bounds hi,hi+1. *) + addUBoundChecks () + | ForCall -> + (* Conservatively forbid assignment of a call result + * when e=hi. *) + addUBoundChecks () + | ForWrite what -> + if isNullterm t then begin + if bitsSizeOf (baseType "mem write" t) > 32 then + unimp "Nullterm writes for base type larger than 32 bits"; + addCheck (CWriteNT (e, hi, mkCast what intType, baseSize t)) + end else + addUBoundChecks () + end; + let bt = + match unrollType t with + | TPtr (bt, _) -> bt + | _ -> E.s (bug "Expected pointer type.") + in + emptyContext, bt + | Var vi -> + let ctx = + if not vi.vglob then + localsContext !curFunc + else + globalsContext vi + in + ctx, vi.vtype + in + let ctx' = addThisBinding ctx t (Lval lv) in + substType ctx' t + | Field (fld, NoOffset) -> + let compType = + (* If why = ForWrite, then we are writing to a field or element of + * lv'. It doesn't make sense to say that we are writing "e" to the + * entire lval, so use the more conservative ForCall instead. *) + let why' = match why with + | ForWrite e -> ForCall + | _ -> why + in + unrollType (checkLval why' lv') + in + let ftype' = + try + polySubst (polyCompMap compType) fld.ftype + with PolyError -> + reportPolyFieldError lv fld + in + if fld.fcomp.cstruct then begin + let ctx = structContext lv' fld.fcomp in + let ctx' = addThisBinding ctx ftype' (Lval lv) in + substType ctx' ftype' + end else begin (* Union *) + (* check the field access *) + if isTrustedComp fld.fcomp then + markLocationTrusted () + else + checkUnionAccess why compType fld; + (* now do the type of the field itself *) + let value = Lval lv in + let ctx = addBinding emptyContext fld.fname value in + let ctx' = addThisBinding ctx ftype' value in + substType ctx' ftype' + end + | Index (index, NoOffset) -> + (* Convert to pointer arithmetic for checking. *) + let p = StartOf lv' in + checkLval why (Mem (BinOp (PlusPI, p, index, typeOf p)), NoOffset) + | _ -> E.s (bug "Unexpected result from removeOffset") + +and checkUnionAccess (why:whyLval) (compType: typ) (fld:fieldinfo): unit = + if (why = ForAddrOf) then + E.s (error "Can't take the address of a union field"); + let wm = fancyWhenOfType compType in + (* Check the selector for the current field. *) + (try + let s = List.assq fld wm in + addCheck (CSelected s) + with Not_found -> () (* a scalar field without a WHEN *) + ); + if why <> ForRead then begin + (* Check that the other selectors are 0 *) + List.iter + (fun (f,s) -> if f != fld then + addCheck (CNotSelected s)) + wm + end; + () + +let checkSetEnv (ctx: context) (x: 'a) (e: exp) (env: 'a list) + (expOf: 'a -> exp) (nameOf: 'a -> string) + (typeOf: 'a -> typ) : unit = + (* Cast e to its new type, so that we do arithmetic correctly. *) + let eCast = mkCast ~e ~newt:(typeOf x) in + let xName = nameOf x in + List.iter + (fun y -> + let yName = nameOf y in + let yType = typeOf y in + if xName = yName || + isUnionType yType || + List.mem xName (depsOfType yType) then begin + let yExp = expOf y in + (* ySubst is the new value of y after the assignment. + * ySubstCast is ySubst with a cast to its new type, for use in + * the enviroment. Without the cast, case cast3 of cast9.c + * incorrectly passes because the arithmetic is wrong. *) + let ySubst, ySubstCast = + if xName <> yName then + yExp, yExp + else + e, eCast + in + let ctx' = + addBinding (addThisBinding ctx yType ySubstCast) xName eCast + in + coerceExp ySubst (substType ctx' yType) + end) + env + +let checkSet (varsInScope: VS.t) (lv: lval) (e: exp) : unit = + (* log "checkSet for %a := %a\n" d_lval lv dx_exp e; *) + let t = checkLval (ForWrite e) lv in + if isConstType t then + warn "Assigning to an ASSUMECONST value. Make sure there are no live values that depend on it."; + let off1, off2 = removeOffset (snd lv) in + begin + match off2 with + | NoOffset -> + begin + match fst lv with + | Var x -> + let ctx, env = + if not x.vglob then begin + (* Add x to the scope. Even if it hasn't been initialized + earlier, we'll want to start checking it now. + Also add anything that x depends on, so that we can compile the + type of x.*) + let varsInScope' = VS.union (Dlocals.localDependsOn x) + (VS.add x varsInScope) in + liveLocalsContext varsInScope', VS.elements varsInScope' + end else + globalsContext x, globalsEnv x + in + checkSetEnv ctx x e env + (fun vi -> Lval (var vi)) + (fun vi -> vi.vname) + (fun vi -> vi.vtype) + | Mem addr -> + let t = typeOfLval lv in + let ctx = addThisBinding emptyContext t e in + coerceExp e (substType ctx t) + end + | Field (x, NoOffset) when x.fcomp.cstruct -> (* struct *) + let baseLval = fst lv, off1 in + let ctx = structContext baseLval x.fcomp in + let env = x.fcomp.cfields in + let map = polyCompMap (typeOfLval baseLval) in + checkSetEnv ctx x e env + (fun fi -> Lval (addOffsetLval (Field (fi, NoOffset)) baseLval)) + (fun fi -> fi.fname) + (fun fi -> + try + polySubst map fi.ftype + with PolyError -> + reportPolyFieldError lv fi) + | Field (x, NoOffset) -> (* Union *) + (* union fields don' +t depend on each other. *) + () + | Index (_, NoOffset) -> + let ctx = addThisBinding emptyContext (typeOfLval lv) e in + coerceExp e (substType ctx (typeOfLval lv)) + | _ -> E.s (bug "Unexpected result from removeOffset") + end; + addInstr (Set (lv, e, !currentLoc)) + +(* Check the right-hand side of a call instruction. The result is an + * _unchecked_ lval temporary representing the result of the call. The + * arguments are the same as for checkCall, although the lval option + * has been changed to a type option for said lval, since this function + * is not supposed to do any checking on the left-hand side. The result + * of this call is Some _ iff lvTypeOpt is Some _. *) +let checkCallRhs (lvTypeOpt: typ option) (fnType: typ) (func: exp) + (args: exp list) (exempt: int list) : lval option = + let returnType, argInfo, varargs, fnAttrs = + match fnType with + | TFun (returnType, argInfo, varargs, fnAttrs) -> + returnType, argInfo, varargs, fnAttrs + | _ -> E.s (error "Expected function type at call: %a" dx_exp func) + in + + (* CIL uses the missingproto attribute to signal that the function + * was used before being declared. *) + if hasAttribute "missingproto" fnAttrs then + errorwarn "Calling function that has no prototype: %a" dx_exp func; + + let returnDeps = if lvTypeOpt <> None then depsOfType returnType else [] in + + let formals : (string * typ * attributes) list = argsToList argInfo in + let numFormals = List.length formals in + let numActuals = List.length args in + + (* Check number of arguments. If there aren't enough actuals, we bail; + * if there aren't enough formals, we can still proceed. *) + if numActuals < numFormals then + E.s (error "Function call has too few arguments") + else if numFormals < numActuals && not varargs then + errorwarn "Function call has too many arguments"; + + (* Split the actuals between those that match the formals, and the ones + * that match the ... *) + let actualsMain, actualsVararg = split args numFormals in + + (* Set up polymorphism. First we match up argument types and formals in + * order to figure out which types are used with which type variables. + * Then we pick a type from among these (or complain if none is to be + * found). Finally, we substitute in the types of formals. *) + polyStart (); + + List.iter2 + (fun (_, ftype, _) arg -> polyMakeSubst ftype (deputyTypeOf arg)) + formals actualsMain; + + polyResolve (); + + let formals = + List.map2 + (fun (fname, ftype, fattrs) arg -> + try + fname, polySubst polyMap ftype, fattrs + with PolyError -> + reportPolyArgError fname ftype arg) + formals actualsMain + in + + (* Build the context for the call: the formals mapped to actuals. + * When needed for the return value, we introduce a temporary to capture + * the value of the actuals before the call. The results are: + * . actualsMain': The new list of actuals (using temporaries). + * . ctxCall: The context mapping formals to actuals. + * . tmpMapping: A mapping of formals to temporary locals, used for + * any formals that the return type depends upon. + *) + let actualsMain', ctxCall, tmpMapping = + try + List.fold_right2 + (fun (argName, argType, _) arg (actualsAcc, ctxAcc, mapAcc) -> + if argName <> "" then + let arg', mapAcc' = + if List.mem argName returnDeps then + (* Optimization: Before inserting a temporary, check to + * see whether we already have a local var. In some cases, + * preprocessing has already placed a temporary here. *) + let vi = + match arg with + | Lval (Var vi, NoOffset) + when (not vi.vaddrof) && (not vi.vglob) -> vi + | _ -> addTmpSet arg + in + Lval (var vi), (argName, vi.vname) :: mapAcc + else + arg, mapAcc + in + (arg' :: actualsAcc, + addBinding ctxAcc argName (mkCast arg' argType), + mapAcc') + else + (arg :: actualsAcc, ctxAcc, mapAcc)) + formals + actualsMain + ([], emptyContext, []) + with Invalid_argument _ -> + E.s (bug "Expected lists with same length") + in + + (* First check any "free" arguments, which are basically trusted. *) + let exempt, freeTypeOpt = + match getFreeArg fnType with + | Some n -> + begin + try + n :: exempt, Some (checkExp (List.nth actualsMain' (n - 1))) + with Failure "nth" -> + E.s (bug "Could not get argument %d." n) + end + | None -> exempt, None + in + + (* Check the actuals that have matching formals. *) + begin + try + iter2_index + (fun (argName, argType, _) arg i -> + if not (List.mem i exempt) then + let ctxCall' = addThisBinding ctxCall argType arg in + let argType' = substType ctxCall' argType in + coerceExp arg argType') + formals + actualsMain' + with Invalid_argument _ -> + E.s (bug "Expected lists with same length") + end; + + (* Check the actuals that match the ... *) + iter_index + (fun arg i -> + if not (List.mem (i + numFormals) exempt) then + ignore (checkExp arg)) + actualsVararg; + + let args' = actualsMain' @ actualsVararg in + + (* Update the return type based on the substitutions we've accumulated + * while checking the arguments. We can then forget all the info about + * polymorphism for this call. *) + let returnType = + try + polySubst polyMap returnType + with PolyError -> + reportPolyRetError func + in + + polyClear (); + + (* Now insert the call itself, with the return placed in a temporary. *) + match lvTypeOpt with + | Some lvType -> + (* If we're allocating, we adjust the type of the return value + * to indicate the number of objects allocated, and we need to do + * some initialization. *) + if isAllocator fnType then + (* Get the base type. *) + let lvBaseType = + match unrollType lvType with + | TPtr (bt, _) -> bt + | TInt _ -> voidType (* Treat integer types like void*. *) + | _ -> E.s (error ("Left-hand side of allocation " ^^ + "is not a pointer type.")) + in + (* If freeTypeOpt <> None, we're reallocing. Make sure the freed + * type is the same as the realloced type. *) + begin + match freeTypeOpt with + | Some freeType -> + begin + match unrollType freeType with + | TPtr (freeBaseType, _) -> + if not (compareTypes freeBaseType lvBaseType) then + error ("Reallocator changes type of memory area.\n" ^^ + " from: %a\n" ^^ + " to: %a") + dx_type lvType dx_type freeType + | _ -> error ("Expected pointer type for freed argument.\n" ^^ + " type: %a\n") dx_type freeType + end + | None -> () + end; + (* Get the size of the array. If we're handling an open array, + * treat "extra" space as the open array, *not* as additional + * malloced objects. *) + let openArrayLen = getOpenArrayLength lvBaseType in + let count, size = getAllocationExp lvType fnType actualsMain' in + if openArrayLen <> None then begin + addCheck (CLeqInt (SizeOf lvBaseType, size, + "open array allocation test")) + end; + let newAttr = + if openArrayLen <> None then + safeAttr + else + let countVar = addTmpSet count in + countAttr (ACons (countVar.vname, [])) + in + let returnType' = + typeAddAttributes [newAttr] + (typeRemoveAttributes ["bounds"; "size"; "nonnull"] lvType) + in + let returnVar = addTmpCall returnType' func args' in + (* Now do some initialization. *) + if typeContainsNonnull (baseType "allocation" returnType') then + error "Allocation of a buffer containing non-null values"; + if typeContainsPtrOrNullterm lvBaseType && freeTypeOpt = None then begin + (* If the type contains pointers or nullterm, just zero out + * the whole thing. *) + (* TODO: We exclude realloc'ed memory, because we don't want + * to overwrite the existing data! Fix this somehow! *) + addInstr (Call (None, Lval (var memset), + [Lval (var returnVar); zero; size], + !currentLoc)) + end else if isNullterm lvType then begin + (* We don't need to zero the whole thing, but we do need to + * zero the last element. *) + let last = BinOp (PlusPI, Lval (var returnVar), count, returnType') in + addInstr (Set ((Mem last, NoOffset), zero, !currentLoc)) + end; + (* Set the size of the open array, if necessary. *) + begin + match openArrayLen with + | Some (fld, atype) -> + let bt = + match unrollType atype with + | TArray (bt, _, _) -> bt + | _ -> E.s (bug "Expected array type.") + in + let loc = Mem (Lval (var returnVar)), Field (fld, NoOffset) in + let count = + BinOp (Div, + BinOp (MinusA, size, SizeOf lvBaseType, !upointType), + SizeOf bt, !upointType) + in + addInstr (Set (loc, count, !currentLoc)) + | None -> () + end; + Some (var returnVar) + else + (* If we're not allocating, create a temporary with the declared + * return value. *) + let returnType' = + substTypeName tmpMapping (typeRemoveAttributes ["nonnull"] returnType) + in + let returnVar = addTmpCall returnType' func args' in + Some (var returnVar) + | None -> + addInstr (Call (None, func, args', !currentLoc)); + None + +(* Check a call instruction. Arguments are the same as for a call + * instruction with the addition of the exempt list. The exempt list + * contains integers indicating which arguments should _not_ be checked. + * Arguments are numbered starting with 1; the return value is indicated + * in this list by 0. *) +let checkCall (varsInScope: VS.t) (lvOpt: lval option) (fnType: typ) (func: exp) + (args: exp list) (exempt: int list) : unit = + let lvTypeOpt = + match lvOpt with + | Some lv -> Some (typeOfLval lv) + | None -> None + in + match lvOpt, checkCallRhs lvTypeOpt fnType func args exempt with + | Some lv, Some lvTmp -> + let e = Lval (lvTmp) in + if not (List.mem 0 exempt) then + checkSet varsInScope lv e + else + addInstr (Set (lv, e, !currentLoc)); + if isPointerType (typeOfLval lvTmp) then + addInstr (Set (lvTmp, zero, !currentLoc)) + | None, None -> () + | _ -> E.s (bug "Unexpected result from checkCallRhs") + +(* FIXME: with all of these special functions, we should pay attention + to the argument numbers in the annotations (e.g. dmemset(1,2,3)). + So far, we assume args are in the usual order. *) +let checkMemset (varsInScope: VS.t) + (lvOpt: lval option) (fnType: typ) (func:exp) (args: exp list) + : unit = + match args with + | [(AddrOf lv1 | StartOf lv1); e2; e3] + when (isZero e2) && (isCorrectSizeOf e3 lv1) -> + (* Special case: if we're overwriting a complete lval with 0, we + don't need to check for dependencies within lv1. We still + check to make sure nothing outside of lv1 depends on lv1. + + We need this when lv1 is a union. It's okay to zero a union, but it's + not normally okay to take the address of a union, since it + depends on its context. + *) + ignore (checkLval ForAddrOf lv1); + if hasExternalDeps lv1 then + E.s (error + "Memset: cannot take address of lval with external dependencies"); + if typeContainsNonnull (typeOfLval lv1) then begin + error "memset on a type containing a nonnull pointer.\n" + end; + checkCall varsInScope lvOpt fnType func [mkAddrOrStartOf lv1; e2; e3] [1] + | [e1; e2; e3] -> + let e1Type = checkExp e1 in + let e1BaseType = + match unrollType e1Type with + | TPtr (bt, _) -> bt + | _ -> E.s (error "First arg to memset is not a pointer") + in + if isTrustedType e1Type then + markLocationTrusted () + else begin + addSizeChecks e1Type e1 e3; + if typeContainsPointers e1BaseType then begin + addCheck (CEq (e2, zero, "memset argument", [])); + addCheck (CMult (SizeOf e1BaseType, e3)) + end; + if typeContainsNonnull e1BaseType then + errorwarn "Calling memset on a type containing a nonnull pointer"; + end; + checkCall varsInScope lvOpt fnType func [e1; e2; e3] [1] + | _ -> E.s (error "Expected three args to memset") + +let checkMemcpy (varsInScope: VS.t) + (lvOpt: lval option) (fnType: typ) (func:exp) (args: exp list) + : unit = + match args with + | [e1; e2; e3] -> + let e1Type = checkExp e1 in + let e2Type = checkExp e2 in + let e1BaseType = + match unrollType e1Type with + | TPtr (bt, _) -> bt + | _ -> E.s (error "First arg to memcpy is not a pointer") + in + let e2BaseType = + match unrollType e2Type with + | TPtr (bt, _) -> bt + | _ -> E.s (error "Second arg to memcpy is not a pointer") + in + if isTrustedType e1Type then + markLocationTrusted () + else begin + addSizeChecks e1Type e1 e3; + if typeContainsPointers e1BaseType then begin + if not (compareTypes e1BaseType e2BaseType) then + errorwarn "Calling memcpy on arrays with different base types"; + addCheck (CMult (SizeOf e1BaseType, e3)) + end; + end; + if isTrustedType e2Type then + markLocationTrusted () + else + addSizeChecks e2Type e2 e3; + checkCall varsInScope lvOpt fnType func [e1; e2; e3] [1; 2] + | _ -> E.s (error "Expected three args to memcpy") + +let checkMemcmp (varsInScope: VS.t) + (lvOpt: lval option) (fnType: typ) (func:exp) (args: exp list) + : unit = + match args with + | [e1; e2; e3] -> + let e1Type = checkExp e1 in + let e2Type = checkExp e2 in + if isTrustedType e1Type then markLocationTrusted () + else + addSizeChecks e1Type e1 e3; + if isTrustedType e2Type then markLocationTrusted () + else + addSizeChecks e2Type e2 e3; + checkCall varsInScope lvOpt fnType func [e1; e2; e3] [1; 2] + | _ -> E.s (error "Expected three args to memcmp") + +(* Check only the right-hand side of an instruction. Used when generating + * automatic bounds for the left-hand side. Returns an expression + * representing the right-hand side, the type of that expression, and + * a list of clean-up instructions to be executed after the expression + * has been used. *) +let checkInstrRhs (instr: instr) : exp * typ * instr list = + let e, instrs = + match instr with + | Call (Some lv, fn, args, _) -> + begin + match checkCallRhs (Some (typeOfLval lv)) (typeOf fn) fn args [] with + | Some lv -> Lval lv, [Set (lv, zero, !currentLoc)] + | None -> E.s (bug "Unexpected result from checkCallRhs") + end + | Call (None, _, _, _) -> + E.s (bug "Expected call with return lval") + | Set (_, e, _) -> + e, [] + | Asm _ -> + E.s (bug "Expected call or set") + in + e, checkExp e, instrs + +(* Check one instruction. + varsInScope is the set of local variables that have been initialized: i.e. + are live or have had their addresses taken. + We'll use this set as the context in checkSetEnv (the Hoare rule). + If we write to any variables, add them to the in-scope set and return the + new set. *) +let checkInstr (varsInScope: VS.t) (instr : instr) : VS.t = + currentLoc := get_instrLoc instr; + markLocationChecked (); + if !verbose then + log "INSTR: %a" dn_instr instr; + let addToScope (lv:lval) : VS.t = + (* We've written to an lval that could be a local var. + Update varsInScope. Also include any vars that vi + depends on, so that we can compile vi's dependencies. *) + match lv with + Var vi,_ when not vi.vglob -> VS.union + (Dlocals.localDependsOn vi) + (VS.add vi varsInScope) + | _ -> varsInScope + in + let addToScopeOpt (lvo:lval option) : VS.t = + match lvo with + Some lv -> addToScope lv + | None -> varsInScope + in + match instr with + | Call (lvOpt, Lval (Var vf, NoOffset), args, _) + when vf.vname = "strcpy" || vf.vname = "strcat" -> + (* Without this check, users get a rather cryptic error message when + using strcpy. We need a better way to forbid use of certain bad + API functions. *) + warn "Calls to %s are unsafe; use newer string functions instead." + vf.vname; + addInstr instr; + addToScopeOpt lvOpt + | Call (lvOpt, fn, _, _) when fn == maxFunction -> + (* Ignore the max function for now. *) + addInstr instr; + addToScopeOpt lvOpt + | Call (lvOpt, fn, args, _) -> + let fnType = checkExp fn in + if isMemset fnType then + checkMemset varsInScope lvOpt fnType fn args + else if isMemcpy fnType then + checkMemcpy varsInScope lvOpt fnType fn args + else if isMemcmp fnType then + checkMemcmp varsInScope lvOpt fnType fn args + else if isVarargOperator fn then begin + (* skip va_start, va_arg, and family *) + if !warnVararg then + warn "Ignoring vararg operator %a" dx_exp fn; + addInstr instr + end + else + checkCall varsInScope lvOpt fnType fn args []; + addToScopeOpt lvOpt + | Set ((Var vi, NoOffset) as lv, _, _) when List.memq vi !exemptLocalVars -> + addInstr instr; + addToScope lv + | Set (lv, e, _) -> + checkSet varsInScope lv e; + addToScope lv + | Asm _ -> + markLocationTrusted (); + if !warnAsm then + warn "Ignoring asm"; + addInstr instr; + varsInScope + +let returnCtx : context ref = ref [] + +let checkReturn (eo : exp option) : unit = + let returnType = + match !curFunc.svar.vtype with + | TFun (returnType, _, _, _) -> returnType + | _ -> E.s (bug "Expected function type") + in + match eo with + | Some e -> + if !verbose then + log "RETURN: %a" dx_exp e; + let ctx = addThisBinding !returnCtx returnType e in + coerceExp e (substType ctx returnType) + | None -> + if !verbose then + log "RETURN: [void]"; + if not (isVoidType returnType) then + errorwarn "Return type of function is not void" + +let rec checkStmt (s : stmt) : unit = + curStmt := s.sid; + currentLoc := get_stmtLoc s.skind; + markLocationChecked (); + let varsInScope = Dlocals.liveAtStmtStart s in + if !verbose then + log "STMT %d. Live vars: %a\n" s.sid + (docList (fun v -> text v.vname)) (VS.elements varsInScope); + let mkBlockMaybe (instrs: instr list) (sk: stmtkind) = + if instrs <> [] then + Block (mkBlock [mkStmt (Instr instrs); mkStmt sk]) + else + sk + in + let sk' = + match s.skind with + | Instr instrs -> + startExtraInstrs (); + ignore (List.fold_left checkInstr varsInScope instrs); + Instr (endExtraInstrs ()) + | Return (eo, _) -> + startExtraInstrs (); + checkReturn eo; + mkBlockMaybe (endExtraInstrs ()) s.skind + | If (e, b1, b2, _) -> + startExtraInstrs (); + coerceExp e intType; + let extras = endExtraInstrs () in + checkBlock b1; + checkBlock b2; + mkBlockMaybe extras s.skind + | Switch (e, b, _, _) -> + startExtraInstrs (); + coerceExp e intType; + let extras = endExtraInstrs () in + checkBlock b; + mkBlockMaybe extras s.skind + | Loop (b, _, _, _) + | Block b -> + checkBlock b; + s.skind + | Goto _ + | Break _ + | Continue _ -> + s.skind + | TryFinally _ + | TryExcept _ -> E.s (E.unimp "exceptions not supported\n") + in + s.skind <- sk' + +and checkBlock (b : block) : unit = + if isTrustedAttr b.battrs then + markTrustedBlock b + else + List.iter + (fun s -> + if !multipleErrors then + try checkStmt s with E.Error -> () + else + checkStmt s) + b.bstmts + +let checkTypedef (ti: typeinfo) : unit = + checkType emptyContext ti.ttype (dprintf "typedef %s" ti.tname) + +let checkStruct (ci: compinfo) : unit = + let ctx = + List.fold_left + (fun acc fld -> addBinding acc fld.fname zero) + emptyContext + ci.cfields + in + List.iter + (fun fld -> checkType ctx fld.ftype + (dprintf "field %s of struct %s" fld.fname ci.cname)) + ci.cfields + +let checkVar (vi: varinfo) (init: initinfo) : unit = + checkType (globalsContext vi) vi.vtype (dprintf "global %s" vi.vname) + +let makeCFG (fd : fundec) : unit = + Cfg.clearCFGinfo fd; (* zra *) + let cnt = Cfg.cfgFun fd in + Cfg.start_id := cnt + !Cfg.start_id + +let checkFundec (fd : fundec) : unit = + if !verbose then + log "Starting function %s" fd.svar.vname; + curFunc := fd; + clearBoundsTable (); + markLocationChecked (); + (* Check types of formals. *) + let ctxFormals = formalsContext fd in + List.iter + (fun vi -> checkType ctxFormals vi.vtype + (dprintf "formal parameter %s" vi.vname)) + fd.sformals; + (* Check types of locals. *) + let ctxLocals = localsContext fd in + List.iter + (fun vi -> checkType ctxLocals vi.vtype + (dprintf "local variable %s" vi.vname)) + fd.slocals; + (* Check type of return value. *) + let returnType = + match fd.svar.vtype with + | TFun (returnType, _, _, _) -> returnType + | _ -> E.s (bug "Expected function type") + in + checkType ctxFormals returnType (text "return type"); + (* Now find out which variables the return type depends upon. Save the + * values of these variables so that we can check the return type later. *) + let returnDeps = depsOfType returnType in + startExtraInstrs (); + returnCtx := + List.fold_right + (fun name acc -> + if name <> thisKeyword then + let vi = + try + List.find (fun vi -> vi.vname = name) fd.sformals + with Not_found -> + E.s (bug "Expected formal named %s" name) + in + addBinding acc name (Lval (var (addTmpSet (Lval (var vi))))) + else + acc) + returnDeps + emptyContext; + let instrs = endExtraInstrs () in + (* We add the instrs to the beginning of the function. We also add an + * empty list to the beginning so that Dlocals.doLiveness can add + * initialization instructions to the first statement without messing up + * the CFG. *) + fd.sbody.bstmts <- mkStmt (Instr []) :: mkStmt (Instr instrs) :: + fd.sbody.bstmts; + (* fix block, see if cfg should be used, check block *) + fixBlock fd.sbody; + makeCFG fd; (* formerly done only if !optLevel >= 2 *) + Stats.time "Liveness" Dlocals.doLiveness fd; + checkBlock fd.sbody; + (* Clean up. *) + curFunc := dummyFunDec; + curStmt := -1; + returnCtx := emptyContext; + Dlocals.clearLiveness (); + () + + +(** Check the functions in a file. *) +let checkFile (f: file) (globinit: fundec) (fdat : DPF.functionData) : unit = + if !verbose then + log "Using optimization level %d" !optLevel; + allowChecks := true; + iterGlobals f + (fun global -> + match global with + | GType (ti, _) -> checkTypedef ti + | GCompTag (ci, _) when ci.cstruct -> checkStruct ci + | GVar (vi, init, _) -> checkVar vi init + | GFun (fd, loc) -> + if isTrustedType fd.svar.vtype then + markTrustedBlock fd.sbody + else begin + checkFundec fd; + DO.optimFunction fd loc fdat; + end + | _ -> ()); + () diff --git a/src/dcheck.mli b/src/dcheck.mli new file mode 100644 index 0000000..c3f5537 --- /dev/null +++ b/src/dcheck.mli @@ -0,0 +1,45 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 fixBlock : ?giveID:bool -> Cil.block -> unit +val exemptLocalVars : Cil.varinfo list ref +val startExtraInstrs : unit -> unit +val endExtraInstrs : unit -> Cil.instr list +val checkInstrRhs : Cil.instr -> Cil.exp * Cil.typ * Cil.instr list +val checkInstr : Usedef.VS.t -> Cil.instr -> Usedef.VS.t +val checkFundec : Cil.fundec -> unit +val checkFile : Cil.file -> Cil.fundec -> Dprecfinder.functionData -> unit diff --git a/src/dcheckdef.ml b/src/dcheckdef.ml new file mode 100644 index 0000000..38711e3 --- /dev/null +++ b/src/dcheckdef.ml @@ -0,0 +1,429 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 Expcompare +open Dutil +open Dattrs + +module E = Errormsg +module DCE = Dcanonexp + +type check = + CNonNull of exp (** e != 0 *) + | CEq of exp * exp * string * doc list + (** e1 == e2 *) + | CMult of exp * exp (** e1 * k == e2 for some int k *) + | CPtrArith of exp * exp * exp * exp * int + (** e3 + (e4 * size) does not overflow, and + * e1 <= e3 + (e4 * size) <= e2. *) + | CPtrArithNT of exp * exp * exp * exp * int + (** e3 + (e4 * size) does not overflow, and + * e1 <= e3 + (e4 * size) <= (e2 + sizeof(e2)). *) + | CPtrArithAccess of exp * exp * exp * exp * int + (** e3 + ((e4+1) * size) does not overflow, and + * e1 <= e3 + ((e4+1) * size) <= e2. *) + | CLeqInt of exp * exp * string + (** e1 <= e2, unsigned. + * Also remember why this check was added. *) + | CLeq of exp * exp * string + (** e1 <= e2, unsigned. + * Also remember why this check was added. *) + | CLeqNT of exp * exp * int * string + (** e1 <= (e2 + sizeof(e2)), unsigned. + * The int is the size of the base type. + * Also remember why this check was added. *) + | CNullOrLeq of exp * exp * exp * string + (** e1 == 0 || e2 <= e3. + * Also remember why this check was added. *) + | CNullOrLeqNT of exp * exp * exp * int * string + (** e1 == 0 || e2 <= (e3 + sizeof(e3)). + * The int is the size of the base type. + * Also remember why this check was added. *) + | CWriteNT of exp * exp * exp * int + (** (e1 == e2) ==> (e3 = 0) + * The int is the size of the base type. *) + | CNullUnionOrSelected of lval * exp + (** lv = \vec{0} || e. + Here, e is a shortcut saying that if the + newly-active field is the same as the old + active field, we don't check for the union + equalling zero.*) + (* These two are redundant with CNonNull and CEq, but having separate + checks for unions gives better error messages: *) + | CSelected of exp (** e != 0 *) + | CNotSelected of exp (** e == 0 *) +(* Other checks will be needed, such as nullterm checks and checks for when + part of one of the above checks can be proved statically. *) + + +(* These aren't real variables. In the output, they'll show up as + __LOCATION__, which is a macro defined in deputy/checks.h. We use them + for calling runtime check functions. *) +let locationToken : exp = + let vi = makeGlobalVar "__LOCATION__" charPtrType in + Lval (var vi) + +let mkFun (name: string) (rt:typ) (args: typ list) : exp = + let fdec = emptyFunction name in + let args = List.map (fun t -> ("", t, [])) args in + fdec.svar.vtype <- TFun(rt, Some args, false, []); + Lval (var fdec.svar) + +let mkCheckFun (name: string) (n: int) : exp = + (* A check function takes n void* parameters, a location *) + let args = Util.list_init n (fun _ -> voidPtrType) in + let args' = args @ [charPtrType] in + mkFun name voidType args' + +let cnonnull = mkCheckFun "CNonNull" 1 +let ceq = mkCheckFun "CEq" 3 +let cmult = mkCheckFun "CMult" 2 +let cptrarith = mkCheckFun "CPtrArith" 5 +let cptrarithaccess = mkCheckFun "CPtrArithAccess" 5 +let cptrarithnt = mkCheckFun "CPtrArithNT" 5 +let cleqint = mkCheckFun "CLeqInt" 3 +let cleq = mkCheckFun "CLeq" 3 +let cleqnt = mkCheckFun "CLeqNT" 4 +let cnullorleq = mkCheckFun "CNullOrLeq" 4 +let cnullorleqnt = mkCheckFun "CNullOrLeqNT" 5 +let cwritent = mkCheckFun "CWriteNT" 4 +let cnullunion = mkCheckFun "CNullUnionOrSelected" 3 +let cselected = mkCheckFun "CSelected" 1 +let cnotselected = mkCheckFun "CNotSelected" 1 + +let unmkString (e: exp) : string = + match e with + | Const (CStr s) -> s + | _ -> E.s (bug "Expected string constant") + +let toInt (e:exp) : int = + match isInteger e with + Some i64 -> to_int i64 + | None -> + E.s (bug "expected a constant int for the size param in this check.") + +let checkFunctions : exp list = + [ cnonnull; ceq; cmult; cptrarith; cptrarithnt; cleqint; + cleq; cleqnt; cnullorleq; cnullorleqnt; cwritent; cnullunion; + cselected; cnotselected; cptrarithaccess ] + +(* This function gives a high-level reason for each check. The text here + * should mirror the text in the runtime library, where possible. *) +let checkWhy (c: check) : string = + match c with + | CNonNull _ -> "non-null check" + | CEq (_, _, why, _) -> why + | CMult _ -> "alignment check" + | CPtrArithAccess _ -> "pointer arithmetic and dereference check" + | CPtrArith _ -> "pointer arithmetic check" + | CPtrArithNT _ -> "nullterm pointer arithmetic check" + | CLeqInt (_, _, why) -> why + | CLeq (_, _, why) -> why + | CLeqNT (_, _, _, why) -> why + | CNullOrLeq (_, _, _, why) -> why + | CNullOrLeqNT (_, _, _, _, why) -> why + | CWriteNT _ -> "nullterm write check" + | CNullUnionOrSelected _ -> "null union check" + | CSelected _ -> "check that union field is selected" + | CNotSelected _ -> "check that union field is not selected" + +(* This function gives a textual representation of a given check for + * error-reporting purposes. *) +let checkText (c: check) : doc list = + startTemps (); + let docs = + match c with + | CNonNull (e) -> + [dprintf "%a != 0%t" dc_exp e dx_temps] + | CEq (e1,e2,why,docs) -> + if docs <> [] then + docs + else + [dprintf "%a == %a%t" dc_exp e1 dc_exp e2 dx_temps] + | CMult (e1,e2) -> + [dprintf "%a %% %a == 0%t" dc_exp e2 dc_exp e1 dx_temps] + | CPtrArithAccess(e1,e2,e3,e4,e5) -> + [dprintf "%a <= %a + %a + 1 (with no overflow)%t" + dc_exp e1 dc_exp e3 dc_exp e4 dx_temps; + dprintf "%a + %a + 1 <= %a (with no overflow)%t" + dc_exp e3 dc_exp e4 dc_exp e2 dx_temps] + | CPtrArith (e1,e2,e3,e4,e5) -> + [dprintf "%a <= %a + %a (with no overflow)%t" + dc_exp e1 dc_exp e3 dc_exp e4 dx_temps; + dprintf "%a + %a <= %a (with no overflow)%t" + dc_exp e3 dc_exp e4 dc_exp e2 dx_temps] + | CPtrArithNT (e1,e2,e3,e4,e5) -> + [dprintf "%a <= %a + %a (with no overflow)%t" + dc_exp e1 dc_exp e3 dc_exp e4 dx_temps; + dprintf "%a + %a <= %a + len(%a) (with no overflow)%t" + dc_exp e3 dc_exp e4 dc_exp e2 dc_exp e2 dx_temps] + | CLeqInt (e1,e2,why) -> + [dprintf "%a <= %a%t" dc_exp e1 dc_exp e2 dx_temps] + | CLeq (e1,e2,why) -> + [dprintf "%a <= %a%t" dc_exp e1 dc_exp e2 dx_temps] + | CLeqNT (e1,e2,e3,why) -> + [dprintf "%a <= %a + len(%a)%t" dc_exp e1 dc_exp e2 dc_exp e2 dx_temps] + | CNullOrLeq (e1,e2,e3,why) -> + [dprintf "%a == 0 || %a <= %a%t" dc_exp e1 dc_exp e2 dc_exp e3 dx_temps] + | CNullOrLeqNT (e1,e2,e3,e4,why) -> + [dprintf "%a == 0 || %a <= %a + len(%a)%t" + dc_exp e1 dc_exp e2 dc_exp e3 dc_exp e3 dx_temps] + | CWriteNT (p,hi,what,sz) -> + [dprintf "%a != %a || *(%a) != 0 || %a == 0%t" + dc_exp p dc_exp hi dc_exp p dc_exp what dx_temps] + | CNullUnionOrSelected (lv, sameFieldSelected) -> + [dprintf "%a || iszero(%a)%t" + dc_exp sameFieldSelected dx_lval lv dx_temps] + | CSelected (e) -> + [dprintf "%a%t" dc_exp e dx_temps] + | CNotSelected (e) -> + [dprintf "! %a%t" dc_exp e dx_temps] + in + stopTemps (); + docs + +let instrToCheck (instr: instr) : check option = + match instr with + | Call (None, fn, args, _) when List.exists (compareExp fn) checkFunctions -> + let c = + match args with + | [e;_;_] when compareExp fn cnonnull -> + CNonNull e + | [e1;e2;why;doc;_] when compareExp fn ceq -> + CEq (e1,e2,unmkString why,[text (unmkString doc)]) + | [e1;e2;_;_] when compareExp fn cmult -> + CMult (e1,e2) + | [e1;e2;e3;e4;e5;_;_;_] when compareExp fn cptrarith -> + CPtrArith (e1,e2,e3,e4,toInt e5) + | [e1;e2;e3;e4;e5;_;_;_] when compareExp fn cptrarithaccess -> + CPtrArithAccess (e1,e2,e3,e4,toInt e5) + | [e1;e2;e3;e4;e5;_;_;_] when compareExp fn cptrarithnt -> + CPtrArithNT (e1,e2,e3,e4,toInt e5) + | [e1;e2;why;_;_] when compareExp fn cleqint -> + CLeqInt (e1,e2,unmkString why) + | [e1;e2;why;_;_] when compareExp fn cleq -> + CLeq (e1,e2,unmkString why) + | [e1;e2;e3;why;_;_] when compareExp fn cleqnt -> + CLeqNT (e1,e2,toInt e3,unmkString why) + | [e1;e2;e3;why;_;_] when compareExp fn cnullorleq -> + CNullOrLeq (e1,e2,e3,unmkString why) + | [e1;e2;e3;e4;why;_;_] when compareExp fn cnullorleqnt -> + CNullOrLeqNT (e1,e2,e3,toInt e4,unmkString why) + | [p;hi;what;sz;_;_] when compareExp fn cwritent -> + CWriteNT (p,hi,what,toInt sz) + | [AddrOf lv;_;e;_;_] when compareExp fn cnullunion -> + CNullUnionOrSelected (lv, e) + | [e;_;_] when compareExp fn cselected -> + CSelected (e) + | [e;_;_] when compareExp fn cnotselected -> + CNotSelected (e) + | _ -> + E.s (bug "Check instruction not recognized: %a" d_instr instr) + in + Some c + | _ -> None + +let checkToInstr (c:check) : instr = + let call f args docs = + (* Append the file and line to the end of the args *) + let extraArgs = + List.fold_right + (fun doc acc -> Const (CStr (sprint 1000000 doc)) :: acc) + docs [locationToken] + in + Call (None, f, args @ extraArgs, !currentLoc) + in + let docs = checkText c in + (* Use dc_exp instead of dx_exp so we don't print so many casts in the + "why" messages of checks. *) + let i = + match c with + | CNonNull (e) -> + call cnonnull [e] docs + | CEq (e1,e2,why,_) -> + call ceq [e1;e2;mkString why] docs + | CMult (e1,e2) -> + call cmult [e1;e2] docs + | CPtrArithAccess(e1,e2,e3,e4,e5) -> + call cptrarithaccess [e1;e2;e3;e4;integer e5] docs + | CPtrArith (e1,e2,e3,e4,e5) -> + call cptrarith [e1;e2;e3;e4;integer e5] docs + | CPtrArithNT (e1,e2,e3,e4,e5) -> + call cptrarithnt [e1;e2;e3;e4;integer e5] docs + | CLeqInt (e1,e2,why) -> + call cleqint [e1;e2;mkString why] docs + | CLeq (e1,e2,why) -> + call cleq [e1;e2;mkString why] docs + | CLeqNT (e1,e2,e3,why) -> + call cleqnt [e1;e2;integer e3;mkString why] docs + | CNullOrLeq (e1,e2,e3,why) -> + call cnullorleq [e1;e2;e3;mkString why] docs + | CNullOrLeqNT (e1,e2,e3,e4,why) -> + call cnullorleqnt [e1;e2;e3;integer e4;mkString why] docs + | CWriteNT (p,hi,what,sz) -> + call cwritent [p;hi;what;integer sz] docs + | CNullUnionOrSelected (lv, sameFieldSelected) -> + let sz = sizeOf (typeOfLval lv) in + call cnullunion [mkAddrOf lv; sz; sameFieldSelected] docs + | CSelected (e) -> + call cselected [e] docs + | CNotSelected (e) -> + call cnotselected [e] docs + in + (* For the optimizer to work properly, we must be able to convert instrs + * back to the original check. As a sanity check, we verify here that + * this is possible for each instr we generate. *) + if instrToCheck i = None then + E.s (bug "checkToInstr not invertible"); + i + +let checks_equal c1 c2 = +let ce = (*deputyStripAndCompareExp*) DCE.canonCompareExp in +match c1, c2 with +| CEq(e11,e12,_,_), CEq(e21,e22,_,_) +| CMult(e11,e12), CMult(e21, e22) +| CLeqInt(e11,e12,_), CLeqInt(e21,e22,_) +| CLeq(e11,e12,_), CLeq(e21,e22,_) -> + (ce e11 e21) && + (ce e12 e22) +| CLeqNT(e11,e12,sz1,_), CLeqNT(e21,e22,sz2,_) -> + (ce e11 e21) && + (ce e12 e22) && + sz1 = sz2 +| CNullOrLeq(e11,e12,e13,_), CNullOrLeq(e21,e22,e23,_) -> + (ce e11 e21) && + (ce e12 e22) && + (ce e13 e23) +| CNullOrLeqNT(e11,e12,e13,sz1,_), CNullOrLeqNT(e21,e22,e23,sz2,_) +| CWriteNT(e11,e12,e13,sz1),CWriteNT(e21,e22,e23,sz2) -> + (ce e11 e21) && + (ce e12 e22) && + (ce e13 e23) && + sz1 = sz2 +| CPtrArithAccess(e11,e12,e13,e14,sz1), CPtrArithAccess(e21,e22,e23,e24,sz2) -> + (ce e11 e21) && + (ce e12 e22) && + (ce e13 e23) && + (ce e14 e24) && + sz1 = sz2 +| CPtrArith(e11,e12,e13,e14,sz1), CPtrArith(e21,e22,e23,e24,sz2) +| CPtrArithNT(e11,e12,e13,e14,sz1), CPtrArithNT(e21,e22,e23,e24,sz2) -> + (ce e11 e21) && + (ce e12 e22) && + (ce e13 e23) && + (ce e14 e24) && + sz1 = sz2 +| CNullUnionOrSelected(l1, e1), CNullUnionOrSelected(l2, e2) -> + (compareLval l1 l2) && + (ce e1 e2) +| CSelected e1, CSelected e2 +| CNotSelected e1, CNotSelected e2 +| CNonNull e1, CNonNull e2 -> + ce e1 e2 +| _ -> false + + +let isDeputyFunctionLval (e:exp) : bool = + List.exists (compareExp e) checkFunctions || + match e with + | Lval(Var vf,NoOffset) -> begin + vf.vname = "deputy_findnull" || + vf.vname = "deputy_max" + end + | _ -> false + +(* + * Return true if i is a deputy + * runtime check. + *) +let is_check_instr i = + match instrToCheck i with + None -> false + | Some _ -> true + +let is_deputy_fun i = match i with + Call(_,Lval(Var vf,NoOffset),_,_) -> + vf.vname = "deputy_findnull" || + vf.vname = "deputy_max" + | _ -> false + +let alloc_names = [ + "malloc"; + "calloc"; + "realloc"; + "xmalloc"; + "__builtin_alloca"; + "alloca"; + "kmalloc" +] + +let libc_no_side_effects = [ + "printf"; +] @ alloc_names + +let is_alloc_fun i = + match i with + | Call(_,Lval(Var vf,NoOffset),_,_) -> + List.mem vf.vname alloc_names + | _ -> false + +let isLibcNoSideEffects i = + match i with + | Call(_,Lval(Var vf,NoOffset),_,_) -> + List.mem vf.vname libc_no_side_effects || + (hasAttribute "pure" vf.vattr) || + (hasAttribute "pure" (typeAttrs vf.vtype)) + | _ -> false + +let lvNoSideEffects lve = + List.mem lve checkFunctions || + match lve with + | Lval(Var vf, NoOffset) -> + List.mem vf.vname libc_no_side_effects || + (hasAttribute "pure" vf.vattr) || + (hasAttribute "pure" (typeAttrs vf.vtype)) + | _ -> false + +(* + * Return true if i is any + * instruction that deputy added. + *) +let is_deputy_instr i = + match instrToCheck i with + Some _ -> true + | None -> is_deputy_fun i diff --git a/src/dcheckdef.mli b/src/dcheckdef.mli new file mode 100644 index 0000000..1da754d --- /dev/null +++ b/src/dcheckdef.mli @@ -0,0 +1,66 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 = + CNonNull of Cil.exp + | CEq of Cil.exp * Cil.exp * string * Pretty.doc list + | CMult of Cil.exp * Cil.exp + | CPtrArith of Cil.exp * Cil.exp * Cil.exp * Cil.exp * int + | CPtrArithNT of Cil.exp * Cil.exp * Cil.exp * Cil.exp * int + | CPtrArithAccess of Cil.exp * Cil.exp * Cil.exp * Cil.exp * int + | CLeqInt of Cil.exp * Cil.exp * string + | CLeq of Cil.exp * Cil.exp * string + | CLeqNT of Cil.exp * Cil.exp * int * string + | CNullOrLeq of Cil.exp * Cil.exp * Cil.exp * string + | CNullOrLeqNT of Cil.exp * Cil.exp * Cil.exp * int * string + | CWriteNT of Cil.exp * Cil.exp * Cil.exp * int + | CNullUnionOrSelected of Cil.lval * Cil.exp + | CSelected of Cil.exp + | CNotSelected of Cil.exp +val checks_equal : check -> check -> bool +val mkFun : string -> Cil.typ -> Cil.typ list -> Cil.exp +val checkWhy : check -> string +val checkText : check -> Pretty.doc list +val instrToCheck : Cil.instr -> check option +val checkToInstr : check -> Cil.instr +val isDeputyFunctionLval : Cil.exp -> bool +val is_check_instr : Cil.instr -> bool +val is_deputy_instr : Cil.instr -> bool +val is_deputy_fun : Cil.instr -> bool +val is_alloc_fun : Cil.instr -> bool +val isLibcNoSideEffects : Cil.instr -> bool +val lvNoSideEffects : Cil.exp -> bool diff --git a/src/dglobinit.ml b/src/dglobinit.ml new file mode 100755 index 0000000..0dfa380 --- /dev/null +++ b/src/dglobinit.ml @@ -0,0 +1,261 @@ + +(** Process the global initializer *) +open Cil +open Pretty +open Dattrs +open Doptions +open Dutil +open Dcheckdef + +module E = Errormsg +module IH = Inthash + +(*** PREPROCESSING **) + +(* Make a function that contains all the assignments that would be needed to + * initialize the globals. We expect the checker to add the necessary checks, + * and the optimizers to remove ALL of them. We'll check this later. Call + * this then the global initializers have been finished, but before inserting + * checks. *) +let prepareGlobalInitializers (f: file) : fundec = + (* Create a function at the end of the file *) + let fd = emptyFunction "__deputy_global_initializers" in + fd.svar.vstorage <- Static; + setFunctionType fd (TFun(voidType, Some [], false, [])); + (* We do not insert it in the file *) + + (* Now scan all global data defined in this file. *) + let instrs : instr list ref = ref [] in + + let rec doInit (lv: lval) (i: init) : unit = + let addi (lv': lval) (e': exp) : unit = + instrs := (Set(lv', e', !currentLoc)) :: !instrs + in + let doSubInit () : unit = + match i with + CompoundInit (ct, initl) -> + foldLeftCompound ~implicit:true + ~doinit:(fun off' i' t' acc -> + if not (isOpenArray t') then + doInit (addOffsetLval off' lv) i') + ~ct:ct + ~initl:initl + ~acc:() + + | _ -> () + in + match unrollType (typeOfLval lv), i with + | TPtr _, SingleInit e -> (* All pointers are checked *) + addi lv e + + (* For arrays whose base type contains pointers or null-term, we + * check the whole array *) + | TArray(bt, _, a), _ when typeContainsPtrOrNullterm bt -> + doSubInit () + + (* For arrays whose base type does not contain pointers or nullterm, + * but are nullterm themselves, we check the last element only *) + | (TArray(_, _, a) as arrt), + CompoundInit (_, initl) when hasAttribute "nullterm" a -> + begin + (* Scan all (including implicit initializers) and remember the last*) + let last : (offset * init) option ref = ref None in + foldLeftCompound + ~implicit:true + ~doinit:(fun off' i' t acc -> last := Some (off', i')) + ~ct:arrt + ~initl:initl + ~acc:(); + match !last with + | Some (off', SingleInit e') -> + addi (addOffsetLval off' lv) e' + | Some (_, CompoundInit _) -> + unimp ("Cannot initialize a global nullterm " ^^ + "array of arrays or structs.") + | None -> E.s (bug "Missing implicit initializer for %a." d_lval lv) + end + + (* For structs that contain pointers of null-term we check the whole + * thing *) + | TComp _ as t, _ when typeContainsPtrOrNullterm t -> doSubInit () + + (* For other things we do not need to check anything *) + | _, _ -> () + in + + iterGlobals f + (function + GVar(gvi, {init = inito}, l) + when not (isTrustedAttr (typeAttrs gvi.vtype)) -> + let init' = + match inito with + None -> makeZeroInit gvi.vtype + | Some init' -> init' + in + doInit (var gvi) init' + | _ -> ()); + + fd.sbody <- mkBlock [mkStmt (Instr (List.rev !instrs))]; + + + fd + + +(** Call this function after you inserted the checks, to perform the + * optimization of the global initializer. Return true if we still have + * residual checks. *) +let checkGlobinit (f: file) + (gi: fundec) + (check: fundec -> unit) + (optim: fundec -> location -> unit) : bool = + (* Before optimization we replace all the references to global data with the + * actual data in the initializer. *) + if !verbose then + log "checkGlobinit\n"; + + (* insert the checks *) + check gi; + + if !verbose then + log "prepare global initializer for optimizations\n"; + + (* First, create a hash-table with the initializers for each global, + * indexed by the vid *) + let globinits : init IH.t = IH.create 13 in + iterGlobals f + (function + GVar(gvi, { init = Some i }, _) -> IH.add globinits gvi.vid i + | _ -> ()); + + let replaceGlobalsVisitor = object (self) + inherit nopCilVisitor + method vtype (t: typ) = SkipChildren + + method vexpr (e: exp) = + match e with + | Lval (Var g, off) when g.vglob && not (isFunctionType g.vtype) && + g.vname <> "__LOCATION__" -> begin + let off' = visitCilOffset (self :> cilVisitor) off in + (* Now fetch the value of this lval from the globinits *) + let i: init = + try IH.find globinits g.vid + with Not_found -> makeZeroInit g.vtype + in + (* + ignore (log "Find init for %a in %a\n" + d_lval (Var g, off) + d_init i); + *) + let rec findInit (i: init) (off: offset) : exp = + match off, i with + NoOffset, SingleInit e -> e (* We found it *) + | Index(idx, off'), CompoundInit (ct, inits) -> begin + let expToInt (e: exp) : int = + match isInteger (constFold true e) with + Some i -> to_int i + | None -> E.s (unimp "Integer index %a not a constant" + d_exp e) + in + let idxi : int = expToInt idx in + (* Find the field in the inits *) + let found : init option ref = ref None in + (try + foldLeftCompound + ~implicit:true + ~doinit:(fun off i t () -> + match off with + Index(thisidx, _) -> + let thisi = expToInt thisidx in + if thisi = idxi then begin + found := Some i; + raise Not_found (* Skip the rest *) + end + | _ -> assert false) + ~ct:ct + ~initl:inits + ~acc:() + with Not_found ->()); + + match !found with + Some i -> findInit i off' + | None -> + E.s (unimp "Cannot find initializer for %a" + d_lval (Var g, off)) + end + + | Field(fld, off'), CompoundInit (ct, inits) -> begin + (* Find the field in the inits *) + try + match List.find (function (Field(fld', _), _) -> fld' == fld + | _ -> assert false) + inits with + Field(_, _), fi -> findInit fi off' + | _ -> assert false + with Not_found -> + E.s (unimp "Cannot find initializer for field %s" fld.fname) + end + | _, SingleInit _ -> + E.s (unimp "SingleInit for compound value (%a)" + (d_offset (text g.vname)) off) + | NoOffset, CompoundInit _ -> + E.s (unimp "global initializer reads CompoundInit") + in + ChangeTo (findInit i off') + end + | SizeOfE _ | AlignOfE _ -> + (* Skip size/align because these may contain large array values. + * See small/global8. *) + SkipChildren + | _ -> DoChildren + + method vinst (i: instr) = + (* Drop the instructions that initialize the initializers. Hopefully we + * do not drop other instructios too *) + match i with + Set _ -> ChangeTo [] + | _ -> DoChildren + + end in + gi.sbody <- visitCilBlock replaceGlobalsVisitor gi.sbody; + + if !verbose then + log "optimize the global initializer\n"; + + (* Now we optimize *) + optim gi locUnknown; + + let suppressGlobalInitWarnings = ref false in + + (** Now check the global initializers, after the optimizations. Return true + * if we have residual checks for global initializer. *) + (* The global initializer function must be empty. Give an error message for + * each check in the file *) + let hadErrors = ref false in + let reportChecksVisitor = object (self) + inherit nopCilVisitor + + method vexpr (e: exp) = SkipChildren + + method vinst (i: instr) = + if (instrToCheck i) <> None then begin + hadErrors := true; + if not !suppressGlobalInitWarnings then begin + (* Doptions.strictGlobInit chooses whether this should be an + error or a warning. FIXME: always make it an error (bug?) + once we're sure we've covered all of the cases. *) + if !Doptions.strictGlobInit then + error "Undischarged check for global initializer:\n%a\n" + dn_instr i + else + ignore (warn "Undischarged check for global initializer:\n%a\n" + dn_instr i); + (* suppressGlobalInitWarnings := true; *) + end; + end; + SkipChildren + + end in + suppressGlobalInitWarnings := false; (* We give one warning for each file *) + ignore (visitCilBlock (reportChecksVisitor :> cilVisitor) gi.sbody); + + !hadErrors diff --git a/src/dglobinit.mli b/src/dglobinit.mli new file mode 100644 index 0000000..8c6ddea --- /dev/null +++ b/src/dglobinit.mli @@ -0,0 +1,41 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 prepareGlobalInitializers : Cil.file -> Cil.fundec +val checkGlobinit : + Cil.file -> Cil.fundec -> (Cil.fundec -> unit) -> + (Cil.fundec -> Cil.location -> unit) -> bool diff --git a/src/dinfer.ml b/src/dinfer.ml new file mode 100755 index 0000000..3ae375d --- /dev/null +++ b/src/dinfer.ml @@ -0,0 +1,1720 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 Expcompare +open Pretty +open Dattrs +open Doptions +open Dutil +open Dcheckdef +open Dcheck + +module E = Errormsg +module DC = Dcheck +module DO = Doptimmain +module S = Stats +module N = Ptrnode +module H = Hashtbl + +(**************************************************************************) + + +(* Get the base type and attributes of a pointer type. + * If this is a void* type, see if we've inferred a better type for it. *) +let getPointerType (t: typ) (where: string) : typ * attributes = + match unrollType t with + | TPtr (bt, a) when isVoidType bt -> begin + (* This is a void*. Have we inferred a better type for it?*) + match N.nodeOfAttrlist a with + Some n when not (isVoidType (N.get_rep n).N.btype) -> + (* we have a better type *) + let rep = N.get_rep n in + if hasAttribute "trusted" a || hasAttribute "ntexpand" a then begin + (* Don't replace *) + bt, a + end + else if (hasAttribute "bounds" a || hasAttribute "size" a) + && not (hasDefaultAnnot a) then + begin + (* Don't replace if this void* has an explicit annotation. *) + if !verbose then + log ("Not replacing %a in %s with a true type because "^^ + "it has an annotation.\n") + dx_type t where; + bt, a + end + else begin + if !verbose then + log "Replacing %a in %s with %a." + dx_type t where dx_type (TPtr(rep.N.btype,a)); + rep.N.btype, a + end + | _ -> (* No better type, so keep the void* *) + bt, a + end + | TPtr (bt, a) -> + bt, a + | _ -> E.s (error "Expected pointer type in %s" where) + + +(**************************************************************************) + +let debugAuto = false + + +let findnull = mkFun "deputy_findnull" intType + [typeAddAttributes [count0Attr; trustedAttr] voidPtrType; intType] + +let hasBoundsAttr (t: typ) : bool = + hasAttribute "bounds" (typeAttrs t) + +let getBoundsAttr (t: typ) : attrparam list = + match filterAttributes "bounds" (typeAttrs t) with + | [Attr ("bounds", aps)] -> aps + | [] -> E.s (bug "Expected bound attribute") + | _ -> E.s (error "Type has more than one bound attribute: \"%a\"" + dx_type t) + +let setBoundsAttr (t: typ) (aps: attrparam list) : typ = + typeAddAttributes [Attr ("bounds", aps)] (typeRemoveAttributes ["bounds"] t) + +let hasAutoBounds (t: typ) : bool = + isPointerType t && + hasBoundsAttr t && + match getBoundsAttr t with + | [ACons (n, []); _] when n = autoKeyword -> true + | [_; ACons (n, [])] when n = autoKeyword -> true + | [_; _] -> false + | _ -> E.s (bug "Bounds attribute does not have two arguments") + +let mapBounds (fn: attrparam -> string -> attrparam) (aps: attrparam list) + : attrparam list = + match aps with + | [b; e] -> [fn b "b"; fn e "e"] + | _ -> E.s (bug "Bounds attribute does not have two arguments") + +(* The name of a fat structure, based on base type and the meta fields. We + * must differentiate in the name all attributes of types that we do not want + * to conflate. *) +let fatStructName (bt: typ) (metafields: (string * typ) list) = + let rec btname = function + | TNamed (t, _) -> t.tname + | TBuiltin_va_list _ -> "va_list" + | TVoid(_) -> "void" + | TInt(IInt,_) -> "int" + | TInt(IUInt,_) -> "uint" + | TInt(IShort,_) -> "short" + | TInt(IUShort,_) -> "ushort" + | TInt(IChar,_) -> "char" + | TInt(IUChar,_) -> "uchar" + | TInt(ISChar,_) -> "schar" + | TInt(ILong,_) -> "long" + | TInt(IULong,_) -> "ulong" + | TInt(ILongLong,_) -> "llong" + | TInt(IULongLong,_) -> "ullong" + | TFloat(FFloat,_) -> "float" + | TFloat(FDouble,_) -> "double" + | TFloat(FLongDouble,_) -> "ldouble" + | TEnum (enum, _) -> "e_" ^ enum.ename + | TComp (comp, _) -> + let su = if comp.cstruct then "s_" else "u_" in + su ^ comp.cname + | TFun _ -> "fun" + | TPtr(t, a) -> + let atn = + if hasAttribute "nullterm" a then + "n" + else + "" + in + "p" ^ atn ^ "_" ^ btname t + | TArray(t, sz, _) -> "a_" ^ btname t + in + List.fold_left + (fun acc (s, _) -> + (* We assume that s starts with __ *) + acc ^ + (if String.length s > 2 then + String.sub s 2 (String.length s - 2) else s)) + ((btname bt) ^ "_") + metafields + +(** Keep a list of the fat structs, indexed by their name *) +let fatStructs: (string, typ) H.t = H.create 13 + +(** Keep a list of global declarations that we must add, in reverse order *) +let preAutoDecls: global list ref = ref [] + +(** Make a fat struct. Each field is described with a name and type. We + * assume that the names are of the form "__x", where "x" a suffix (either + * "b" or "e" for now). The main field is called __p and is always the first + * one. *) +let makeFatStruct (dt: typ) (* type of the data field *) + (metafields: (string * typ) list) : typ = + (* Get the name of the fat struct, based on base type and suffixes *) + let fn = fatStructName dt metafields in + try H.find fatStructs fn + with Not_found -> begin + let fatci = + mkCompInfo true fn + (fun ci -> + (* Prepend the data field *) + ("__p", dt, None, [], !currentLoc) :: + List.map (fun (fn, ft) -> (fn, ft, None, [], !currentLoc)) + metafields) + [] + in + preAutoDecls := GCompTag(fatci, !currentLoc) :: !preAutoDecls; + let tfat = TComp(fatci, []) in + H.add fatStructs fn tfat; + tfat + end + +(** Test if a type is a fat structure *) +let isFatStructType (t: typ) = + match unrollType t with + TComp(ci, _) when H.mem fatStructs ci.cname -> true + | _ -> false + +(** Get the data and meta fields of a fat compinfo. For each meta field we + * also have the suffix. *) +let getFieldsOfFatComp (ci: compinfo) : fieldinfo * (string * fieldinfo) list = + match ci.cfields with + fdata :: fmetas when fdata.fname = "__p" -> + let metas: (string * fieldinfo) list = + List.map + (fun fm -> + (* We assume that the field name is __e, etc *) + let suff = + if String.length fm.fname > 2 then + String.sub fm.fname 2 (String.length fm.fname - 2) + else + fm.fname + in + (suff, fm)) + fmetas + in + fdata, metas + + | _ -> E.s (bug "The data field is not the first one in %s\n" ci.cname) + +(** Get the data and meta fields of a fat compinfo. *) +let getFieldsOfFat (t: typ) : (fieldinfo * (string * fieldinfo) list) option = + match unrollType t with + TComp(ci, _) when H.mem fatStructs ci.cname -> + Some (getFieldsOfFatComp ci) + + | _ -> None + + +(* Split a fat lval into the data one and the meta lvals, each one with the + * suffix. Return None if not a fat struct lval. *) +let splitFatLval (lv: lval) : (lval * (string * lval) list) option = + let lvt = typeOfLval lv in + let lvbase, lvoff = lv in + match unrollType lvt with + TComp(ci, _) when H.mem fatStructs ci.cname -> begin + let fdata, fmeta = getFieldsOfFatComp ci in + Some ((lvbase, addOffset (Field(fdata, NoOffset)) lvoff), + List.map (fun (suff, fm) -> + (suff, (lvbase, addOffset (Field(fm, NoOffset)) lvoff))) fmeta) + + end + | _ -> None + + +(** Get the data field, if any, from a fat struct lval *) +let getDataFromFatLval (lv: lval) : lval = + match getFieldsOfFat (typeOfLval lv) with + None -> lv + | Some (fdata, _) -> begin + let reslv = addOffsetLval (Field(fdata, NoOffset)) lv in + reslv + end + + +(** Get an lval denoting the whole fat value, from a data value. Return + * the input lval if not a data lval *) +let getFatFromDataLval (lv: lval) : lval = + match removeOffsetLval lv with + lv', Field(fdata, NoOffset) -> begin + try + if H.mem fatStructs fdata.fcomp.cname && + fdata == List.nth fdata.fcomp.cfields 0 then + lv' + else + lv + with _ -> lv + end + + | _ -> lv + + +(** Get an expression denoting the whole fat value, from a data value. Return + * the input expression if not a data expression *) +let getFatFromDataExp (e: exp) : exp = + match e with + Lval lv -> begin + let lv' = getFatFromDataLval lv in + if lv' != lv then + Lval lv' + else + e + end + | _ -> e + + +let makeHiddenVar (fdec: fundec) (name: string) (t: typ) : varinfo = + let vi = makeLocalVar fdec name t in + vi.vattr <- addAttribute hiddenAttr vi.vattr; + vi + +(* This visitor is responsible for converting "__auto" in bounds annotation + * into fresh variables and fat structures that have properly-assigned + * bounds. *) +let autoVisitor = object (self) + inherit nopCilVisitor + + (** Map a variable name to a list of new bound variables added for it, each + * with the suffix "b" or "e" and the variable name. Use find_all to get + * all the bounds. *) + val varBounds : (string, (string * varinfo)) Hashtbl.t = + Hashtbl.create 7 + + (** The current return type of the function, already processed *) + val mutable currentReturnType = intType + + (** Indicates whether we are currently processing trusted code. *) + val mutable trustedCode = false + + val mutable curIndex = 0 + method private makeName (base: string) = + curIndex <- curIndex + 1; + base ^ (string_of_int curIndex) + + (* Get the fancybounds of this expression, for the purposes of + * setting automatic bound variables. *) + method private getPointerBounds (toType: typ) (fromType: typ) (e: exp) = + let lo, hi = + if hasAttribute "fancysize" (typeAttrs fromType) then + fancyBoundsOfSizeType toType fromType e + else + fancyBoundsOfType fromType + in + (* We expand the range of nullterms with deputy_findnull (like strlen) + * when NTEXPAND is used, or when we cast from something with + * fixed bounds to a local/cast with automatic bounds. *) + let doExpandNullterm: bool = + isNulltermExpand toType || + (isNullterm fromType && not (isNullterm toType)) + in + if doExpandNullterm then + let tmp = makeHiddenVar !curFunc (self#makeName "deplength") intType in + let sz = + match unrollType fromType with + | TPtr (bt, _) -> bitsSizeOf bt / 8 + | _ -> E.s (error "Expected pointer type") + in + let instrs = + [Call (Some (var tmp), findnull, [hi; integer sz], !currentLoc)] + in + let hi' = BinOp (PlusPI, hi, Lval (var tmp), typeOf hi) in + instrs, lo, hi' + else + [], lo, hi + + (* Get the upper and lower bounds for an expression e when assigning to + * a variable of type toType. Also two lists of instructions that + * must be inserted into the program before and after using the + * expressions. *) + method private getBounds (instr: instr) (toType: typ) + : instr list * exp * exp * exp * instr list = + DC.startExtraInstrs (); + let e, t, endInstrs = DC.checkInstrRhs instr in + let beginInstrs = DC.endExtraInstrs () in + if isPointerType t then + let instrs', lo, hi = self#getPointerBounds toType t e in + beginInstrs @ instrs', e, lo, hi, endInstrs + else + beginInstrs, e, e, e, endInstrs + + (* Given a type t whose bounds contain the "__auto" keyword, create + * fresh variables with the given base name. The global flag indicates + * whether the new variables should be globals. Returns the new type + * with the fresh variables substituted, along with a list of the new + * variables for each bound (given as strings "b" and "e"). *) + method private makeNewVars (t: typ) (baseName: string) + : typ * (string * string * typ) list = + let addedVars : (string * string * typ) list ref = ref [] in + let bounds = getBoundsAttr t in + let bounds' = + mapBounds + (fun ap suffix -> + match ap with + | ACons (n, []) when n = autoKeyword -> + let name = baseName ^ "__" ^ suffix in + let t' = + typeAddAttributes sentinelAttrs + (typeRemoveAttributes ["bounds"] t) + in + addedVars := (suffix, name, t') :: !addedVars; + ACons (name, []) + | _ -> ap) + bounds + in + setBoundsAttr t bounds', !addedVars + + + (* Given a list of suffix/type pairs, where the suffix "b" or "e" + * indicates the purpose of the type, create a list of expressions that + * can be used to set these variables of this type to the given low and + * high bounds appropriately. *) + method private makeSetExps (addedTypes: (string * typ) list) + (lo: exp) (hi: exp) : exp list = + List.fold_right + (fun (suffix, rhs) acc -> + if List.mem_assoc suffix addedTypes then + (stripNopCasts rhs) :: acc + else + acc) + [("b", lo); ("e", hi)] + [] + + (* Given a list of suffix/lval pairs, where the suffix "b" or "e" + * indicates the purpose of the lval, create a list of instructions that + * set these variables to the given low and high bounds appropriately. *) + method private makeSetInstrs (addedLvals: (string * lval) list) + (lo: exp) (hi: exp) : instr list = + List.fold_right + (fun (suffix, rhs) acc -> + try + let lv = List.assoc suffix addedLvals in + Set (lv, (stripNopCasts rhs), !currentLoc) :: acc + with Not_found -> + acc) + [("b", lo); ("e", hi)] + [] + + + (** Process a type. This is done w.r.t a function that can process new + * names. If the function is not given then we use fat pointers (the + * default case) *) + val mutable typeProcessMeta : + (string (* base name for makeVars *) * + (string * string * typ -> unit) (* function to process a meta, with + * suffix, name, and type. *) + ) option = None + method vtype (t: typ) = + (* Save the processor as we see this type *) + let savedProcessor = typeProcessMeta in + (* Turn off the processor for nested types, always *) + typeProcessMeta <- None; + + match unrollType t with + TPtr(bt, a) as t' -> begin + let bt' = visitCilType (self :> cilVisitor) bt in + if not (hasAutoBounds t') then + if bt' == bt then SkipChildren else ChangeTo (TPtr(bt', a)) + else + match savedProcessor with + None -> + (* We just generate the names for the fields *) + let t'', addedNames = self#makeNewVars (TPtr(bt', a)) "" in + (* make the structure *) + let fat : typ = makeFatStruct t'' + (List.map (fun (_, n, t) -> (n, t)) addedNames) in + ChangeTo fat + + | Some (basename, process) -> + let t'', addedNames = self#makeNewVars t' basename in + (* process them *) + List.iter process addedNames; + ChangeTo t'' + end + + | TArray (bt, leno, a) -> + let bt' = visitCilType (self :> cilVisitor) bt in + let leno' = + match leno with + None -> None + | Some len -> Some (visitCilExpr (self :> cilVisitor) len) + in + if bt == bt' && leno == leno' then + SkipChildren + else + ChangeTo (TArray(bt', leno', a)) + + (* Process the function type. This is only invoked for prototypes and + * pointers to functions. For function definitions we do the same thing + * indirectly by processing the formals *) + | TFun (rt, formals, isva, a) -> begin + (* Do the return type *) + let rt' = visitCilType (self :> cilVisitor) rt in + (* Do the formals in expanded form *) + + let formals' = + match formals with + None -> None + | Some formals -> begin + (* Add the formals in the right order, first the data and then + * the meta fields. *) + let formals' : (string * typ * attributes) list ref = ref [] in + (* Specify after how many to add. Use negative number for end *) + let addFormal (after: int) f = + let rec loop after = function + | rest when after = 0 -> f :: rest + | [] -> [f] + | f1 :: rest -> f1 :: loop (after - 1) rest + in + formals' := loop after !formals' + in + + List.iter + (fun (fName, fType, fAttrs) -> + (* We never leave the formals in fat form *) + let formalMetaProcessor (suff, mname, mtype) = + (* We get here because we have a formal *) + (* We better have a name for this formal *) + if fName = "" then + E.s (error "Formal with auto-bounds must have name"); + (* Always add meta formals at end of list *) + addFormal (-1) (mname, mtype, []); + in + typeProcessMeta <- Some (fName, formalMetaProcessor); + (* Process the type and add the meta formals *) + let placeForDataFormal = List.length !formals' in + let fType' = visitCilType (self :> cilVisitor) fType in + typeProcessMeta <- None; + (* Add the data formal *) + addFormal placeForDataFormal (fName, fType', []); + ) + + formals; + + Some !formals' + end + in + + ChangeTo (TFun(rt', formals', isva, a)) + end + | _ -> DoChildren + + + (* Process expressions. Normally all expressions that would end up as fat, + * are transformed to refer to the data element. This is mostly achieved by + * vlval, but we need some special cases done here. *) + method vexpr e = + let ve e = visitCilExpr (self :> cilVisitor) e in + let vt t = visitCilType (self :> cilVisitor) t in + let vl l = visitCilLval (self :> cilVisitor) l in + + let te e = + let saveTrustedCode = trustedCode in + trustedCode <- true; + let e' = ve e in + trustedCode <- saveTrustedCode; + e' + in + + match e with + | SizeOfE e' -> + (* We process sizeof in fat mode, since we want the size of the + * actual structure, if relevant. We use 'te' in order to turn + * on the trusted flag--this code will not actually be executed! *) + let e2 = getFatFromDataExp (te e') in + if e2 != e' then ChangeTo (SizeOfE e2) else SkipChildren + + | AlignOfE e' -> + (* Same as sizeof. *) + let e2 = getFatFromDataExp (te e') in + if e2 != e' then ChangeTo (AlignOfE e2) else SkipChildren + + | BinOp ((PlusPI | IndexPI | MinusPI) as bop, e1, e2, t) -> + (* We must not do the t, or else vtype will change it. *) + let e1' = ve e1 in + let e2' = ve e2 in + (* Ordinarily, we would SkipChildren unless e1 != e1' or e2 != e2'. + * However, we need to make sure that we set the type properly, + * eliminating __auto, even if the expressions themselves haven't + * changed. See small/auto9. *) + ChangeTo (BinOp (bop, e1', e2', typeOf e1')) + + | BinOp (bop, e1, e2, t) -> + if isPointerType t then + E.s (bug "Unexpected pointer type in non-pointer binop"); + DoChildren + + (* When we take the address of, we take the address of the fat thing *) + | StartOf lv + | AddrOf lv -> + let lv' = vl lv in + let lvFat = getFatFromDataLval lv' in + if lvFat != lv' && trustedCode then + E.s (error ("In trusted code, you may not take the address of " + ^^"%a, which has auto bounds.") dx_lval lv); + if lvFat != lv then + ChangeTo (mkAddrOrStartOf lvFat) + else + SkipChildren + + | CastE (t, e') when trustedCode -> + (* In trusted code, we make no changes to casts. We still need to + * process the expression in case reads of auto globals need + * expansion. *) + ChangeTo (CastE (t, ve e')) + + (* Handle automatic bounds in casts. We create fresh variables and + * assign them based on the expression to be cast. *) + | CastE (t, e') when hasAutoBounds t -> begin + if !curFunc == dummyFunDec then + E.s (error "Casts in global initializers may not have auto bounds"); + let t = (* FIXME: NTEXPAND macro should set the type *) + if isNulltermExpand t then + setTypeAttrs (typeOf e') (nulltermAttr :: typeAttrs t) + else + t + in + (* Do the type. If it has auto bounds, we make new local variables + * for them *) + let boundLocals: (string * lval) list ref = ref [] in + let castTypeProcessor (suff, mname, mtype) = + let lv = makeHiddenVar !curFunc mname mtype in + boundLocals := (suff, var lv) :: !boundLocals + in + typeProcessMeta <- Some ((self#makeName "cbound"), castTypeProcessor); + let t' = vt t in + typeProcessMeta <- None; + let e2 = ve e' in + (* We must create assignments *) + (* make an instruction, to get the bounds *) + let instr = Set ((Mem zero, NoOffset), e2, !currentLoc) in + let begini, e3, lo, hi, endi = self#getBounds instr t' in + if endi <> [] then + E.s (unimp "Post-instructions when processing cast"); + let boundType = + typeAddAttributes sentinelAttrs (typeRemoveAttributes ["bounds"] t') + in + let il = + self#makeSetInstrs !boundLocals + (mkCast lo boundType) (mkCast hi boundType) + in + self#queueInstr (begini @ il); + ChangeTo (CastE (t', e3)) + end + + | _ -> DoChildren (* The rest are known to be non fat already, because + * all fat have been taken care by vlval *) + + (* Get the data field of lvals *) + method vlval (lv: lval) = + ChangeDoChildrenPost (lv, getDataFromFatLval) + + + + method vinst i = + (* We first process the children and then we cleanup, first the calls, + * then the Set instructions *) + + + let processCall (instr: instr) : instr list (* some preamble, already + * processed *) + * instr (* replacement instruction *) + = + match instr with + Call(retlv, func, args, l) -> begin + let rett, formals = + match typeOf func with + | TFun (rett, argInfo, _, _) -> rett, (argsToList argInfo) + | _ -> E.s (bug "Expected function type") + in + (* Deal with the arguments *) + let (beginInstrs: instr list), (args': exp list) = + let rec loopArgs (formals: (string * typ * attributes) list) + (actuals: exp list) : instr list * exp list = + if formals = [] then + (* We ran out of formals, a vararg *) + [], actuals + else if actuals = [] then + (* We ran out of actuals *) + E.s (error "Function call has too few arguments") + else begin + let (fn: string), (ft: typ), restformals = + match formals with + (fn, ft, _) :: restformals -> fn, ft, restformals + | _ -> assert false + in + (** See if we have some meta formals that follow *) + let (metaFormals: (string * typ) list), restformals' = + let rec loopFormals = function + [] -> [], [] + | ((fn1, ft1, _) :: rest) as formals -> + let meta', rest' = loopFormals rest in + (* If fn1 is fn__b or fn__e then it is ours *) + if fn1 = fn ^ "__b" then + (("b", ft1) :: meta'), rest' + else if fn1 = fn ^ "__e" then + (("e", ft1) :: meta'), rest' + else + [], formals + in + loopFormals restformals + in + let arg, restactuals' = + match actuals with + arg :: restactuals -> arg, restactuals + | _ -> assert false + in + + (* Process the rest now *) + let instrs', actuals'' = loopArgs restformals' restactuals' in + + if metaFormals = [] then begin + (* Not an auto formal *) + instrs', arg :: actuals'' + end else if trustedCode then begin + error ("Calling function %a from trusted code. Trusted code" + ^^" is not modified by Deputy, so it may not use" + ^^" functions that have auto bounds.") dx_exp func; + instrs', arg :: actuals'' + end else begin + (* It was an auto formal. Get the bounds *) + (* Dummy instr; the bogus lval will be ignored. *) + let instr = Set ((Mem zero, NoOffset), arg, !currentLoc) in + let beginInstrs, arg', lo, hi, endInstrs = + self#getBounds instr ft + in + if endInstrs <> [] then + E.s (bug "Expected empty endInstrs"); + beginInstrs @ instrs', + arg' :: self#makeSetExps metaFormals lo hi @ actuals'' + end + end + in + loopArgs formals args + in + (* If the return type of the function is fat, then we introduce a + * temporary variable *) + if isFatStructType rett && retlv != None then begin + let tmp = makeHiddenVar !curFunc (self#makeName "ret") rett in + let retlv: lval = + match retlv with Some retlv -> retlv | _ -> assert false + in + beginInstrs @ [Call(Some (var tmp), func, args', l)], + (* Turn the instruction into something that you would get from + * preprocessing a set instruction *) + Set (getDataFromFatLval retlv, + Lval (getDataFromFatLval (var tmp)), l) + end else + beginInstrs, Call (retlv, func, args', l) + end + | _ -> [], instr + in + + (* Helpers for processLhs, below. *) + let makeInstrs ~(isALocal:bool) + (addedLvals: (string * lval) list) + (instr: instr) (lv: lval) : instr list = + assert (not trustedCode); (* Don't modify trusted blocks *) + let lvType = typeOfLval lv in + let beginInstrs, e, lo, hi, endInstrs = self#getBounds instr lvType in + (* We don't need to zero locals; liveness handles this issue for us *) + let zeroInstrs = + if isALocal then [] else [Set (lv, zero, !currentLoc)] in + let setInstrs = self#makeSetInstrs addedLvals lo hi in + let instr' = Set (lv, e, !currentLoc) in + beginInstrs @ zeroInstrs @ setInstrs @ [instr'] @ endInstrs + in + + (* If we're setting a variable with automatic bounds, get the bounds + * from the RHS and assign the automatic bounds variables. *) + let processLhs (instr: instr) : instr list = + (* If lv is a local split variable *) + let getSplitMetas lv: (string * varinfo) list = + match lv with + (Var vi, NoOffset) when not vi.vglob -> + H.find_all varBounds vi.vname + | _ -> [] + in + let lvHasAuto lv: bool = + ((getSplitMetas lv) <> []) + || ((splitFatLval (getFatFromDataLval lv)) <> None) + in + match instr with + | Set (lv, _, _) + | Call (Some lv, _, _, _) -> begin + (* If lv is a local split variable *) + let splitMetas = getSplitMetas lv in + if splitMetas <> [] then begin + if trustedCode then + E.s (error ("Trusted block assigns to \"%a\", which has auto" + ^^" bounds. Trusted blocks are not modified by Deputy," + ^^" so they may not use variables that have auto bounds.") + dx_lval lv); + makeInstrs ~isALocal:true + (List.map (fun (suff, vil) -> (suff, var vil)) splitMetas) + instr + lv + end else begin + (* See if it this is the data of a fat type *) + let lvfat = getFatFromDataLval lv in + match splitFatLval lvfat with + None -> (* Not a fat lval, must be regular lval *) + [instr] + | Some (lvdata, lvmeta) -> + if trustedCode then + E.s (error + ("Trusted code assigns to \"%a\", which has auto " + ^^"bounds. Trusted code is not modified by Deputy, " + ^^"so it may not use lvalues that have auto bounds.") + dx_lval lv); + (* Change the instruction to use lvdata instead *) + let instr' = + match instr with + Set (lv, e, l) -> Set (lvdata, e, l) + | Call (Some lv, func, args, l) -> + Call (Some lvdata, func, args, l) + | _ -> assert false + in + makeInstrs ~isALocal:false lvmeta instr' lvdata + end + end + | Call(None, _, _, _) -> + [instr] + | Asm(_,_,outputs,_,_,_) -> + List.iter + (fun (_,_,lv) -> + if lvHasAuto lv then begin + (* Inline asm modifies something with Deputy-controlled + metadata. This will cause runtime problems.*) + error + "Inline assembly modifies \"%a\", which has auto bounds." + dx_lval lv + end) + outputs; + [instr] + in + + (* Process the LHS and the RHS separately. For the RHS, we need to + * adjust calls whose arguments involve automatic bounds. For the + * LHS, we need to handle cases where the LHS of a call or set has + * automatic bounds. *) + let postProcessInstrs (instrs: instr list) : instr list = + match instrs with + | [] -> [] + | [instr] -> + let beginInstrs, instr' = processCall instr in + beginInstrs @ processLhs instr' + | _ -> E.s (bug "Expected at most one instruction") + in + ChangeDoChildrenPost([i], postProcessInstrs) + + method vstmt (s: stmt) = + match s.skind with + Return (Some rv, l) -> + (* If the return type is fat, then create a new fat local and we copy + * the return value in there before we return *) + if trustedCode then begin + if isFatStructType currentReturnType then + E.s (error "Trusted block contains return of fat type"); + DoChildren + end else if isFatStructType currentReturnType then begin + (* If the type is fat then we make a new local with the fat type *) + let newl = makeHiddenVar !curFunc (self#makeName "ret") + currentReturnType in + let newlv = (Var newl, NoOffset) in + (* make an instruction to assign to the new local *) + let instr = Set (newlv, rv, !currentLoc) in + (* process the instruction *) + let il = visitCilInstr (self :> cilVisitor) instr in + self#queueInstr il; + (* Now we want to return the whole fat thing *) + s.skind <- Return (Some (Lval (getFatFromDataLval newlv)), l); + SkipChildren + end else + DoChildren + + | _ -> DoChildren + + method vblock (b: block) = + let saveTrustedCode = trustedCode in + trustedCode <- saveTrustedCode || isTrustedAttr b.battrs; + let postProcessBlock (b: block) = + trustedCode <- saveTrustedCode; + b + in + ChangeDoChildrenPost (b, postProcessBlock) + + (* Handle locals with automatic bounds. Here we create the new + * variables and update the type of the corresponding local variable. *) + method vfunc fd = + Hashtbl.clear varBounds; + curFunc := fd; + trustedCode <- isTrustedType fd.svar.vtype; + + (* We process the formals first. This will fix the type of the function + * also. *) + let where : string ref = ref "" in (* Where to add the formal *) + List.iter (fun vi -> + let metaForFormal (suff, varName, varType) = + if vi.vaddrof then + E.s (unimp "You cannot take the address of a formal (%s) with auto-bounds. Use a copy\n" vi.vname); + + (* We make the formal, and we put it in all places *) + let vif = makeFormalVar !curFunc ~where:!where varName varType in + H.add varBounds vi.vname (suff, vif); + where := vif.vname + in + typeProcessMeta <- Some (vi.vname, metaForFormal); + where := vi.vname; (* Add the first one right after this one *) + vi.vtype <- visitCilType (self :> cilVisitor) vi.vtype; + typeProcessMeta <- None) + + fd.sformals; + + if not trustedCode then begin + (* Now take care of the locals *) + List.iter + (fun vi -> + (* If we take the address of this one, or involved in return, we + * leave if fat *) + let metaForLocal: (string * (string * string * typ -> unit)) option= + if vi.vaddrof then + None + else + Some (vi.vname, + fun (vSuff, vName, vType) -> + let vil = makeHiddenVar !curFunc vName vType in + H.add varBounds vi.vname (vSuff, vil)) + in + typeProcessMeta <- metaForLocal; + let t' = visitCilType (self :> cilVisitor) vi.vtype in + typeProcessMeta <- None; + vi.vtype <- t') + fd.slocals; + + (* Process the return type *) + (match fd.svar.vtype with + TFun(rt, args, isva, l) -> + typeProcessMeta <- None; + let rt' = visitCilType (self :> cilVisitor) rt in + currentReturnType <- rt'; + fd.svar.vtype <- TFun(rt', args, isva, l) + | _ -> assert false); + end; + + + let cleanup x = + Hashtbl.clear varBounds; + curFunc := dummyFunDec; + trustedCode <- false; + x + in + ChangeDoChildrenPost (fd, cleanup) + + + (** process the initializers *) + method vinit (forg: varinfo) (off: offset) (i: init) = + (* The initializers have already been processed. We must turn SingleInit + * for fat into CompoundInit *) + let postInit (i: init) = + match i with + SingleInit e -> begin + let expected_t = typeOffset forg.vtype off in + match getFieldsOfFat expected_t with + None -> (* Not a fat type *) i + | Some (fdata, fmetas) -> + (* Dummy instr; the bogus lval will be ignored. *) + let instr = Set ((Mem zero, NoOffset), e, !currentLoc) in + let beginInstrs, arg', lo, hi, endInstrs = + self#getBounds instr fdata.ftype + in + if beginInstrs <> [] || endInstrs <> [] then + E.s (unimp "Processing initializer %a (for %s) requires instructions" d_exp e forg.vname); + (* Prepare the fmetas for makeSetExps *) + let addedTypes : (string * typ) list = + List.map (fun (suff, f) -> (suff, f.ftype)) fmetas in + let addedInits: exp list = self#makeSetExps addedTypes lo hi in + (* Now package the list of initializers *) + CompoundInit (expected_t, + (Field(fdata, NoOffset), SingleInit e) :: + (List.map2 + (fun (_, fm) i -> + (Field(fm, NoOffset), SingleInit i)) + fmetas + addedInits)) + end + | CompoundInit _ -> i + in + ChangeDoChildrenPost (i, postInit) + + method vvdec (vi: varinfo) = + (* We preprocess first, to get the new type *) + let postVar (vi: varinfo) : varinfo = + (* see if a type contains or refers to fat pointers *) + let containsAutoType (t: typ) : bool = + existsType + (function + TComp (ci, _) when H.mem fatStructs ci.cname -> ExistsTrue + | _ -> ExistsMaybe) + t + in + if vi.vglob && vi.vstorage <> Static then begin + (* Perhaps the name is already changed *) + let vil = String.length vi.vname in + if vil > 7 && String.sub vi.vname (vil - 8) 8 = "__deputy" then + (* We already have the mangled name *) + () + else if containsAutoType vi.vtype then + vi.vname <- vi.vname ^ "__deputy" + end; + vi + in + ChangeDoChildrenPost(vi, postVar) + + (* Handle functions, globals, and structures with automatic bounds. *) + method vglob g = + preAutoDecls := []; + ChangeDoChildrenPost([g], + (fun x -> (List.rev !preAutoDecls) @ x)) +end + + +(**************************************************************************) + + +let needsAnnot (t: typ) : bool = + isPointerType t && + let attrs = typeAttrs t in + not (hasAttribute "bounds" attrs) && + not (hasAttribute "size" attrs) + +let isCharPtr (t: typ) : bool = + match unrollTypeDeep t with + | TPtr (TInt ((IChar | ISChar | IUChar), _), _) -> true + | _ -> false + +let isCharArray (t: typ) : bool = + match unrollTypeDeep t with + | TArray (TInt ((IChar | ISChar | IUChar), _), _, _) -> true + | _ -> false + +(* This visitor is responsible for inferring bound and nullterm + * annotations when not otherwise provided by the programmer. We use the + * results from CCured's inference for locals, and we guess annotations + * for globals, function parameters, and structure fields. *) +let inferVisitor = object (self) + inherit nopCilVisitor + + (* Keep track of vars that didn't have a programmer-supplied anntoation. *) + val mutable unannotatedVars : varinfo list = [] + + (* Builtins can appear in the code without a preceding declaration, + * so we make sure to check out their types too. *) + method vvrbl v = + v.vtype <- visitCilType self v.vtype; + DoChildren + + (* This is the catchall case. If a type has not otherwise been assigned + * a type (e.g., by CCured inference), then guess. *) + method vtype t = + let postProcessType (t: typ) = + if needsAnnot t then + let newAnnots = + if !assumeString && isCharPtr t then + stringAttrs + else + [safeAttr] + in + typeAddAttributes (missingAnnotAttr :: newAnnots) t + else if isArrayType t then + match unrollType t with + | TArray (_, Some e, a) -> + let n = + match isInteger (constFold true e) with + | Some n -> to_int n + | None -> E.s (bug "Array length could not be determined") + in + let n' = + if isNullterm t then + if n = 0 then begin + error "Cannot have nullterm array with zero length."; + 0 + end else + n - 1 + else + n + in + if not (hasAttribute "bounds" a) || n' > 0 then + typeAddAttributes [countAttr (AInt n')] + (typeRemoveAttributes ["bounds"] t) + else + t + | TArray (_, None, a) -> + if not (hasAttribute "bounds" a) then + typeAddAttributes [count0Attr] t + else + t + | _ -> E.s (bug "Expected array type") + else + t + in + ChangeDoChildrenPost (t, postProcessType) + + (* Infer annotations for types in casts. *) + method vexpr e = + (* Assign string constants to a temporary variable that is exempt from + * Deputy checks. The reason is that two identical string constants + * may not always evaluate to the same address; thus, when adding + * checks on such variables, we need to make sure that we refer to the + * same address in all parts of the check. *) + let fixStr (t: typ) (length: int) : exp = + (* Add a temp with annotation NT COUNT(stringlen) *) + let lengthAttr = countAttr (AInt length) in + let t = typeAddAttributes [lengthAttr; nulltermAttr] t in + let tmp = makeTempVar !curFunc t in + addTempInfoSet tmp e; + DC.exemptLocalVars := tmp :: !DC.exemptLocalVars; + self#queueInstr [Set (var tmp, e, locUnknown)]; + Lval (var tmp) + in + let e' = + match e with + | Const (CStr str) when !curFunc != dummyFunDec -> + (* JC: We use charPtrType instead of (typeOf e) because the + * latter results in lots of warnings relating to const casts. *) + fixStr charPtrType (String.length str) + | Const (CWStr wchars) when !curFunc != dummyFunDec -> + fixStr (TPtr (!wcharType, [])) (List.length wchars) + + (* All trusted types are converted to auto types. This change is + * necessary because the TC macro uses typeof(), which can + * otherwise introduce invalid annotations. *) + | CastE (t, e') when isPointerType t && isTrustedType t && + !curFunc != dummyFunDec -> + let t' = + typeAddAttributes [autoAttr] (typeRemoveAttributes ["bounds"] t) + in + CastE (t', e') + + | CastE (t, e') when isNulltermExpand t && !curFunc != dummyFunDec -> + let bt, a = getPointerType t "the cast" in + let a = dropAttribute "bounds" a in + mkCast e' (TPtr (bt, addAttribute autoEndAttr a)) + | CastE (t, e') when needsAnnot t && !curFunc != dummyFunDec -> + (* Make sure we're not casting from a trusted pointer. *) + if isTrustedType (typeOf e') then + error ("Target of trusted cast must have user-supplied bounds:\n" ^^ + " from: %a\n" ^^ + " to: %a\n" ^^ + " exp: %a") + dt_type (typeOf e') dt_type t dx_exp e'; + (* First adjust the type for void* polymorphism. *) + let bt, a = getPointerType t "the cast" in + let a = dropAttribute "bounds" a in + (* Now see if we need to add an annotation. *) + let kind, _ = N.inferredKindOf a in + let a = + if N.kindIsNullterm kind && not (hasAttribute "nullterm" a) then + addAttribute nulltermAttr a + else + a + in + begin + match kind with + | N.Safe when not (isVoidPtrType (typeOf e')) && + not (isTrustedType t) -> + mkCast e' (TPtr (bt, addAttribute safeAttr a)) + + | N.Sentinel -> + mkCast e' (TPtr (bt, addAttribute count0Attr a)) + | N.String when not (isNulltermExpand t) -> + mkCast e' (TPtr (bt, addAttribute count0Attr a)) + | N.FSeq | N.FSeqN -> + mkCast e' (TPtr (bt, addAttribute autoEndAttr a)) + | _ -> + mkCast e' (TPtr (bt, addAttribute autoAttr a)) + end + | _ -> e + in + ChangeDoChildrenPost (e', (fun e -> e)) + + (* Make sure the left-hand side of a TC is fully annotated. *) + method vinst i = + let check (vi: varinfo) (t: typ) : unit = + if List.memq vi unannotatedVars && isTrustedType t then + error "Target \"%s\" of trusted cast must have user-supplied bounds" + vi.vname + in + begin + match i with + | Set ((Var vi, NoOffset), e, _) -> check vi (typeOf e) + | Call (Some (Var vi, NoOffset), fn, _, _) -> + begin + match typeOf fn with + | TFun (t, _, _, _) -> check vi t + | _ -> E.s (bug "Expected function with non-void return value") + end + | _ -> () + end; + DoChildren + + (* Infer annotations for local variables. *) + method vfunc fd = + assert (unannotatedVars = []); + if isTrustedType fd.svar.vtype then begin + (* Visit the return type and formals. This is mostly just to get SAFE + added in the right places. *) + fd.svar.vtype <- visitCilType self fd.svar.vtype; + + let newformals = mapNoCopy (visitCilVarDecl self) fd.sformals in + (* Make sure the type reflects the formals *) + setFormals fd newformals; + + SkipChildren + end + else begin + curFunc := fd; + List.iter + (fun vi -> + if isPointerType vi.vtype then begin + (* First adjust the type for void* polymorphism. *) + let bt, a = getPointerType vi.vtype vi.vname in + vi.vtype <- TPtr (bt, a); + (* Now see if we need to add an annotation. *) + let kind, _ = N.inferredKindOf a in + if hasAttribute "bounds" a || hasAttribute "size" a then begin + if N.kindIsNullterm kind && + not (hasAttribute "nullterm" a) && + not (hasAttribute "sentinel" a) then begin + warn "Marking variable %s as null-terminated" vi.vname; + vi.vtype <- TPtr (bt, addAttribute nulltermAttr a) + end + end else begin + if not (isTrustedType vi.vtype) then + unannotatedVars <- vi :: unannotatedVars; + let a = + if N.kindIsNullterm kind && not (hasAttribute "nullterm" a) then + addAttribute nulltermAttr a + else + a + in + match kind with + | N.Safe -> (* No bound vars needed. *) + vi.vtype <- TPtr (bt, addAttribute safeAttr a) + | N.String | N.Sentinel -> (* No bound vars needed. *) + vi.vtype <- TPtr (bt, addAttribute count0Attr a) + | N.FSeq | N.FSeqN -> (* Automatic bounds for end only. *) + vi.vtype <- TPtr (bt, addAttribute autoEndAttr a) + | N.Seq | N.SeqN -> (* Automatic bounds for base and end. *) + vi.vtype <- TPtr (bt, addAttribute autoAttr a) + | N.Unknown | N.UnknownN -> + (bug "bad kind returned by inferredKindOf for %a" + dx_type vi.vtype); + () + end + end else if isArrayType vi.vtype then begin + (* For arrays, we infer nullterm if one of two conditions holds: + * 1. It's a char array and we're assuming all such arrays are + * null-terminated, or + * 2. It was inferred nullterm by the inference engine *) + let a = typeAttrs vi.vtype in + if ((!assumeString && isCharArray vi.vtype) || + N.kindIsNullterm (fst (N.inferredKindOf a))) && + not (hasAttribute "nullterm" a) then + vi.vtype <- typeAddAttributes [nulltermAttr] vi.vtype + end) + fd.slocals; + List.iter + (fun vi -> + if isPointerType vi.vtype && + not (hasAttribute "bounds" (typeAttrs vi.vtype)) then begin + match getZeroOneAttr ["arraylen"] (typeAttrs vi.vtype) with + | Some (Attr (_, [a])) -> + vi.vtype <- typeAddAttributes [countAttr a] vi.vtype + | Some _ -> errorwarn "Malformed arraylen attribute." + | None -> () + end) + fd.sformals; + let cleanup fd = + curFunc := dummyFunDec; + unannotatedVars <- []; + fd + in + ChangeDoChildrenPost (fd, cleanup) + end +end + + +(**************************************************************************) + +let strncpy_proto: varinfo option ref = ref None + +(* This visitor does some simple pre-processing prior to inference and + * type checking. *) +let preProcessVisitor = object (self) + inherit nopCilVisitor + + method vglob g = + (* Look for a strncpy prototype *) + (match g with + GVarDecl(vi, _) + | GFun({svar = vi}, _) when vi.vname = "strncpy" -> + strncpy_proto := Some vi + | _ -> () + ); + DoChildren + + method vtype t = + let t' = unrollType t in + let attrs = typeAttrs t' in + if (hasAttribute "bound" attrs || hasAttribute "nullterm" attrs) && + not (isPointerType t') && not (isArrayType t') then + E.s (error "Deputy annotations cannot be placed on this type"); + match t with + | TNamed (ti, a) -> + (* Unroll unannotated typedefs. *) + if hasAttribute "bounds" (typeAttrs ti.ttype) then + DoChildren + else + ChangeTo t' + | _ -> DoChildren + + method vexpr e = + let post e : exp = + match e with + | AddrOf lv -> + (* Change AddrOf of an array to a StartOf, + and optimize &*e to e. *) + mkAddrOrStartOf lv + | _ -> e + in + ChangeDoChildrenPost(e, post) + + (* If the RHS of an instruction refers to a variable that is modified in + * the LHS, introduce a temporary. Later, autoVisitor will assume that + * a variable appearing on the LHS does not also appear on the RHS. + * We also spread the trusted attribute to CIL-introduced temporaries + * on the LHS of a call (see trusted12.c). *) + method vinst i = + let postProcessInstr (instrs: instr list) : instr list = + List.fold_right + (fun instr acc -> + let needsTemp (instr: instr) : bool = + match instr with + | Call _ -> + (* Processing the call will introduce a temporary, so an + * additional one is not needed. *) + false + | Set ((Var vi, NoOffset), e, _) -> + (* We only need a temp if we might have automatic bounds + * and if the RHS refers to the variable. *) + isPointerType vi.vtype && expRefersToVar vi.vname e + | Set (lv, _, _) -> + (* For an LHS other than a variable, automatic bounds + * must already be indicated by the programmer. *) + let t = typeOfLval lv in + hasAttribute "bounds" (typeAttrs t) && hasAutoBounds t + | Asm _ -> + false + in + let needsTrusted (instr: instr) : bool = + match instr with + | Call (Some (Var vi, NoOffset), fn, _, _) -> + let rtype = + match unrollType (typeOf fn) with + | TFun (rtype, _, _, _) -> rtype + | _ -> E.s (bug "Expected function type.") + in + vi.vdescr <> nil && isTrustedType rtype + | _ -> false + in + let getLhs (instr: instr) : lval = + match instr with + | Set (lv, _, _) -> lv + | Call (Some lv, _, _, _) -> lv + | Call (None, _, _, _) -> E.s (bug "Expected return for call") + | Asm _ -> E.s (bug "Unexpected asm instruction") + in + let setLhs (instr: instr) (lv: lval) : instr = + match instr with + | Set (_, e, l) -> Set (lv, e, l) + | Call (Some _, fn, args, l) -> Call (Some lv, fn, args, l) + | Call (None, _, _, _) -> E.s (bug "Expected return for call") + | Asm _ -> E.s (bug "Unexpected asm instruction") + in + let getRhsType (instr: instr) : typ = + match instr with + | Set (_, e, _) -> typeOf e + | Call (_, fn, _, _) -> + begin + match typeOf fn with + | TFun (t, _, _, _) -> t + | _ -> E.s (bug "Expected function type") + end + | Asm _ -> E.s (bug "Unexpected asm instruction") + in + if needsTemp instr then + let lv = getLhs instr in + let t = typeRemoveAttributes + ["bounds"; "nonnull"; "warn_unused_result"] + (typeOfLval lv) in + let t' = + if isTrustedType (getRhsType instr) then + typeAddAttributes [Attr ("trusted", [])] t + else + t + in + let tmp = makeTempVar !curFunc t' in + begin + match instr with + | Set (_, e, _) -> addTempInfoSet tmp e + | Call (_, fn, args, _) -> addTempInfoCall tmp fn args + | Asm _ -> E.s (bug "Unexpected asm instruction") + end; + (setLhs instr (var tmp)) :: + Set (lv, Lval (var tmp), !currentLoc) :: + Set (var tmp, zero, !currentLoc) :: + acc + else begin + if needsTrusted instr then begin + match getLhs instr with + | Var vi, NoOffset -> + vi.vtype <- typeAddAttributes [trustedAttr] vi.vtype + | _ -> E.s (bug "Unexpected LHS.") + end; + instr :: acc + end) + instrs + [] + in + let i' : instr list = + match i with + (* strcpy is not permitted in Deputy programs. + * Here, we transform strcpy(dest, "literal") into + * + * strncpy(dest, "literal", len); + * dest[len] = 0; + * where len = (sizeof("literal")-1) + * TODO: Maybe we should do this for non-literals as well? But + * there's a perf cost to calling strlen. For now, we'll only do it + * for literals. *) + | Call (lvo, Lval (Var vf, NoOffset), [dest; src], loc) + when vf.vname = "strcpy" -> begin + match stripNopCasts src with + Const(CStr s) -> begin + let len = integer(String.length s) in + let last_ptr = BinOp (PlusPI, + mkCast dest charPtrType, + len, + charPtrType) in + let last_lv = (Mem last_ptr), NoOffset in + match !strncpy_proto with + Some strncpy -> + [Call(lvo, Lval(var strncpy), [dest; src; len], loc); + Set(last_lv, zero, loc) + ] + | None -> + warn ("Could not transform strcpy() to strncpy() " ^^ + "because strncpy() declaration was not found."); + [i] + end + | _ -> + (* The source is not a literal. Leave it alone; + this is reported as an error later. *) + [i]; + end + | _ -> [i] + in + match i with + Call(_, f, _, _) when isVarargOperator f -> + (* Don't mess with the arguments to e.g. __builtin_va_arg *) + SkipChildren + | _ -> + ChangeDoChildrenPost (i', postProcessInstr) + + method vfunc fd = + curFunc := fd; + let cleanup fd = + curFunc := dummyFunDec; + fd + in + ChangeDoChildrenPost (fd, cleanup) +end + + +(***************************************************************) + + +(* This visitor makes array type declarations consistent. Empty array + * bounds in extern globals are converted to zeros. Zero array bounds at + * the end of a structure are converted to empty bounds. All other + * appearances of empty array bounds are illegal. + * + * From this point forward, the only empty array bounds should be an + * indication of an open array at the end of a structure. *) +let flexibleArrayVisitor = object (self) + inherit nopCilVisitor + + method vtype t = + match t with + | TArray (_, None, _) -> E.s (error "Illegal use of flexible array") + | _ -> DoChildren + + method vglob g = + match g with + (* Rewrite bounds for structures ending in a zero-length array. *) + | GVarDecl (vi, _) when vi.vstorage = Extern -> + begin + match unrollType vi.vtype with + | TArray (bt, None, a) -> + (* This is always an error; if the array were unused then + * Rmtmps would have deleted it. + * Without this, we get unhelpful errors about + * arrays with length 0 or -1. *) + if not (hasBoundsAttr vi.vtype) + && not (isTrustedType vi.vtype) then + error ("Global array %s needs a length annotation " + ^^"(e.g. COUNT or NTS)") vi.vname; + let e = if isNullterm vi.vtype then one else zero in + vi.vtype <- TArray (bt, Some e, a); + DoChildren + | _ -> DoChildren + end + (* Rewrite bounds for extern globals with emtpy bounds. *) + | GCompTag (ci, _) when List.length ci.cfields > 1 -> + let _, fi = remove_last ci.cfields in + let fixup bt a g = fi.ftype <- TArray (bt, None, a); g in + begin + match unrollType fi.ftype with + | TArray (bt, Some z, a) when isZero z -> + (* Fix the type on the way up so as not to trigger the + * "illegal use" warning above. *) + ChangeDoChildrenPost ([g], fixup bt a) + | TArray (bt, None, a) -> + (* Change the type temporarily so as not to trigger the + * "illegal use" warning above. Fix it on the way up. *) + fi.ftype <- TArray (bt, Some zero, a); + ChangeDoChildrenPost ([g], fixup bt a) + | _ -> DoChildren + end + | _ -> DoChildren +end + + +(***************************************************************) + + +(* This visitor handles the copytype attribute, which says that the + * associated void* should be changed to hold the type of the source + * for this cast expression. This feature is used to implement the + * TC, NTDROP, and NTEXPAND macros. *) +let copyTypeVisitor = object (self) + inherit nopCilVisitor + + method vexpr e = + let postProcessExpr e = + match e with + | CastE (TPtr (TVoid [], a), e') when hasAttribute "copytype" a -> + let bt = + match unrollType (typeOf e') with + | TPtr (bt, _) -> bt + | _ -> TVoid [] + in + CastE (TPtr (bt, dropAttribute "copyType" a), e') + | _ -> e + in + ChangeDoChildrenPost (e, postProcessExpr) +end + + +(***************************************************************) +(* Combine the prepasses *) +(***************************************************************) + + +let preProcessFile (f : file) = + let doPreprocess () = + if !verbose then + log "preprocess file (dinfer)"; + + (* Create a decl for "__deputy_memset". *) + f.globals <- GVarDecl(memset, locUnknown) :: f.globals; + + List.iter + (fun global -> + match global with + | GVar (vi, _, _) + | GVarDecl (vi, _) when not (isFunctionType vi.vtype)-> + if not (List.memq vi !allGlobalVars) then begin + registerGlobal vi + end + | _ -> ()) + f.globals; + if !verbose then + log "preprocess visitor (dinfer)"; + visitCilFileSameGlobals copyTypeVisitor f; + visitCilFileSameGlobals flexibleArrayVisitor f; + visitCilFileSameGlobals preProcessVisitor f; + in + Stats.time "preprocessing" doPreprocess () + +let preProcessFileAfterMarking (f : file) = + let doPreprocess () = + if !verbose then + log "infer visitor (dinfer)"; + visitCilFileSameGlobals inferVisitor f; + + H.clear fatStructs; + if !verbose then + log "auto visitor (dinfer)"; + visitCilFile autoVisitor f; + H.clear fatStructs; + + if !verbose then + log "finished preprocessing (dinfer)"; + in + Stats.time "preprocessing" doPreprocess () + + +(**************************************************************************) +(* Post pass *) +(**************************************************************************) + +let numChecksAdded: int ref = ref 0 +let numChecksAddedVar: varinfo option ref = ref None + +let postPassVisitor = object (self) + inherit nopCilVisitor + + method vinst i = + (match instrToCheck i with + Some _ -> incr numChecksAdded + | None -> ()); + DoChildren + + method vglob g = + match g with + GVarDecl(vi, _) when vi.vname = "DEPUTY_NUM_CHECKS_ADDED" -> + numChecksAddedVar := Some vi; + DoChildren + | GVarDecl(vi, _) when vi == memset -> + (* Filter out the decl of __deputy_memset. This is declared in + checks.h *) + ChangeTo [] + | _ -> DoChildren + + + (* Remove any "bounds" or "fancybounds" annotations. *) + method vattr a = + if isDeputyAttr a then + ChangeTo [] + else + DoChildren + + (* Replace gratuitous blocks and instruction sequences *) + (* matth: only move statements with no labels. If you want to clean up blocks + with labels, you must patch up goto statements. See r9295 and earlier + for the version of this code that moved labels around correctly but + did not patch gotos. *) + method vblock (b: block) : block visitAction = + (* See if there are nested Blocks *) + let postProcessBlock b = + let rec loop (bl: stmt list) : stmt list = + match bl with + | [] -> [] + | {skind=Block b';labels=[]} :: brest when b'.battrs == [] -> begin + (* Move the labels from the statement into the first statement *) + loop (Util.list_append b'.bstmts brest) + end + | {skind=Instr [];labels=[]} :: brest -> + loop brest + + | ({skind=Switch(e,b,sl,loc); labels=[]} as s) :: brest -> begin + let slp = loop b.bstmts in + b.bstmts <- slp; + s.skind <- Switch(e,b,sl,loc); + + (s :: (loop brest)) + end + + | s :: brest -> + let brest' = loop brest in + if brest' == brest then + bl + else + (s :: brest') + in + b.bstmts <- loop b.bstmts; + b + in + ChangeDoChildrenPost (b, postProcessBlock) + +end + + +(**************************************************************************) + + + +let postProcessFile (f : file) = + (* Turn the check datastructure into explicit checks, so that they show up + in the output. *) + if !verbose then + log "postprocess file (dinfer)"; + if !optLevel >= 3 then + S.time "deadcode-elim" DO.deadCodeElim f; + visitCilFile postPassVisitor f; + let numChecksAddedGlobal = match !numChecksAddedVar with + (* Was DEPUTY_NUM_CHECKS_ADDED declared in this file? If so, replace + the declaration with a definition. (If the var is missing, that's + because it was unused and CIL deleted it.) *) + Some vi -> + vi.vstorage <- Static; + GVar(vi, {init = Some (SingleInit(integer !numChecksAdded))}, vi.vdecl) + | None -> GText "" + in + f.globals <- (GText ((if !alwaysStopOnError then "#define" else "#undef") ^ + " DEPUTY_ALWAYS_STOP_ON_ERROR")) :: + (GText ((if !fastChecks then "#define" else "#undef") ^ + " DEPUTY_FAST_CHECKS")) :: + numChecksAddedGlobal :: + (GText "#include \n\n")::f.globals; + (*if not(Check.checkFile [] f) then + E.s(error "Check.checkFile failed!");*) + (* this is done in main.ml: + if !Doptions.stats then S.print stdout "optimizer-stats:" *) + () diff --git a/src/dinfer.mli b/src/dinfer.mli new file mode 100644 index 0000000..af32fca --- /dev/null +++ b/src/dinfer.mli @@ -0,0 +1,42 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 findnull : Cil.exp +val preProcessFile : Cil.file -> unit +val preProcessFileAfterMarking : Cil.file -> unit +val postPassVisitor : Cil.nopCilVisitor +val postProcessFile : Cil.file -> unit diff --git a/src/dlocals.ml b/src/dlocals.ml new file mode 100755 index 0000000..1e488ee --- /dev/null +++ b/src/dlocals.ml @@ -0,0 +1,383 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 Dattrs +open Doptions +open Dutil + +module E = Errormsg +module IH = Inthash +module VS = Usedef.VS +module DF = Dataflow + +(* Liveness analysis for local vars. + * + * This has two uses: + * 1) Any local that's live at the start of the func is used without being initialized. + * This is a warning/error. + * 2) We'll say that variables are only in scope once if they're live. + * This reduces the number of variables in the context, and it fixes issues + * such as small/locals1 that are caused by CIL moving all locals to the same scope. + * + * A variable is live if + * a) it is live in the usual sense, or + * b) a live variable depends on it. + *) + + +(* A map from variables to the list of variables that the first + * variable depends on. This is closed under transitivity, + * but it excludes self-dependencies. *) +let dependsOn: VS.t IH.t = IH.create 40 + +(* Update a variable set "start" based on the variables defined and used + * by the current instruction. Ensures that the result is closed w.r.t. + * the dependsOn relation. *) +let handleDefUse (start: VS.t) (def: VS.t) (use: VS.t): VS.t = + let addDeps (v:varinfo) (acc: VS.t): VS.t = + VS.union (IH.find dependsOn v.vid) acc + in + (* Subtract anything in the Def set. Note that acc is no longer closed! *) + let acc = VS.diff start def in + (* Add anything that was Used. *) + let acc = VS.union use acc in + (* Add anything that the Def set depends on, because we'll need these + * to check the assignment. *) + let acc = VS.fold addDeps def acc in + (* Finally, make sure acc is closed. *) + let acc = VS.fold addDeps acc acc in + acc + + +(* The variables that are live at the start of each stmt of this function. + This is always closed under dependsOn. *) +let liveAtStart: VS.t IH.t = IH.create 50 + +(* This is copied from liveness.ml, with some extra Deputy magic. *) +module LiveFlow = struct + let name = "Liveness" + let debug = ref false + type t = VS.t + + let pretty () vs = + (VS.fold + (fun vi d -> + d ++ text "name: " ++ text vi.vname + ++ text " id: " ++ num vi.vid ++ text " ") + vs nil) ++ line + + let stmtStartData = liveAtStart + + let funcExitData = VS.empty + + 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 log "looking at: %a" d_stmt stmt; + let handle_stm vs = match stmt.skind with + Instr _ -> vs + | s -> let u, d = Usedef.computeUseDefStmtKind s in + handleDefUse vs d u + in + DF.Post handle_stm + + let doInstr i vs = + let transform vs' = + let u,d = Usedef.computeUseDefInstr i in + handleDefUse vs' d u + in + DF.Post transform + + let filterStmt stm1 stm2 = true + +end + +module L = DF.BackwardsDataFlow(LiveFlow) + + +(* What variables does a local depend on? *) +let varDepsOfType (localsList: varinfo list) (t: typ) : VS.t = + let deps = depsOfType t in + if deps = [] then VS.empty + else begin + List.fold_left + (fun acc v -> + if List.mem v.vname deps then VS.add v acc + else acc) + VS.empty + localsList + end + +(* Finds the (transitive) dependencies of a variable, and adds them to acc *) +let getDepsOf (localsList: varinfo list) (v:varinfo): VS.t = + let rec helper (v:varinfo) (acc: VS.t): VS.t = + let deps = varDepsOfType localsList v.vtype in + let newvars = VS.diff deps acc in + (* Add in deps *) + let acc = VS.union acc newvars in + (* And add in any vars that those vars depend on. *) + VS.fold helper newvars acc + in + let deps = helper v VS.empty in + (* Finally, remove any self-dependency. *) + VS.remove v deps + + +let extraUsesOfExpr (localsList: varinfo list) : (exp -> VS.t) = + function + (* If a cast has an annotation that refers to locals, + add those locals to the USE set *) + CastE(t, _) -> varDepsOfType localsList t + | _ -> VS.empty + + +(* Check for "memset(&v,_,sizeof(v))". + This is a definition of v, not a use. *) +let interceptMemset (func:exp) (args: exp list): VS.t * VS.t * exp list = + (* the default response: process the args as normal. *) + let default = (VS.empty, VS.empty, args) in + if isMemset (typeOf func) then begin + match args with + | [(AddrOf lv1 | StartOf lv1); e2; e3] + when (isCorrectSizeOf e3 lv1) -> begin + (* We're memsetting the entire lval. Consider this a def. *) + match lv1 with + Var vi, NoOffset when not vi.vglob -> + VS.empty, (* no extra uses *) + VS.singleton vi, (* consider vi to be defined *) + [e2;e3] (* process the last two args as usual *) + | _ -> + default + end + | _ -> default + end + else + default + +(**** Set some hooks for Usedef: ****) + +let setHooks (f:fundec) : unit = + (* Exclude globals: *) + let notGlobal (v:varinfo): bool = not v.vglob in + Usedef.considerVariableUse := notGlobal; + Usedef.considerVariableDef := notGlobal; + Usedef.considerVariableAddrOfAsUse := notGlobal; + + Usedef.onlyNoOffsetsAreDefs := true; + + Usedef.extraUsesOfExpr := extraUsesOfExpr (f.sformals @ f.slocals); + Usedef.getUseDefFunctionRef := interceptMemset; + () + +let unsetHooks () : unit = + Usedef.considerVariableUse := (fun v -> true); + Usedef.considerVariableDef := (fun v -> true); + Usedef.considerVariableAddrOfAsUse := (fun v -> true); + Usedef.onlyNoOffsetsAreDefs := false; + Usedef.extraUsesOfExpr := (fun e -> VS.empty); + Usedef.getUseDefFunctionRef := (fun f args -> (VS.empty, VS.empty, args)); + () + + + +(***************************************************************) + + +(* Initialize locals to 0, if needed. Some of this initialization may be + wrong (e.g. initializing NONNULL values), but we should catch that later + during type checking.*) +let rec initLval (lv: lval) (t: typ) (acc: instr list) : instr list = + let t = unrollType t in + match t with + TInt _ | TEnum _ | TFloat _ | TVoid _ -> acc + | TBuiltin_va_list _ -> + if !Doptions.warnVararg then + warn "Vararg variables not handled."; + acc + | TPtr _ -> Set(lv, zero, !currentLoc) :: acc + | TArray (bt, _, a) when typeContainsPtrOrNullterm bt -> + (* for arrays whose elements contain pointers or nullterminated + * arrays, we just memset the whole thing *) + Call(None, Lval (var memset), + [mkAddrOrStartOf lv; zero; SizeOf t], + !currentLoc)::acc + | TArray(_, sz, a) when hasAttribute "nullterm" a -> + (* For arrays whose elements have no pointers, but that are + * nullterminated, we just write the last element *) + let szn = + match sz with + Some sz -> sz + | _ -> E.s (unimp "Cannot initialize local null-terminated array with no size") + in + Set(addOffsetLval (Index(increm szn (-1), NoOffset)) lv, + zero, !currentLoc) :: acc + + | TArray _ -> acc + + | TComp (comp, _) when not (typeContainsPtrOrNullterm t) -> acc + + (* For performance it would be better to go over structs field by + field, but these assignments might be in the wrong order w.r.t + dependencies. We should either move this until after dcheck, or + replace the memset with individual assignments during + optimization. *) +(* | TComp(comp, _) when comp.cstruct -> *) +(* List.fold_left *) +(* (fun acc f -> *) +(* initLval (addOffsetLval (Field(f, NoOffset)) lv) *) +(* f.ftype *) +(* acc) *) +(* acc *) +(* comp.cfields *) + + | TComp (comp, _) -> + (* Zero it all *) + Call(None, Lval (var memset), + [mkAddrOf lv; zero; SizeOf t], + !currentLoc)::acc + + | TNamed _ -> assert false + | TFun _ -> assert false + + +let initOneVar (funcLoc: location) (vi: varinfo) (acc: instr list): instr list + = + currentLoc := if vi.vdecl == locUnknown then funcLoc else vi.vdecl; + + (* First, report warnings or errors for this var. Then call initLval *) + if vi.vaddrof then + (* It's common to take the address of an uninitialized variable + and pass it somewhere to be initialized. Don't warn about this, + just fix it. *) + () + else begin + match unrollType vi.vtype with + | TInt _ | TEnum _ | TFloat _ -> + (* a scalar is used without being defined. Give a warning. *) + warn "Variable %s may be used without being defined." vi.vname + | TPtr _ -> + (* a pointer is used without being defined. *) + (* Should we add a command-line flag that makes this a warning? *) + error "Pointer variable %s may be used without being defined." vi.vname + | TBuiltin_va_list _ -> () (* we warn about this in initLval *) + | TComp (comp, _) when not comp.cstruct -> + warn ("Union \"%s\" may be used without being defined. Therefore, we " + ^^"also treat its tags as being used before definition.") + vi.vname + + | TArray _ | TComp _ -> + (* Don't warn, because we're not good at deciding when + compound structures have been initialized. *) + () + | TNamed _ | TFun _ | TVoid _ -> + E.s (bug "bad type for local %s: %a" vi.vname dx_type vi.vtype) + end; + initLval (var vi) vi.vtype acc + +let initVars (func: fundec) : unit = + let savedLoc = !currentLoc in + let firstStmt: stmt = + match func.sbody.bstmts with + s::rest -> s + | [] -> E.s (bug "function has no body") + in + (* Are any vars live on input? These need initialization, + unless they're formals. *) + let vars = IH.find liveAtStart firstStmt.sid in + if !verbose then + log "%s: Live on input: %a\n" func.svar.vname + (docList (fun vi -> text vi.vname)) (VS.elements vars); + let locals = VS.filter + (fun vi -> not (List.memq vi func.sformals)) + vars in + let init: instr list = + VS.fold (initOneVar savedLoc) locals [] + in + currentLoc := savedLoc; + (* Now add init to the function body. *) + match firstStmt.skind with + (* The first statement should be an instr statement. + Modify the first statement in place, so that we don't have to + recompute the CFG. *) + Instr il -> + let il' = Util.list_append init il in + firstStmt.skind <- Instr il' + | _ -> + E.s (bug "The first statement of %s should have been an Instr." + func.svar.vname) + + +(*** This interface is exported to Dcheck: ******************) + +let doLiveness (f:fundec) : unit = + assert ((IH.length liveAtStart) = 0); + assert ((IH.length dependsOn) = 0); + let savedLoc = !currentLoc in + setHooks f; + let localsList = f.sformals @ f.slocals in + List.iter (fun v -> IH.add dependsOn v.vid (getDepsOf localsList v)) + localsList; + + let all_stmts, _ = DF.find_stmts f in + List.iter (fun s -> + IH.add liveAtStart s.sid VS.empty) all_stmts; + L.compute all_stmts; + currentLoc := savedLoc; + + unsetHooks (); + + initVars f; + () + + +let clearLiveness () : unit = + IH.clear liveAtStart; + IH.clear dependsOn; + () + +let liveAtStmtStart (s:stmt): VS.t = + IH.find liveAtStart s.sid + +(* What variables does this local depend on? *) +let localDependsOn (v:varinfo): VS.t = + IH.find dependsOn v.vid diff --git a/src/dlocals.mli b/src/dlocals.mli new file mode 100644 index 0000000..fa44afa --- /dev/null +++ b/src/dlocals.mli @@ -0,0 +1,41 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 doLiveness : Cil.fundec -> unit +val clearLiveness : unit -> unit +val liveAtStmtStart : Cil.stmt -> Usedef.VS.t +val localDependsOn : Cil.varinfo -> Usedef.VS.t diff --git a/src/doptions.ml b/src/doptions.ml new file mode 100755 index 0000000..b3be3f4 --- /dev/null +++ b/src/doptions.ml @@ -0,0 +1,228 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 C = Cil +module RD = Reachingdefs +module AE = Availexps +module Z = Zrapp + +let outFile : string ref = ref "" +let debug : bool ref = ref false +let verbose : bool ref = ref false +let trustAll : bool ref = ref false +let stats: bool ref = ref false +let optLevel : int ref = ref 3 +let parseFile : string ref = ref "" +let inferFile : string ref = ref "" +let assumeString : bool ref = ref false +let alwaysStopOnError : bool ref = ref false +let fastChecks : bool ref = ref false +let multipleErrors : bool ref = ref false +let inferKinds: bool ref = ref true +let saturnLogicPath : string ref = ref "" +let findNonNull: bool ref = ref false +let findPreconditions : bool ref = ref false +let propPreconditions : bool ref = ref false +let htmlOutDir : string ref = ref "" +let instrument : bool ref = ref false +let taintflow : bool ref = ref false +let doPtrAnalysis : bool ref = ref false +let warnAsm: bool ref = ref false +let warnVararg: bool ref = ref false +let strictGlobInit: bool ref = ref false +let countTrustedLines: bool ref = ref false +let inferBlocking = ref "" +let patches = ref [] +let checkCilInvariants = ref false + +(** How much detail to print. -1 means do not print the graph *) +let emitGraphDetailLevel : int ref = ref (-1) + + +let rec options = [ + (* General *) + "", Arg.Unit (fun () -> ()), "General:"; + "--out", Arg.Set_string outFile, + "Output file"; + "--warnall", Arg.Unit (fun _ -> Errormsg.warnFlag := true), + "Show all warnings"; + "--verbose", Arg.Set verbose, + "Enable verbose output for Deputy"; + "--stats", Arg.Set stats, + "Output optimizer execution time stats"; + "--help", Arg.Unit (fun () -> Arg.usage (align options) ""; exit 0), + "Show this help message"; + "-help", Arg.Unit (fun () -> Arg.usage (align options) ""; exit 0), + "Show this help message"; + + (* Preprocessing and inference *) + "", Arg.Unit (fun () -> ()), "Preprocessing and inference:"; + "--patch", Arg.String (fun s -> patches := s :: !patches), + "Specify a patch file containing extra annotations"; + "--parse-out", Arg.Set_string parseFile, + "File in which to place Deputy parsing results, before preprocessing"; + "--no-infer", Arg.Clear inferKinds, + ("Don't use CCured-style interprocedural analysis to determine kinds " ^ + "for unannotated pointers."); + "--infer-out", Arg.Set_string inferFile, + ("File in which to place the results of Deputy's preprocessing, " ^ + "including inference results."); + "--infer-out-detail", Arg.Set_int emitGraphDetailLevel, + ("Dump the inference graph with the specified level " ^ + "of detail, with n=0 being the most terse and n=3 the most " ^ + "verbose. Has no effect unless --infer-out " ^ + "and the interprocedural inference are both used."); + "--find-nonnull", Arg.Set findNonNull, + ("Find parameters to functions that should be annotated as NONNULL"); + "--find-preconditions", Arg.Set findPreconditions, + ("Find function preconditions, and add them to the patch file"); + "--prop-preconditions", Arg.Set propPreconditions, + ("Make use of Precondition attributes"); + "--html-out-dir", Arg.String (fun s -> htmlOutDir := s), + ("Directory in which to put html files"); + "--do-ptr-analysis", Arg.Set doPtrAnalysis, + ("Use the results of a pointer analysis during optimization"); + "--saturn-logic-path", Arg.String (fun s -> saturnLogicPath := s), + ("Specify where to look for the results of Saturn analysis"); + + (* Typechecking *) + "", Arg.Unit (fun () -> ()), "Typechecking:"; + "--multiple-errors", Arg.Set multipleErrors, + "Attempt to continue processing on error"; + "--trust", Arg.Set trustAll, + "Trust all bad casts by default"; + "--assume-string", Arg.Set assumeString, + ("Assume all char arrays, and all unannotated char*s in function " ^ + "types, are NT."); + "--warn-asm", Arg.Set warnAsm, + "Show warnings when assembly is ignored"; + "--warn-vararg", Arg.Set warnVararg, + "Show warnings when vararg operators are ignored"; + (* FIXME: make this the default *) + "--strict-global-init", Arg.Set strictGlobInit, + ("Report an error, instead of a warning, if global initializer code " ^ + "can't be proved statically safe."); + "--count-trusted-lines", Arg.Set countTrustedLines, + "Report how many source lines contain an operation that is TRUSTED."; + + (* Code gen and optimizations *) + "", Arg.Unit (fun () -> ()), "Codegen:"; + "--opt", Arg.Set_int optLevel, + ("Control deputy optimizations:\n" ^ + " 0: no optimization\n" ^ + " 1: flow-insensitive optimization\n" ^ + " 2: some flow-sensitive optimization\n"^ + " 3: all optimizations (default)\n"^ + " 4: use Mine's octagon analysis"); + "--fail-stop", Arg.Set alwaysStopOnError, + "Optimize checks assuming that we stop on error"; + "--fast-checks", Arg.Set fastChecks, + ("Optimize checks assuming that we stop on error without printing " ^ + "specifics about the failure"); + "--zrapp", + Arg.Unit (fun n -> C.lineDirectiveStyle := None; + C.printerForMaincil := Z.zraCilPrinter; + Z.doElimTemps := true), + "Use Zach Anderson's pretty printer"; + "--instrument", Arg.Set instrument, + ("Add instrumentation suitable for runtime analysis"); + "--taintflow", Arg.Set taintflow, + ("Perform a static taint analysis"); + + (* Analyses not related to the Deputy type system *) + "", Arg.Unit (fun () -> ()), "Additional analyses:"; + "--blocking-analysis", Arg.Set_string inferBlocking, + ("Infer the BLOCKING attribute on functions, and put the results in the"^ + " specified file."); + + (* Things end users usually won't need *) + "", Arg.Unit (fun () -> ()), "Advanced (for debugging Deputy):"; + "--debug-optim", Arg.Unit (fun n -> Z.debug := true; RD.debug := true; + AE.debug := true; debug := true), + "Have the optimizer output lots of debugging info"; + "--internal-line-nums", + Arg.Unit (fun _ -> Cil.lineDirectiveStyle := Some Cil.LineComment; + Cprint.printLnComment := true), + "Do not map line numbers back to the original source file"; + "--check-cil-invariants", Arg.Set checkCilInvariants, + "Ensure Deputy generates well-formed CIL code."; +] + +and align (options: (string * Arg.spec * string) list) = + (* Get the width of the left column, which contains argument names. *) + let left = + try + List.hd (List.sort (fun a b -> - (compare a b)) + (List.map (fun (arg, _, _) -> String.length arg) options)) + with Not_found -> + 0 + in + (* Add extra for left and right margin. *) + let left = left + 4 in + (* Now get the width of the description column. *) + let width = 78 - left in + (* Helper function to wrap strings. *) + let rec wrap str = + if String.length str <= width then + str + else + (* Find the point to break the string--first newline or last space. *) + let break, skip = + try + let break = String.rindex_from str width ' ' in + try + String.index (String.sub str 0 break) '\n', 1 + with Not_found -> + break, 1 + with Not_found -> + width, 0 + in + (* Split the string and keep wrapping. *) + let lstr, rstr = + String.sub str 0 break, + String.sub str (break + skip) (String.length str - break - skip) + in + lstr ^ "\n" ^ String.make left ' ' ^ wrap rstr + in + (* Now update all the descriptions. *) + List.map + (fun (arg, action, str) -> + if arg = "" then + arg, action, "\n" ^ str ^ "\n" + else + let pre = String.make (left - String.length arg - 3) ' ' in + arg, action, pre ^ wrap str) + options diff --git a/src/doptions.mli b/src/doptions.mli new file mode 100644 index 0000000..3b34ba7 --- /dev/null +++ b/src/doptions.mli @@ -0,0 +1,69 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 outFile : string ref +val debug : bool ref +val verbose : bool ref +val trustAll : bool ref +val stats : bool ref +val optLevel : int ref +val parseFile : string ref +val inferFile : string ref +val assumeString : bool ref +val alwaysStopOnError : bool ref +val fastChecks : bool ref +val multipleErrors : bool ref +val inferKinds : bool ref +val saturnLogicPath : string ref +val findNonNull : bool ref +val findPreconditions : bool ref +val propPreconditions : bool ref +val htmlOutDir : string ref +val instrument : bool ref +val taintflow : bool ref +val doPtrAnalysis : bool ref +val warnAsm : bool ref +val warnVararg : bool ref +val strictGlobInit : bool ref +val countTrustedLines: bool ref +val emitGraphDetailLevel : int ref +val inferBlocking : string ref +val patches : string list ref +val checkCilInvariants : bool ref + +val options : (string * Arg.spec * string) list +val align : (string * Arg.spec * string) list -> (string * Arg.spec * string) list diff --git a/src/dpatch.ml b/src/dpatch.ml new file mode 100644 index 0000000..76ad88b --- /dev/null +++ b/src/dpatch.ml @@ -0,0 +1,300 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * George C. Necula + * 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 Dattrs +open Dutil + +module E = Errormsg +module F = Frontc +module H = Hashtbl + +exception PatchFailed + +(* Determine whether a struct/union is an anonymous one named by CIL. *) +let isAnonStruct (ci: compinfo) : bool = + try + String.sub ci.cname 0 6 = "__anon" + with Invalid_argument _ -> + false + +(* Apply the specified mapping to translate names in a list of attribute + * parameters. This is used to adjust types in function parameters so + * that they refer to the correct function parameter names. *) +let patchAttrParamsVisitor (map: (string, string) H.t) = object (self) + inherit nopCilVisitor + + method vattrparam ap = + try + begin + match ap with + | ACons (name, []) -> ChangeTo (ACons (H.find map name, [])) + | _ -> DoChildren + end + with Not_found -> + DoChildren +end + +(* Apply the above visitor to attributes. *) +let patchAttrParamsInAttrs (map: (string, string) H.t) + (attrs: attributes) : attributes = + visitCilAttributes (patchAttrParamsVisitor map) attrs + +(* Apply the above visitor to a type. *) +let patchAttrParamsInType (map: (string, string) H.t) (t: typ) : typ = + visitCilType (patchAttrParamsVisitor map) t + +(* Add the relevant attributes from extra to orig to make a patched + * attribute list. *) +let patchAttrs (orig: attributes) (extra: attributes) : attributes = + let filter a = + isDeputyAttr a && + match a with + | Attr (name, _) -> not (hasAttribute name orig) + in + addAttributes (List.filter filter extra) orig + +(* Given a type orig and a type extra, take the Deputy attributes from + * extra and merge them into orig. *) +let rec patchType (orig: typ) (extra: typ) (name : string) : typ = + match orig, extra with + | TPtr (origBase, origAttrs), TPtr (extraBase, extraAttrs) -> + let origBase' = patchType origBase extraBase name in + TPtr (origBase', patchAttrs origAttrs extraAttrs) + | TArray (origBase, len, origAttrs), TArray (extraBase, _, extraAttrs) -> + let origBase' = patchType origBase extraBase name in + TArray (origBase', len, patchAttrs origAttrs extraAttrs) + | TFun (_, _, _, origAttrs), TFun _ + when hasAttribute "missingproto" origAttrs -> + orig + | TFun (origRet, origArgInfo, origVar, origAttrs), + TFun (extraRet, extraArgInfo, extraVar, extraAttrs) + when origVar = extraVar && + (* The patch must either omit the args, or have the correct + number of args *) + (extraArgInfo=None || + (List.length (argsToList origArgInfo) = + List.length (argsToList extraArgInfo))) -> + let map = H.create 5 in + let origArgInfo' = + match origArgInfo, extraArgInfo with + | None, _ -> None + | Some origArgs, None -> + (* The patch had no arguments, so leave the args alone *) + origArgInfo + | Some origArgs, Some extraArgs -> + let origArgNames = List.map (fun (name, _, _) -> name) origArgs in + let rec uniquify name = + if not (List.mem name origArgNames) then + name + else + uniquify (name ^ "_") + in + let renamedArgs = + List.map2 + (fun (origName, origArg, origAttrs) (extraName, _, _) -> + if extraName <> "" then begin + let origName' = + if origName <> "" then + origName + else + uniquify extraName + in + H.replace map extraName origName'; + (origName', origArg, origAttrs) + end else + (origName, origArg, origAttrs)) + origArgs extraArgs + in + let patchedArgs = + List.map2 + (fun (origName, origArg, origAttrs) (_, extraArg, _) -> + let extraArg' = patchAttrParamsInType map extraArg in + (origName, patchType origArg extraArg' name, origAttrs)) + renamedArgs extraArgs + in + Some patchedArgs + in + let extraRet' = patchAttrParamsInType map extraRet in + let origRet' = patchType origRet extraRet' name in + let extraAttrs' = patchAttrParamsInAttrs map extraAttrs in + TFun (origRet', origArgInfo', origVar, + patchAttrs origAttrs extraAttrs') + | TNamed (origDef, _), TNamed (extraDef, _) -> + if origDef.tname = extraDef.tname || isVoidType (unrollType extra) then + orig + else begin + ignore(E.log ("Mismatched typedefs in patch:\n" ^^ + " original: %s\n" ^^ + " patch: %s\n") origDef.tname extraDef.tname); + raise PatchFailed + end + | TNamed (origDef, al), _ -> + patchType (typeAddAttributes al origDef.ttype) extra name + | _, TNamed (extraDef, al) -> + patchType orig (typeAddAttributes al extraDef.ttype) name + | TComp (origComp, _), TComp (extraComp, _) + when isAnonStruct origComp && isAnonStruct extraComp -> begin + patchComp origComp extraComp; + orig + end + | TComp (origComp, _), TComp (extraComp, _) + when origComp.cname = extraComp.cname -> + orig + | TEnum (origEnum, _), TEnum (extraEnum, _) + when origEnum.ename = extraEnum.ename -> + orig + | TFloat _, TFloat _ + | TInt _, TInt _ + | TBuiltin_va_list _, TBuiltin_va_list _ + | _, TVoid _ -> orig + | _, _ -> begin + ignore(E.log ("Mismatched types in patch for %s:\n" ^^ + " original: %a\n" ^^ + " patch: %a\n") name dx_type orig dx_type extra); + raise PatchFailed + end + +(* Given an original compinfo and an extra (patch) compinfo, mege the + * annotations from the extra fields into the corresponding original + * fields. *) +and patchComp (origComp: compinfo) (extraComp: compinfo) : unit = + let patchCompField extraField = + try + List.iter + (fun origField -> + if origField.fname = extraField.fname then + origField.ftype <- patchType origField.ftype + extraField.ftype + origComp.cname) + origComp.cfields + with Not_found -> + () + in + List.iter patchCompField extraComp.cfields + +(* For a given global in the patch file (extraGlob), find the + * corresponding global in the original file (if any) and patch its + * attributes. *) +let patchGlobal (origFile: file) (extraGlob: global) : unit = + currentLoc := get_globalLoc extraGlob; + try + List.iter + (fun g -> + match g, extraGlob with + | GFun (fd, _), GVarDecl (vi2, _) + when fd.svar.vname = vi2.vname -> begin + try + fd.svar.vattr <- patchAttrs fd.svar.vattr vi2.vattr; + let newt = patchType fd.svar.vtype vi2.vtype vi2.vname in + (*ignore(E.log "merging %s: %a + %a = %a\n" fd.svar.vname + dx_type fd.svar.vtype dx_type vi2.vtype dx_type newt);*) + setFunctionType fd newt + with PatchFailed -> () + end + | (GVar (vi1, _, _) | GVarDecl (vi1, _)), GVarDecl (vi2, _) + when vi1.vname = vi2.vname -> begin + try + vi1.vattr <- patchAttrs vi1.vattr vi2.vattr; + let newt = patchType vi1.vtype vi2.vtype vi1.vname in + (*ignore(E.log "merging %s: %a + %a = %a\n" vi1.vname + dx_type vi1.vtype dx_type vi2.vtype dx_type newt);*) + vi1.vtype <- newt + with PatchFailed -> () + end + | GCompTag (ci1, _), GCompTag (ci2, _) + when ci1.cname = ci2.cname && not (isAnonStruct ci1) -> begin + try + patchComp ci1 ci2 + with PatchFailed -> () + end + | GType (ti1, _), GType (ti2, _) + when ti1.tname = ti2.tname -> begin + try + ti1.ttype <- patchType ti1.ttype ti2.ttype ti1.tname; + with PatchFailed -> () + end + | _ -> ()) + origFile.globals + with Not_found -> + () + +(* We may have added annotations to the base type of a pointer during + * patching. If this pointer was used to create the type of a temporary, + * we'll get a type mismatch during type checking. Here, we patch any + * temporaries introduced by CIL in order to avoid this problem. We + * detect temporaries by looking at the vdescr field of varinfo, which + * is a bit of a hack. *) +let patchTempsVisitor = object (self) + inherit nopCilVisitor + + method vinst i = + let patchBase orig extra name = + match orig, extra with + | TPtr (origBase, origAttrs), TPtr (extraBase, _) -> begin + try + TPtr (patchType origBase extraBase name, origAttrs) + with PatchFailed -> orig + end + | _ -> orig + in + begin + match i with + | Set ((Var vi, NoOffset), e, _) when vi.vdescr <> Pretty.nil -> + vi.vtype <- patchBase vi.vtype (typeOf e) vi.vname + | Call (Some (Var vi, NoOffset), fn, _, _) when vi.vdescr <> Pretty.nil -> + let rtype = + match unrollType (typeOf fn) with + | TFun (rtype, _, _, _) -> rtype + | _ -> E.s (E.bug "Expected function type %a" d_exp fn) + in + vi.vtype <- patchBase vi.vtype rtype vi.vname + | _ -> () + end; + DoChildren +end + +(* Apply the named patch to the source. *) +let applyPatch (origFile: file) (extraName: string) : unit = + Cabs2cil.cacheGlobals := false; + let extra = + try + F.parse extraName () + with Frontc.ParseError _ -> + E.s (E.error "Error parsing patch file %s\n" extraName) + in + List.iter (patchGlobal origFile) extra.globals; + visitCilFileSameGlobals patchTempsVisitor origFile diff --git a/src/dpatch.mli b/src/dpatch.mli new file mode 100644 index 0000000..9f1a8fc --- /dev/null +++ b/src/dpatch.mli @@ -0,0 +1,41 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * George C. Necula + * 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 patchAttrParamsInAttrs : (string, string) Hashtbl.t -> + Cil.attributes -> Cil.attributes +val patchAttrParamsInType : (string, string) Hashtbl.t -> Cil.typ -> Cil.typ +val applyPatch : Cil.file -> string -> unit +val patchType : Cil.typ -> Cil.typ -> string -> Cil.typ diff --git a/src/dpoly.ml b/src/dpoly.ml new file mode 100644 index 0000000..fdf4e6b --- /dev/null +++ b/src/dpoly.ml @@ -0,0 +1,167 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * George C. Necula + * 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 Expcompare + +open Dattrs +open Dutil + +module E = Errormsg +module H = Hashtbl + +exception PolyError + +type map = (string, typ) H.t + +let polyTypes: (string, typ list) H.t = H.create 5 +let polyMap: map = H.create 5 + +let polyStart () : unit = + if H.length polyMap > 0 || H.length polyTypes > 0 then + E.s (bug "Polymorphism info was not cleared appropriately.") + +let polyClear () : unit = + H.clear polyMap; + H.clear polyTypes + +let getPoly (t: typ) : string = + match filterAttributes "tyvar" (typeAttrs t) with + | [Attr ("tyvar", [ACons (tv, [])])] -> tv + | [] -> raise Not_found + | _ -> E.s (error "Too many type variable attributes.") + +let isPoly (t: typ) : bool = + hasAttribute "tyvar" (typeAttrs t) + +let rec polyMakeSubst (tTo: typ) (tFrom: typ) : unit = + let addSubst tyvar t = + let oldList = + try + H.find polyTypes tyvar + with Not_found -> + [] + in + H.replace polyTypes tyvar (t :: oldList) + in + match unrollType tTo, unrollType tFrom with + | _ when isPoly tTo -> + addSubst (getPoly tTo) tFrom + | TPtr (bt1, _), TPtr (bt2, _) + | TArray (bt1, _, _), TArray (bt2, _, _) -> + polyMakeSubst bt1 bt2 + | TComp (_, attrs1), TComp (_, attrs2) -> + if hasAttribute "typaram" attrs1 <> hasAttribute "typaram" attrs2 then + error ("Type parameter mismatch in coercion:\n" ^^ + " from: %a\n" ^^ + " to: %a") dx_type tFrom dx_type tTo + else begin + match filterAttributes "typaram" attrs1, + filterAttributes "typaram" attrs2 with + | [Attr (_, [ASizeOf t1])], [Attr (_, [ASizeOf t2])] -> + if isPoly t1 then + addSubst (getPoly t1) t2 + | [Attr (_, _)], [Attr (_, _)] -> + error "Malformed type parameter attribute." + | _ :: _, _ | _, _ :: _ -> + error "Too many type parameter attributes." + | [], [] -> + () (* Okay--no type parameters on either. *) + end + | _ -> () + +let polyResolve () : unit = + H.iter + (fun tyvar types -> + let fancy, basic = + List.partition + (fun t -> hasAttribute "fancybounds" (typeAttrs t)) + types + in + let canonical = + match basic with + | t :: rest -> t + | [] -> E.s (error "No non-fancy substitution discovered.") + in + List.iter + (fun t -> + if not (compareTypes canonical t) then + E.s (error "Cannot unify types %a and %a." + dx_type canonical dx_type t)) + basic; + let canonical' = typeRemoveAttributes ["bounds"] canonical in + List.iter + (fun t -> + let t' = typeRemoveAttributes ["fancybounds"] t in + if not (compareTypes canonical' t') then + E.s (error "Cannot unify types %a and %a." + dx_type canonical' dx_type t')) + fancy; + H.replace polyMap tyvar canonical) + polyTypes + +let polyCompMap (t: typ) : map = + let attrs = + match unrollType t with + | TComp (_, a) -> a + | _ -> E.s (error "Bad field offset on type %a" dx_type t) + in + let map = H.create 5 in + begin + match filterAttributes "typaram" attrs with + | [] -> () + | [Attr ("typaram", [ASizeOf t])] -> H.replace map "t" t + | [_] -> E.s (error "Invalid type parameter on structure.") + | _ -> E.s (error "Too many type parameters on structure.") + end; + map + +let polySubstVisitor (map: map) = object (self) + inherit nopCilVisitor + + method vtype t = + if isPoly t then + let tyvar = getPoly t in + try + ChangeTo (H.find map tyvar) + with Not_found -> + raise PolyError + else + DoChildren +end + +let polySubst (map: map) (t: typ) : typ = + visitCilType (polySubstVisitor map) t diff --git a/src/dpoly.mli b/src/dpoly.mli new file mode 100644 index 0000000..034f477 --- /dev/null +++ b/src/dpoly.mli @@ -0,0 +1,46 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 PolyError +type map +val polyMap : map +val polyStart : unit -> unit +val polyClear : unit -> unit +val polyMakeSubst : Cil.typ -> Cil.typ -> unit +val polyResolve : unit -> unit +val polyCompMap : Cil.typ -> map +val polySubst : map -> Cil.typ -> Cil.typ diff --git a/src/dsolverfront.ml b/src/dsolverfront.ml new file mode 100644 index 0000000..29b2333 --- /dev/null +++ b/src/dsolverfront.ml @@ -0,0 +1,192 @@ +(* + * dsolverfront.ml + * + * Translate Doptim.absState and Doptim.Can.t + * into a conjunction of constraints. + * + * + *) + +open Cil +open Expcompare +open Pretty +open Dutil + +module H = Hashtbl +(*module DFS = Dflowsens*) +module DCE = Dcanonexp +module Can = DCE.Can + +(* +type absState = DFS.absState +let emptyAbsState = DFS.top +*) + +type 'a translator = +{ + mkTrue : unit -> 'a; + mkFalse : unit -> 'a; + + mkAnd : 'a -> 'a -> 'a; + mkOr : 'a -> 'a -> 'a; + mkNot : 'a -> 'a; + mkIte : 'a -> 'a -> 'a -> 'a; + mkImp : 'a -> 'a -> 'a; + + mkEq : 'a -> 'a -> 'a; + mkNe : 'a -> 'a -> 'a; + mkLt : 'a -> 'a -> 'a; + mkLe : 'a -> 'a -> 'a; + mkGt : 'a -> 'a -> 'a; + mkGe : 'a -> 'a -> 'a; + + mkPlus : 'a -> 'a -> 'a; + mkTimes : 'a -> 'a -> 'a; + mkMinus : 'a -> 'a -> 'a; + mkDiv : 'a -> 'a -> 'a; + mkMod : 'a -> 'a -> 'a; + mkLShift : 'a -> 'a -> 'a; + mkRShift : 'a -> 'a -> 'a; + mkBAnd : 'a -> 'a -> 'a; + mkBXor : 'a -> 'a -> 'a; + mkBOr : 'a -> 'a -> 'a; + + mkNeg : 'a -> 'a; + mkCompl : 'a -> 'a; + + mkVar : string -> 'a; + mkConst : int -> 'a; + + isValidWithAssumptions : 'a list -> 'a -> (bool * (string * int) list); + isValid : 'a -> (bool * (string * int) list); +} + +let baseFVarName = "FV" + +let nameMakerMaker base = + let c = ref 0 in + (fun () -> + incr c; + base^(Int32.to_string (Int32.of_int !c))) + +let fvNameMaker = nameMakerMaker baseFVarName + +(* map expressions that we can't + * translate to variable names *) +(*let unkExpHash = H.create 100*) + +(* if e isn't mapped to a fv then + * make one for it and return it *) +(* +let mkUnk t (e:exp) = + try H.find unkExpHash e + with Not_found -> begin + let fv = t.mkVar (fvNameMaker()) in + H.add unkExpHash e fv; + fv + end +*) + +exception NYI + +let transUnOp t op e = + match op with + | Neg -> t.mkNeg e + | BNot -> t.mkCompl e + | _ -> raise NYI + +let transBinOp t op e1 e2 = + match op with + | PlusA | PlusPI | IndexPI -> t.mkPlus e1 e2 + | MinusA | MinusPI | MinusPP -> t.mkMinus e1 e2 + | Mult -> t.mkTimes e1 e2 + | Div -> t.mkDiv e1 e2 + | Mod -> t.mkMod e1 e2 + | Shiftlt -> t.mkLShift e1 e2 + | Shiftrt -> t.mkRShift e1 e2 + | Lt -> t.mkLt e1 e2 + | Gt -> t.mkGt e1 e2 + | Le -> t.mkLe e1 e2 + | Ge -> t.mkGe e1 e2 + | Eq -> t.mkEq e1 e2 + | Ne -> t.mkNe e1 e2 + | BAnd -> t.mkBAnd e1 e2 + | BXor -> t.mkBXor e1 e2 + | BOr -> t.mkBOr e1 e2 + | LAnd -> t.mkAnd e1 e2 + | LOr -> t.mkOr e1 e2 + + +let rec transCilExp t (e:exp) = + (*ignore(E.log "DSF.transCilExp: %a\n" d_exp e);*) + match e with + | Const(CInt64(v,k,so)) -> t.mkConst (Int64.to_int v) + | Const _ -> raise NYI + | Lval(Var vi,NoOffset) when vi.vname = "_ZERO_" -> + t.mkConst 0 + | Lval l -> t.mkVar (sprint 80 (d_lval () l)) + | UnOp(op,e,_) -> + let e = transCilExp t e in + transUnOp t op e + | BinOp(op,e1,e2,_) -> + let e1 = transCilExp t e1 in + let e2 = transCilExp t e2 in + transBinOp t op e1 e2 + | SizeOf typ -> t.mkConst ((bitsSizeOf typ)/8) + | SizeOfE e -> transCilExp t (SizeOf(typeOf e)) + | SizeOfStr s -> t.mkConst (1 + String.length s) + | AlignOf typ -> t.mkConst (alignOf_int typ) + | AlignOfE e -> transCilExp t (AlignOf(typeOf e)) + | CastE(typ,e) -> transCilExp t e + (* Cast should check if signed type, and if so, make an ite term *) + | AddrOf lv -> t.mkVar (sprint 80 (d_exp () e)) + | StartOf lv -> t.mkVar (sprint 80 (d_exp () e)) + + +(* 'a translator -> Doptim.Can.t -> 'a *) +let transCan t (cane: Can.t) = + let cExp = t.mkConst (Int64.to_int cane.Can.ct) in + List.fold_left (fun (te,ce) (c, ue) -> + let f = t.mkConst (Int64.to_int c) in + let ue' = transCilExp t ue in + let tc = + match typeOf ue with + | TInt(ku,_) -> t.mkLe (t.mkConst 0) ue' + | TPtr(_,_) -> t.mkLe (t.mkConst 0) ue' + | _ -> t.mkTrue () + in + let tm = t.mkTimes f ue' in + (t.mkPlus te tm,t.mkAnd ce tc)) (cExp,t.mkTrue()) cane.Can.cf + +(* 'a translator -> Doptim.absState -> 'a *) +(* +let transAbsState t (state: DFS.absState) = + List.fold_left (fun e (x,c,y,_) -> + let xe = transCilExp t (Lval x) in + let ye = transCilExp t (Lval y) in + let ce = t.mkConst (Int64.to_int c) in + let te = + match typeOf(Lval x), typeOf(Lval y) with + | TInt(kx,_), TInt(ky,_) -> + if not(isSigned kx) && not(isSigned ky) + then t.mkAnd (t.mkLe (t.mkConst 0) ye) (t.mkLe (t.mkConst 0) xe) + else t.mkTrue () + | TPtr(_,_), TPtr(_,_) -> + t.mkAnd (t.mkLe (t.mkConst 0) ye) (t.mkLe (t.mkConst 0) xe) + | _,_ -> t.mkTrue () + in + t.mkAnd te (t.mkAnd e (t.mkLe (t.mkPlus xe ce) ye))) + (t.mkTrue()) state.DFS.ineqs + +let valid t (state: absState) + (op: binop) + (cane1: Can.t) + (cane2: Can.t) + = + let state = transAbsState t state in + let (cane1,c1) = transCan t cane1 in + let (cane2,c2) = transCan t cane2 in + let cs = t.mkAnd state (t.mkAnd c1 c2) in + let e = t.mkImp cs (transBinOp t op cane1 cane2) in + t.isValid e +*) diff --git a/src/dutil.ml b/src/dutil.ml new file mode 100755 index 0000000..8e44947 --- /dev/null +++ b/src/dutil.ml @@ -0,0 +1,634 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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 Doptions +(*open Dattrs*) +open Expcompare + +module E = Errormsg +module GA = GrowArray +module H = Hashtbl + +let curFunc : fundec ref = ref dummyFunDec +let curStmt : int ref = ref (-1) + +(**************************************************************************) +(* Error/log messages *) + +type 'a myformat = ('a, unit, doc, unit) format4 + +let warningQueue : (location * string) list ref = ref [] +let errorQueue : (location * string) list ref = ref [] + +let outputQueue (queue: (location * string) list) : unit = + let compareMsgs (l1, s1) (l2, s2) = + let fileResult = compare l1.file l2.file in + if fileResult != 0 then + fileResult + else + let lineResult = compare l1.line l2.line in + if lineResult != 0 then + lineResult + else + compare s1 s2 + in + let sorted = List.sort compareMsgs queue in + let unique = + List.fold_right + (fun msg acc -> + try + if msg = List.hd acc then acc else msg :: acc + with Failure "hd" -> + msg :: acc) + sorted [] + in + List.iter (fun (l, s) -> ignore (eprintf "%a: %s" d_loc l s)) unique; + flush !E.logChannel + +let outputAll () : unit = + outputQueue !warningQueue; + outputQueue !errorQueue + +let output (isError: bool) (label: string) (coda: string) (msg: doc) : unit = + if isError then E.hadErrors := true; + let d = dprintf "%s%a@!%s@!" label insert msg coda in + (* We output log messages immediately; all others are delayed for sorting. *) + if label = "" then begin + ignore (eprintf "%a: %a" d_loc !currentLoc insert d); + flush !E.logChannel + end else begin + let item = (!currentLoc, sprint 1000000 d) in + if isError then + errorQueue := item :: !errorQueue + else + warningQueue := item :: !warningQueue + end + +let bug (fmt: 'a myformat) : 'a = + let coda = "Please tell the Deputy team about this error.\n" in + Pretty.gprintf (output true "Internal error: " coda) fmt + +let error (fmt: 'a myformat) : 'a = + Pretty.gprintf (output true "Error: " "") fmt + +let unimp (fmt: 'a myformat) : 'a = + Pretty.gprintf (output true "Unimplemented: " "") fmt + +let warn (fmt: 'a myformat) : 'a = + Pretty.gprintf (output false "Warning: " "") fmt + +let log (fmt: 'a myformat) : 'a = + Pretty.gprintf (output false "" "") fmt + +let errorwarn (fmt: 'a myformat) : 'a = + let f d = + if !trustAll then + warn "%a" insert d + else + error "%a" insert d + in + Pretty.gprintf f fmt + +(**************************************************************************) +(* Miscellaneous utility functions *) + +let isPointer (e: exp) : bool = + isPointerType (typeOf e) + +let isPtrOrArray (t: typ) : bool = + match unrollType t with + | TPtr (bt, _) + | TArray (bt, _, _) -> true + | _ -> false + +let isUnionType (t: typ) : bool = + match unrollType t with + | TComp (ci, _) when not ci.cstruct -> true + | _ -> false + +let isOpenArray (t: typ) : bool = + match unrollType t with + | TArray (_, None, _) -> true + | TArray (_, Some e, _) -> isZero e + | _ -> false + +let isOpenArrayComp (t: typ) : bool = + match unrollType t with + | TComp (ci, _) when List.length ci.cfields > 0 -> + let last = List.nth ci.cfields (List.length ci.cfields - 1) in + isOpenArray last.ftype + | _ -> false + +let rec typeContainsPointers (t: typ) : bool = + match t with + | TPtr _ + | TFun _ + | TBuiltin_va_list _ -> true + | TVoid _ + | TInt _ + | TFloat _ + | TEnum _ -> false + | TArray (bt, _, _) -> typeContainsPointers bt + | TNamed (ti, _) -> typeContainsPointers ti.ttype + | TComp (ci, _) -> + not ci.cdefined (* If we don't know the contents of the struct, + conservatively assume it has pointers. *) + || + (List.exists typeContainsPointers + (List.map (fun fld -> fld.ftype) ci.cfields)) + +(** We test if a value of the given type contains as an element a pointer or + * a nullterminated array. This is used to decide whether to initialize with + * 0 an element *) +let typeContainsPtrOrNullterm (t: typ) : bool = + existsType + (function + TPtr _ -> ExistsTrue + | TBuiltin_va_list _ -> ExistsTrue + | TComp (ci, _) when not ci.cdefined -> ExistsTrue (* be conservative *) + | TArray (_, _, a) when hasAttribute "nullterm" a -> ExistsTrue + | _ -> ExistsMaybe) + t + +(* Is this an undefined struct? *) +let isAbstractType (t: typ) : bool = + match unrollType t with + | TComp (ci, _) when ci.cstruct && not ci.cdefined -> true + | _ -> false + +(* Is this a pointer to an undefined struct? *) +let isAbstractPtr (t: typ) : bool = + match unrollType t with + | TPtr(bt, _) -> isAbstractType bt + | _ -> false + +(* Return the base type of a pointer or array*) +let baseType (where: string) (t: typ) : typ = + match unrollType t with + | TPtr (bt, _) + | TArray (bt, _, _) -> bt + | TInt _ -> voidType (* Treat integer type like void*. *) + | _ -> E.s (bug "Expected pointer/array type for %s, got %a" where d_type t) + +(* Return the size of the base type of a pointer or array, in bytes *) +let baseSize (t: typ) : int= + try + bitsSizeOf (baseType "(sizeof base type)" t) / 8 + with + | Cil.SizeOfError (s, _) -> E.s (bug "Computed size of %s" s) + | e -> raise e + +(* Be careful when converting int64 to int. Int64.to_int + treats 2^31 the same as 0 *) +let to_int (i: int64) : int = + let i': int = Int64.to_int i in (* i.e. i' = i mod 2^31 *) + if i = Int64.of_int i' then i' + else E.s (E.error "Int constant too large: %Ld\n" i) + +(* Interpret this integer as a signed 32-bit number. This means we'll + convert 0xFFFFFFFF to -1 instead of 4294967295. *) +let to_signedint (i:int64) : int = + let (<=%) = (fun x y -> (Int64.compare x y) <= 0) in + if -0x80000000L <=% i && i <=% 0xffffffffL then begin + (* If 0x80000000 <= i <= 0xFFFFFFFF, subtract 2^32 from i. *) + if 0x80000000L <=% i then + Int64.to_int (Int64.sub i 0x1_0000_0000L) + else + Int64.to_int i + end + else + E.s (E.error "Int constant too large: %Ld\n" i) + +(* Like iter, but passes an int indicating the current index in the list. *) +let iter_index (fn: 'a -> int -> unit) (a: 'a list) : unit = + let rec helper a n = + match a with + | [] -> () + | a1 :: arest -> fn a1 n; helper arest (n + 1) + in + helper a 1 + +(* Like iter2, but passes an int indicating the current index in the lists. *) +let iter2_index (fn: 'a -> 'b -> int -> unit) (a: 'a list) (b: 'b list) : unit = + let rec helper a b n = + match a, b with + | [], [] -> () + | a1 :: arest, b1 :: brest -> fn a1 b1 n; helper arest brest (n + 1) + | _ -> raise (Invalid_argument "iter2index") + in + helper a b 1 + +(* Removes the last element of a list. *) +let rec remove_last (a: 'a list) : 'a list * 'a = + match a with + | [] -> raise (Failure "remove_last") + | [x] -> [], x + | x :: rest -> + let y, last = remove_last rest in + x :: y, last + +(* Splits a list into two lists consisting of the first n elements + * and the remainder. *) +let rec split (l: 'a list) (n: int) : 'a list * 'a list = + match l with + | elt :: rest when n > 0 -> + let x, y = split rest (n - 1) in + elt :: x, y + | _ -> [], l + + + +(**************************************************************************) + +(* Return a list of vars referenced by an expression, and a boolean + * saying whether memory is referenced. + * + * We remember whether the expressions that we track + * during optimization involve a memory reference, + * and what local vars they contain. This makes it easier to kill facts. *) +type referenced = { + varsRead: varinfo list; + memRead: bool; +} + +let varsOfExp (e:exp) : referenced = + let readsVars = ref [] in + let readsMem = ref false in + let rec loop : exp -> unit = function + BinOp(_, e1, e2, _) -> loop e1; loop e2 + | UnOp (_, e1, _) -> loop e1 + | CastE(_, e1) -> loop e1 + | Const _ + | SizeOf _ | SizeOfE _ | SizeOfStr _ + | AlignOf _ | AlignOfE _ -> () + | StartOf lv | AddrOf lv | Lval lv -> + let lh, off = lv in + loopLh lh; + loopOff off + and loopLh: lhost -> unit =function + Mem _ -> readsMem := true + | Var vi -> if not (List.memq vi !readsVars) then + readsVars := vi::!readsVars + and loopOff: offset -> unit =function + NoOffset -> () + | Field(_, off) -> loopOff off + | Index(e, off) -> loop e; loopOff off + in + loop e; + {varsRead = !readsVars; memRead = !readsMem} + +let d_referenced () (r:referenced) : doc = + dprintf "vars: %a. mem: %s" + (docList (fun vi -> text vi.vname)) r.varsRead + (if r.memRead then "true" else "false") + +(**************************************************************************) + +let rec expRefersToVar (name: string) (e: exp) : bool = + match e with + | Lval lv -> lvalRefersToVar name lv + | AddrOf lv -> lvalRefersToVar name lv + | StartOf lv -> lvalRefersToVar name lv + | SizeOfE e' -> expRefersToVar name e' + | AlignOfE e' -> expRefersToVar name e' + | UnOp (_, e', _) -> expRefersToVar name e' + | BinOp (_, e1, e2, _) -> expRefersToVar name e1 || expRefersToVar name e2 + | CastE (_, e') -> expRefersToVar name e' + | Const _ + | SizeOf _ + | SizeOfStr _ + | AlignOf _ -> false + +and lvalRefersToVar (name: string) ((host, offset): lval) : bool = + let rec offsetRefersToVar (offset: offset) = + match offset with + | Field (fld, offset') -> offsetRefersToVar offset' + | Index (e, offset') -> expRefersToVar name e || offsetRefersToVar offset' + | NoOffset -> false + in + match host with + | Var vi -> vi.vname = name || offsetRefersToVar offset + | Mem e -> expRefersToVar name e || offsetRefersToVar offset + + +(* CIL treats these functions specially and uses & in the arguments + lists for its own reasons.*) +let isVarargOperator (f:exp) : bool = + let varargOperators = [ + "__builtin_va_arg"; + "__builtin_stdarg_start"; + "__builtin_va_start"; + "__builtin_next_arg"; + ] + in + match f with + | Lval(Var vi, NoOffset) -> List.mem vi.vname varargOperators + | _ -> false + +(* Is "size" the correct size of the given lval? + We use this when checking calls to memset. *) +let isCorrectSizeOf (size: exp) (lv: lval) : bool = + (* return true if size is an expression for the size of lv. *) + let actualSize : int = (bitsSizeOf (typeOfLval lv)) / 8 in + let size' : int64 option = isInteger (constFold true size) in + size' = Some (Int64.of_int actualSize) + + +let memset: varinfo = + (* Create a decl for "__deputy_memset". This is identical to memset, + but we give it its own name to avoid conflicts. We add this to the file + in dinfer. *) + let memsetType = TFun(voidPtrType, Some [("p", voidPtrType, []); + ("what", intType, []); + ("sz", ulongType, [])], + false, + [Attr("dmemset", [AInt 1; AInt 2; AInt 3])]) in + makeGlobalVar "__deputy_memset" memsetType + +(******************************************************************************) +(* Expression comparison and cast stripping *) + +(* Is this a signed comparison? *) +let rec isSignedType (t:typ) : bool = + match unrollType t with + | TInt(ik,_) -> isSigned ik + | TEnum _ -> true + | TPtr _ -> false + | TArray _ -> false + | _ -> E.s (bug "expecting an int or ptr in isSignedType, got %a" d_type t) + +(* A complete list of Deputy attributes. During postprocessing, + we'll delete all of these attributes from the file so that the output is + gcc-ready. *) +let isDeputyAttr (a:attribute): bool = + match a with + Attr(("bounds" | "fancybounds" | "nullterm" | "trusted" | "copytype" + | "size" | "fancysize" + | "when" | "fancywhen" | "sentinel" | "nonnull" | "hidden" + | "dalloc" | "drealloc" | "dfree" + | "dmemset" | "dmemcpy" | "dmemcmp" | "dvararg" + | "tyvar" | "typaram" + | "_ptrnode" | "missing_annot" | "assumeconst" | "Preconditions" + | "blocking" | "noblocking" | "blockingunless" | "irq_restore" + | "irq_save" + | "Modifies" | "Taint" | "CTaint" | "ScanTaint" + | "tainted" ), _) -> true + | _ -> false + + +let hasDeputyAttr (t:typ): bool = + List.exists isDeputyAttr (typeAttrs t) + +let stripDepsFromType (t:typ) : typ = + let t' = unrollType t in + typeRemoveAttributes ["bounds"; "size"; "when"] t' + + +(* type signature w/o Deputy attrs *) +let typeSigNC (t : typ) : typsig = + let attrFilter (a : attribute) = + not(isDeputyAttr a) + in + typeSigWithAttrs ~ignoreSign:true (List.filter attrFilter) t + + +(* Two types are equal iff their typeSigs w/o Deputy attrs are equal *) +let deputyCompareTypes (t1 : typ) (t2 : typ) : bool = + (typeSigNC t1) = (typeSigNC t2) + + +(* Checks that two types have the same non-Deputy attributes *) +let sameAttrs (t1 : typ) (t2 : typ) : bool = + let a1 = typeSigAttrs (typeSigNC (unrollType t1)) in + let a2 = typeSigAttrs (typeSigNC (unrollType t2)) in + List.filter (fun a -> not(List.mem a a2)) a1 = [] && + List.filter (fun a -> not(List.mem a a1)) a2 = [] + + +let rec findInnermostNonCast (e : exp) : exp = + match e with + | CastE(t, e) -> findInnermostNonCast e + | _ -> e + + +(* Strip casts among pointers where the non-Deputy attributes are the same and + * the size of the base types are the same. + * Also, strip casts among integer types of equal bitwidth *) +let rec deputyStripCastsForPtrArith (e:exp): exp = + if !debug then ignore(E.log "deputyStripCastsForPtrArith %a\n" d_exp e); + match e with + | CastE(t, e') (*when not(isTypeVolatile t)*) -> begin + let e' = deputyStripCastsForPtrArith e' in + match unrollType (typeOf e'), unrollType t with + | TPtr (TVoid _, _), TPtr (bt2, _) when not (isVoidType bt2) -> + CastE(t,e') + | TPtr(bt1, a1), TPtr(bt2, a2) -> begin + try + if bitsSizeOf bt1 = bitsSizeOf bt2 && + sameAttrs (typeOf e') t + then e' + else CastE(t,e') + with SizeOfError _ -> CastE(t,e') + end + (* remove casts among integer types of equal bitwidth *) + | (TInt _ as t1), (TInt _ as t2) + when bitsSizeOf t1 = bitsSizeOf t2 -> + if sameAttrs t1 t2 then e' else CastE(t, e') + | (TPtr _ as t1), (TInt(ik,_) as t2) + when bitsSizeOf t1 = bitsSizeOf t2 && not (isSigned ik) -> + if sameAttrs t1 t2 then e' else CastE(t, e') + | _, _ -> CastE(t, e') + end + | UnOp(op,e,t) -> + let e = deputyStripCastsForPtrArith e in + UnOp(op, e, t) + | BinOp(MinusPP,e1,e2,t) -> + let e1 = deputyStripCastsForPtrArith e1 in + let e2 = deputyStripCastsForPtrArith e2 in + if not(compareTypesNoAttributes ~ignoreSign:false + (typeOf e1) (typeOf e2)) + then BinOp(MinusPP, mkCast ~e:e1 ~newt:(typeOf e2), e2, t) + else BinOp(MinusPP, e1, e2, t) + | BinOp(op,e1,e2,t) -> + let e1 = deputyStripCastsForPtrArith e1 in + let e2 = deputyStripCastsForPtrArith e2 in + BinOp(op,e1,e2,t) + | Lval lv -> Lval(deputyStripCastsForPtrArithLval lv) + | AddrOf lv -> AddrOf(deputyStripCastsForPtrArithLval lv) + | StartOf lv -> StartOf(deputyStripCastsForPtrArithLval lv) + | _ -> e + + +and deputyStripCastsForPtrArithLval (lv : lval) : lval = + match lv with + | (Var vi, off) -> (Var vi, deputyStripCastsForPtrArithOff off) + | (Mem e, off) -> + let e = deputyStripCastsForPtrArith e in + let off = deputyStripCastsForPtrArithOff off in + (Mem e, off) + + +and deputyStripCastsForPtrArithOff (off : offset ) : offset = + match off with + | NoOffset -> NoOffset + | Field(fi, off) -> Field(fi, deputyStripCastsForPtrArithOff off) + | Index(e, off) -> + let e = deputyStripCastsForPtrArith e in + let off = deputyStripCastsForPtrArithOff off in + Index(e, off) + + +let rec deputyCompareExp (e1 : exp) (e2 : exp) : bool = + if !debug then ignore(E.log "deputyCompareExp:\n\t%a =\n\t%a\n" + d_plainexp e1 d_plainexp e2); + e1 == e2 || + match e1, e2 with + | (Lval lv1|StartOf lv1), (Lval lv2|StartOf lv2) + (*| StartOf lv1, StartOf lv2*) + | AddrOf lv1, AddrOf lv2 -> deputyCompareLval lv1 lv2 + | BinOp(op1, l1, r1, _), BinOp(op2, l2, r2, _) -> + op1 = op2 && (deputyCompareExp l1 l2) && (deputyCompareExp r1 r2) + | UnOp(op1, e1, _), UnOp(op2, e2, _) -> + op1 = op2 && (deputyCompareExp e1 e2) + | SizeOfE e1, SizeOfE e2 + | AlignOfE e1, AlignOfE e2 -> deputyCompareExp e1 e2 + | CastE(t1, e1), CastE(t2, e2) when deputyCompareTypes t1 t2 -> + deputyCompareExp e1 e2 + | _, _ -> begin + match isInteger (constFold true e1), isInteger (constFold true e2) with + | Some i1, Some i2 -> i1 = i2 + | _ -> false + end + +and deputyCompareLval (lv1 : lval) (lv2 : lval) : bool = + let rec compareOffset (off1: offset) (off2: offset) : bool = + match off1, off2 with + | Field (fld1, off1'), Field (fld2, off2') -> + fld1 == fld2 && compareOffset off1' off2' + | Index (e1, off1'), Index (e2, off2') -> + deputyCompareExp e1 e2 && compareOffset off1' off2' + | NoOffset, NoOffset -> true + | _ -> false + in + if !debug then ignore(E.log "deputyCompareLval:\n\t%a = \n\t%a\n" + d_lval lv1 d_lval lv2); + lv1 == lv2 || + match lv1, lv2 with + | (Var vi1, off1), (Var vi2, off2) -> + vi1 == vi2 && compareOffset off1 off2 + | (Mem e1, off1), (Mem e2, off2) -> + deputyCompareExp e1 e2 && compareOffset off1 off2 + | _ -> false + + +let deputyStripAndCompareExp (e1 : exp) (e2 : exp) : bool = + if !debug then ignore(E.log "deputyStripAndCompareExp\n"); + let e1' = deputyStripCastsForPtrArith e1 in + let e2' = deputyStripCastsForPtrArith e2 in + let res = deputyCompareExp e1' e2' in + if res then begin + if !debug then ignore(E.log "%a -> %a == %a <- %a\n" + d_plainexp e1 d_plainexp e1' d_plainexp e2' d_plainexp e2); + res + end else begin + if !debug then ignore(E.log "%a -> %a != %a <- %a\n" + d_plainexp e1 d_plainexp e1' d_plainexp e2' d_plainexp e2); + res + end + + +(*****************************************************************) +(* Count the lines containing trusted code. *) + +(* programLocs is the set of lines where we do at least some checking. + trustedLocs (a subset of programLocs) is the set of lines where we've + skipped some check. + + "check" here includes compile-time type checking in addition to the + runtime checks. + + These counts are approximate. + *) +let programLocs : (location, unit) H.t = H.create 50 +let trustedLocs : (location, unit) H.t = H.create 50 + +(* Call this at each location that is checked. Uses !currentLoc *) +let markLocationChecked () : unit = + if !Doptions.countTrustedLines && !currentLoc != locUnknown then + H.replace programLocs !currentLoc () + +(* Call this at each location where a check was skipped due to TRUSTED *) +let markLocationTrusted () : unit = + if !Doptions.countTrustedLines && !currentLoc != locUnknown then begin + H.replace trustedLocs !currentLoc () + end + +let locationVisitor = object(self) + inherit nopCilVisitor + method vstmt s = + markLocationChecked (); + markLocationTrusted (); + DoChildren + method vinst i = + markLocationChecked (); + markLocationTrusted (); + SkipChildren + method vexpr e = SkipChildren + method vtype t = SkipChildren +end + +let markTrustedBlock (b: block) : unit = + if !Doptions.countTrustedLines then + ignore (visitCilBlock locationVisitor b) + +let reportTrustedLines () : unit = + assert(!Doptions.countTrustedLines); + currentLoc := locUnknown; + begin + (* Sanity check: is programLocs a superset of trustedLocs? If not, + then we aren't adding enough locations to programLocs. *) + H.iter (fun l () -> + if not (H.mem programLocs l) then + bug "Location %a not in programLocs" d_loc l) + trustedLocs + end; + let numLines = H.length programLocs in + let trustedLines = H.length trustedLocs in + E.log ("The file contains %d non-trivial lines, including %d lines that"^^ + " contain\n a trusted operation.\n") numLines trustedLines; + () diff --git a/src/dutil.mli b/src/dutil.mli new file mode 100644 index 0000000..5ddc614 --- /dev/null +++ b/src/dutil.mli @@ -0,0 +1,87 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 curFunc : Cil.fundec ref +val curStmt : int ref +val memset : Cil.varinfo +val outputAll : unit -> unit +val bug : ('a, unit, Pretty.doc, unit) format4 -> 'a +val error : ('a, unit, Pretty.doc, unit) format4 -> 'a +val unimp : ('a, unit, Pretty.doc, unit) format4 -> 'a +val warn : ('a, unit, Pretty.doc, unit) format4 -> 'a +val log : ('a, unit, Pretty.doc, unit) format4 -> 'a +val errorwarn : ('a, unit, Pretty.doc, unit) format4 -> 'a +val isPointer : Cil.exp -> bool +val isPtrOrArray: Cil.typ -> bool +val isUnionType : Cil.typ -> bool +val isOpenArray : Cil.typ -> bool +val isOpenArrayComp : Cil.typ -> bool +val typeContainsPointers : Cil.typ -> bool +val typeContainsPtrOrNullterm : Cil.typ -> bool +val isAbstractType : Cil.typ -> bool +val isAbstractPtr : Cil.typ -> bool +val baseType : string -> Cil.typ -> Cil.typ +val baseSize : Cil.typ -> int +val to_int : int64 -> int +val to_signedint : Int64.t -> int +val iter_index : ('a -> int -> unit) -> 'a list -> unit +val iter2_index : ('a -> 'b -> int -> unit) -> 'a list -> 'b list -> unit +val remove_last : 'a list -> 'a list * 'a +val split : 'a list -> int -> 'a list * 'a list +type referenced = { varsRead : Cil.varinfo list; memRead : bool } +val varsOfExp : Cil.exp -> referenced +val d_referenced : unit -> referenced -> Pretty.doc +val expRefersToVar : string -> Cil.exp -> bool +val lvalRefersToVar : string -> Cil.lval -> bool +val isVarargOperator : Cil.exp -> bool +val isCorrectSizeOf : Cil.exp -> Cil.lval -> bool + +val isSignedType : Cil.typ -> bool +val isDeputyAttr : Cil.attribute -> bool +val hasDeputyAttr : Cil.typ -> bool +val stripDepsFromType: Cil.typ -> Cil.typ +val deputyCompareTypes: Cil.typ -> Cil.typ -> bool +val deputyCompareExp: Cil.exp -> Cil.exp -> bool +val deputyCompareLval: Cil.lval -> Cil.lval -> bool +val deputyStripCastsForPtrArith : Cil.exp -> Cil.exp +val deputyStripAndCompareExp : Cil.exp -> Cil.exp -> bool + +val markLocationChecked: unit -> unit +val markLocationTrusted: unit -> unit +val markTrustedBlock: Cil.block -> unit +val reportTrustedLines: unit -> unit + diff --git a/src/dvararg.ml b/src/dvararg.ml new file mode 100755 index 0000000..9245b81 --- /dev/null +++ b/src/dvararg.ml @@ -0,0 +1,172 @@ +(* + * + * Copyright (c) 2001-2002, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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 Dattrs +open Dutil + +module E = Errormsg + +(* Process a printf-like vararg function. Each argument gets a cast + * to its expected type so that later type-checking phases work properly. *) +let processVarargs (args: exp list) (nrFormals: int) (formidx: int) : exp list = + (* Return the index of the next descriptor *) + let findNextDescr (s: string) (from: int) : char * int = + try + let i = String.index_from s from '%' in + let rec parseConversionSpec (start: int) : char * int = + match Char.lowercase s.[start] with + | 'e' | 'f' | 'g' (* double arg *) + | 'a' -> (* double arg *) + 'f', start + 1 + | 'd' | 'i' (* signed int arg *) + | 'o' | 'u' | 'x' (* unsigned int arg *) + | 'c' (* unsigned char *) + | 'p' -> (* void pointer treated as int *) + 'd', start + 1 + | 's' -> 's', start + 1 (* char pointer *) + | 'n' -> 'n', start + 1 + | '%' -> + let i' = String.index_from s (start + 1) '%' in + parseConversionSpec (i' + 1) + | _ -> parseConversionSpec (start+1) + in + parseConversionSpec (i + 1) + with _ -> + '_', -1 + in + + let getDescrType (descr: char) : typ = + match descr with + | 'f' -> doubleType + | 'd' -> intType + | 'n' -> intPtrType + | 's' -> typeAddAttributes Dattrs.stringAttrs charPtrType + | _ -> E.s (bug "Unexpected vararg descr %c." descr) + in + + let rec checkFormatArgs (form: string) (idx: int) (args: exp list) + : exp list = + let descr, idx' = findNextDescr form idx in + match descr, args with + | '_', [] -> [] + | '_', _ -> + warn "Too many arguments to printf-like vararg function."; + args + | _, [] -> + errorwarn "Too few arguments to printf-like vararg function."; + args + | _, arg :: rest -> + (* TODO: This cast may change the behavior of the program; for + * example, casting a pointer to an integer for %d may convert + * a 64-bit pointer to a 32-bit integer on some architectures. + * Is there a better way? *) + mkCast arg (getDescrType descr) :: (checkFormatArgs form idx' rest) + in + + if formidx <= 0 || formidx > nrFormals then + E.s (error "Expected the format string to be the %dth argument." formidx); + if List.length args < nrFormals then + E.s (error "Too few arguments to vararg function."); + + match List.nth args (formidx - 1) with + | Const (CStr form) -> + let preArgs, vaArgs = split args nrFormals in + preArgs @ (checkFormatArgs form 0 vaArgs) + | _ -> + warn "Cannot check varargs due to non-literal format string."; + args + + +(* Returns a pair containing the number of formal arguments and the index + * of the format string. *) +let getVarargData (func: exp) : int * int = + match unrollType (typeOf func) with + | TFun (_, Some forms, _, a) -> + begin + match filterAttributes "dvararg" a with + | Attr (_, [ACons("printf", [AInt fidx])]) :: _ -> + List.length forms, fidx + | a -> raise Not_found + end + | _ -> assert false + + +(* Prepare the arguments in a call to a vararg function. *) +let prepareVarargArguments + ~(mkTempVar: typ -> varinfo) (* how to make a temporary variable *) + ~(func: exp) (* the called function *) + ~(nrformals: int) (* how many formals *) + ~(args: exp list) : exp list = + + try + let forms, fidx = getVarargData func in + processVarargs args forms fidx + with Not_found -> begin + if !Doptions.warnVararg then + warn "Call to vararg function %a not fully checked." d_exp func; + args + end + + +(* Turn the gcc format attribute into our own notation. Returns a type + * that may have a new attribute but which is otherwise the same. *) +let processFormatAttribute (funType: typ) : typ = + match filterAttributes "format" (typeAttrs funType) @ + filterAttributes "__format__" (typeAttrs funType) + with + | [Attr (_, [ACons (name, []); AInt format_idx; AInt _])] -> + if name = "printf" || name = "__printf__" then begin + match funType with + | TFun (rt, forms, isva, a) -> + TFun (rt, forms, isva, + addAttribute + (Attr("dvararg", [ACons("printf", [AInt format_idx])])) a) + | _ -> assert false + end else if name = "scanf" || name = "__scanf__" || + name = "strftime" || name = "__strftime__" || + name = "strfmon" || name = "__strfmon" then begin + (* Ignore these for now. *) + funType + end else begin + warn "Did not understand %s format attribute." name; + funType + end + + | [] -> funType + | al -> warn "Malformed format attribute."; funType diff --git a/src/dvararg.mli b/src/dvararg.mli new file mode 100644 index 0000000..22df252 --- /dev/null +++ b/src/dvararg.mli @@ -0,0 +1,41 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * Matthew Harren + * George C. Necula + * 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 prepareVarargArguments : + mkTempVar:(Cil.typ -> Cil.varinfo) -> func:Cil.exp -> nrformals:int -> + args:Cil.exp list -> Cil.exp list +val processFormatAttribute : Cil.typ -> Cil.typ diff --git a/src/infer/controlflow.ml b/src/infer/controlflow.ml new file mode 100644 index 0000000..06c18d4 --- /dev/null +++ b/src/infer/controlflow.ml @@ -0,0 +1,1139 @@ +(* + * + * Copyright (c) 2006, + * Matt Harren + * 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 does three things: a call-graph analysis, a points-to + * analysis of function pointers for the sake of building the call + * graph, and an analysis of blocking functions in the Linux kernel. + * + * The points-to analysis could be extended to all lvalues, if that + * were useful. *) + +open Cil +open Pretty +open Dutil + +module E = Errormsg +module IH = Inthash +module H = Hashtbl +module DF = Dataflow + +open Ptrnode +let (=?) = Util.equals + +let verbose = false +let assumeTypesafeFunctionCalls = true + +let contextForCall (ftype:typ) (args: exp list): Dattrs.context = + let _,formals',_,_ = splitFunctionType ftype in + let formals = argsToList formals' in + let numFormals = List.length formals in + let actualsMain, actualsVararg = split args numFormals in + + (* This is a simplified version of the code in dcheck.ml *) + let ctx = + try + List.fold_right2 + (fun (argName, argType, _) arg ctxAcc -> + if argName <> "" then + (Dattrs.addBinding ctxAcc argName (deputyStripCastsForPtrArith arg)) + else + ctxAcc) + formals + actualsMain + Dattrs.emptyContext + with Invalid_argument _ -> + E.s (bug "Expected lists with same length") + in + ctx + + +let compileLvalAttribute ctx (annot:attrparam): lval = + let deps, res = Dattrs.compileAttribute ~deputyAttrsOnly:false ctx annot + in + match res with + Lval lv -> lv + | _ -> E.s (error "IRQ_SAVE/RESTORE argument must be an lvalue") + + +(* Function attributes can depend on the parameters. + Here, take an attribute and compile it with respect to the actual argument. *) +let compileFunctionAttribute (ftype:typ) (args: exp list) ~(reto:lval option) + (annot:attrparam): lval = + let ctx = contextForCall ftype args in + let ctx' = + match reto with + Some lv -> Dattrs.addBinding ctx "__ret" (Lval lv) + | None -> ctx + in + compileLvalAttribute ctx' annot + +(**************************************************************************** + ** Part 1: Points-to analysis for function pointers ** + ** ** + ** Using the graph built by the solver, we push around the set of ** + ** functions that a node could point to. ** + ** ** +****************************************************************************) + +module VarinfoSet = + Set.Make(struct + type t = varinfo + let compare v1 v2 = Pervasives.compare v1.vid v2.vid + end) + + +(* The functions to which a node could point. *) +let funcsOfNode: VarinfoSet.t IH.t = IH.create 49 + +let getFuncs (n: node) : VarinfoSet.t = + try + let res = IH.find funcsOfNode n.id in +(* log "Node %d can point to %a\n" n.id *) +(* (docList (fun v -> text v.vname)) (VarinfoSet.elements res); *) + res + with Not_found -> +(* log "Node %d currently points nowhere.\n" n.id; *) + VarinfoSet.empty + + +let doPTA (f: file) : unit = + flush !E.logChannel; + (* The worklist is a set of nodes for whom funcsOfNode has recently + changed.*) + let worklist = Queue.create () in + + (* Step 1: initialize the nodes for the addresses of functions. *) + let initOneFunc vf : unit = + let n = match nodeOfAttrlist vf.vattr with + Some n -> n + | _ -> E.s (bug "Function %s is missing a node." vf.vname) + in + IH.add funcsOfNode n.id (VarinfoSet.singleton vf); + Queue.add n worklist; + () + in + iterGlobals f + (function GFun(fn, _) -> initOneFunc fn.svar + | GVarDecl(vf,_) when isFunctionType vf.vtype -> initOneFunc vf + | _ -> () ); + + (* Step 2: push stuff around. *) + while not (Queue.is_empty worklist) do + let n = Queue.pop worklist in + let funcs = getFuncs n in + + let considerNode n2: unit = + (* Ensure (getFuncs n) is a subset of (getFuncs n2) *) + let funcs2 = getFuncs n2 in + if not (VarinfoSet.subset funcs funcs2) then begin + IH.replace funcsOfNode n2.id + (VarinfoSet.union funcs funcs2); + Queue.push n2 worklist + end + in + + + (* Successor edges: n-->n2 implies that (getFuncs n) should be a subset + of (getFuncs n2) *) + let doSucc e = + match e.ekind with + ECast _ + | ECompat _ -> considerNode e.eto + | _ -> () + in + List.iter doSucc n.succ; + + (* For predecessor edges, consider only ECompat edges. *) + let doPred e = + match e.ekind with + ECompat _ -> considerNode e.efrom + | _ -> () + in + List.iter doPred n.pred + done; + () + + + +(**************************************************************************** + ** Part 2: Build the flow-insensitive call graph ** + ****************************************************************************) + +type calltype = Direct | Indirect + +(** A call is a function being called and a list of arguments. *) +type call = varinfo * exp list * calltype * location + + +let d_call () c : doc = + let vf,args,direct,loc = c in + dprintf "%s(%a) %a at %a" vf.vname (docList (d_exp ())) args + insert (if direct= Indirect then text "(Indirect)" else nil) + d_loc loc + + +(* A map from each function (using the varinfo id) to + the calls that it might makes *) +let callgraph: call list IH.t = IH.create 49 + +let callgraphLookup (f:varinfo): call list = + try + IH.find callgraph f.vid + with Not_found -> + (* Probably an external function *) + warn "Call graph information has not been computed for function %s" + f.vname; + [] + + +(* Return the "call" info for this call. + A direct call returns one item; an indirect may return many *) +let getCalls (f:exp) (args:exp list) (loc:location) : call list = + match f with + Lval(Var vf, NoOffset) -> + [vf,args,Direct,loc] + | Lval(Mem pf, NoOffset) when not !Doptions.inferKinds -> + [] (* We've already warned about this. *) + | Lval(Mem pf, NoOffset) -> + let n = match nodeOfAttrlist (typeAttrs (typeOf pf)) with + Some n -> n + | n -> E.s (bug "Can't get the node of %a" d_exp pf) + in + let funcs = + if assumeTypesafeFunctionCalls then begin + (* Filter the list of functions, considering only those + who have the same number of formals as we provide + actuals. Assume Deputy rules out other cases. *) + let numActualArgs = List.length args in + VarinfoSet.filter + (fun (f:varinfo) -> + match unrollType f.vtype with + TFun(_, Some formals, false, _) -> + numActualArgs = List.length formals + | TFun _ -> (* vararg function or no formals specified. *) + true (* conservative *) + | _ -> E.s (bug "expecting TFun")) + (getFuncs n) + end + else + (getFuncs n) + in + let numFuncs = VarinfoSet.cardinal funcs in + if numFuncs <= 0 && !Doptions.inferKinds then + warn ("Function pointer %a (node %d) doesn't seem to point to any" + ^^" functions.\nYou should only use --blocking-analysis with" + ^^" the whole program.") + d_exp pf n.id; + (* If there is exactly one function that pf can point to, + consider this a direct call. *) + let isDirect = if numFuncs = 1 then begin + (* E.log "%a: treating indirect jump as a direct call\n" d_loc loc; *) + Direct + end else + Indirect + in + List.map (fun vf -> (vf,args,isDirect,loc)) + (VarinfoSet.elements funcs) + | _ -> + E.s (bug "Bad Call instruction.") + + +class findCallsVisitor (funcName: string) (callList: call list ref) + = object (self) + inherit nopCilVisitor + + method vinst i = + (match i with + Call(_, f, args, loc) -> + let addOne c: unit = + if not (List.mem c !callList) then + callList := c::!callList + in + List.iter addOne (getCalls f args loc) + | Asm _ | Set _ -> () + ); + SkipChildren + + method vexpr e = SkipChildren + method vtype t = SkipChildren + +end + +let buildCallGraph (f:file) : unit = + if !Doptions.inferKinds then + doPTA f + else + Dutil.warn "Because the whole-file solver was not used, points-to information is unavailable. Therefore, indirect function calls will be ignored.\n"; + + let doOneFunc (fn: fundec): unit = + let callList = ref [] in + let visitor = new findCallsVisitor fn.svar.vname callList in + ignore(visitCilFunction visitor fn); + (* if verbose then *) begin + E.log "\n%s may call:\n" fn.svar.vname; + List.iter + (fun c -> E.log " %a\n" d_call c) + !callList; + end; + if IH.mem callgraph fn.svar.vid then + bug "computed the callgraph twice"; + IH.add callgraph fn.svar.vid !callList + in + let doOneGlobal: global -> unit = function + GFun(fn,_) -> doOneFunc fn + | _ -> () + in + iterGlobals f doOneGlobal; + () + +let isLeaf (vf:varinfo): bool = + try + [] = (IH.find callgraph vf.vid) + with Not_found -> + E.s (bug "Function %s missing from the call graph." vf.vname) + +(* A map from each function (using the varinfo id) to + the functions that might call it *) +let buildInversecallgraph (f:file) : fundec list IH.t = + let inversecallgraph: fundec list IH.t = IH.create (IH.length callgraph) in + + let doOneFunc fn: unit = + let addCall (c:call): unit = + let target,_,_,_ = c in + let oldCallersOfTarget = + try + IH.find inversecallgraph target.vid + with Not_found -> [] + in + if not (List.memq fn oldCallersOfTarget) then begin +(* if verbose then *) +(* E.log "%s calls %s\n" vf.vname target.vname; *) + IH.replace inversecallgraph target.vid (fn::oldCallersOfTarget) + end + in + List.iter addCall (callgraphLookup fn.svar) + in + iterGlobals f + (function GFun(fn, _) -> doOneFunc fn + | _ -> () ); + inversecallgraph + + + +(**************************************************************************** + ** Part 3: A whole-program, flow-sensitive blocking analysis: ** + ****************************************************************************) + +(* Sources of unsoundness: + * o IRQ_SAVE/IRQ_RESTORE functions are assumed to do nothing but save/restore. + * If they do more than that, the blocking analysis may miss it. + * o We don't check for writes that would clobber saved flags. + * o ... + * *) + +type interruptBit = + Disabled + | Enabled + | Unchanged + | UnchangedEnabled (* We have discovered that Unchanged==Enabled on this path *) + | Top (* Top *) + | IrqRestore (* A special placeholder value used to ensure + that IRQ_RESTORE functions behave as advertized *) + + +type whyType = + | BlockAnnotation (** Annotated as a blocking function *) + | JoinWithEnabled of location + (** The function joins unchanged and enabled, so Unchanged should equal + Enabled. *) + +(* Why did the analysis say that interupts should be enabled? + This is one of the reasons above, plus a call chain leading to it. *) +type mustEnable = + call list * whyType + +(* State of the analysis. + * For preEnabled, all that matters is the difference between Some and None. + * The exact contents of preEnabled are only used for error reporting. + * + * Locally: + * This is a lattice where the top element is + * { interruptState = Top; precondition = Some _; savedFlags = [] } + * + * Interprocedurally: + * Top isn't used (we just report an error and save Unchanged in the summary). + * savedFlags is also unused. Therefore the top element is + * { interruptState = Unchanged; preEnabled = Some _; } + * Also, preEnabled is ignored if there's a BLOCKING annotation on the function. + * + *) +type blockingState = { + interruptState: interruptBit; (* Postcondition *) + precondition: mustEnable option; (* If a blocking function might be called without + first enabling interrupts, this is a call chain + demonstrating that. *) + savedFlags: (lval * interruptBit) list; +} + + +let d_bit (): interruptBit -> doc = + (function Disabled -> text "disabled" + | Enabled -> text "enabled" + | Unchanged -> text "unchanged" + | UnchangedEnabled -> text "unchanged, but enabled" + | IrqRestore -> text "restore_saved_flags" + | Top -> text "Top") +let d_blockingState () s : doc = + (if s.precondition <> None then + text "May block; " + else nil) + ++ + d_bit () s.interruptState + ++ text "; " ++ + docList ~sep:(text "::") + (fun (lv,b) -> dprintf "(%a -> %a)" d_lval lv d_bit b) + () + s.savedFlags + +let d_whyType (): whyType -> doc = function + BlockAnnotation -> text "which is annotated as blocking" + | JoinWithEnabled loc -> + text "which enables interrupts along only one path at " + ++ d_loc () loc + + +(* The state/summary of a function that does nothing *) +let emptySummary = + { interruptState = Unchanged; + precondition = None; + savedFlags = [] } + +(* Merge two precondition values. If both could block, choose the best + (e.g shortest) of them *) +let shorter r1 r2 = + let (l1,wt1) = r1 in + let (l2,wt2) = r2 in + (* return the shorter list. + But give priority to annotations over bad joins *) + if wt1 = wt2 then begin + if (List.length l1) <= (List.length l2) then r1 else r2 + end + else if wt1 = BlockAnnotation then r1 else r2 +let betterMayBlock mb1 mb2 = + match mb1, mb2 with + None, None -> None + | Some l1, Some l2 -> Some (shorter l1 l2) + | Some l, None + | None, Some l -> Some l + + +(**************************************************************************** + ** Part 3.1: Blocking annotations and stuff ** + ****************************************************************************) + +let assertIntsEnabledFun = "__deputyAssertIntEnabled" + +class blockingPrinterClass : descriptiveCilPrinter = object (self) + inherit Dattrs.deputyPrinterClass ~showBounds:true ~enable:false as super + + method pAttr (Attr (an, args) : attribute) : doc * bool = + match an, args with + | ("blocking"), [] -> + text "BLOCKING", false + | ("noblocking"), [] -> + text "NOBLOCKING", false + | "blockingunless", [AInt arg; AInt mask] -> + dprintf "BLOCKINGUNLESS(%d,%d)" arg mask, false + | _ -> + super#pAttr (Attr (an, args)) +end + + +(* Does Callee block? If so, change the precondition field of state to Some [] *) +let handleBlockingAnnotations summary + ~(curstate:interruptBit) ~(caller:varinfo) ~(call:call) + : blockingState = + let callee, args, _, _ = call in + let alwaysBlocks () = + {summary with precondition = Some ([], BlockAnnotation)} + in + let neverBlocks () = + {summary with precondition = None} + in + let conditionallyBlocks () = + (* Calls e.g. kmalloc with a variable flags argument, + and the caller has a blockingunless annotation. + FIXME: UNSOUND: make sure this is the same arg that was + passed to the caller. *) + match curstate with + Enabled | Unchanged | UnchangedEnabled -> summary + | Disabled | Top -> + Dutil.warn "%s called with a variable flags argument when interrupts might be disabled." callee.vname; + alwaysBlocks () + | IrqRestore -> E.s (unimp "call a conditionally-blocking function from an IRQ_RESTORE function.") + + in + if (hasAttribute "blocking" callee.vattr) then + alwaysBlocks () + else if (hasAttribute "noblocking" callee.vattr) then + neverBlocks () + else match filterAttributes "blockingunless" callee.vattr with + [] -> + (* There is no annotation *) + summary + | [Attr("blockingunless", [AInt arg; AInt mask])] -> begin + let value: exp = + try + List.nth args (arg-1) + with Failure _ -> + E.s (Dutil.bug "too few args in call to %s" callee.vname) + in + (* The function blocks if (value&mask) is zero *) + match isInteger (constFold true value) with + Some value' -> + let blocks = 0 = ((i64_to_int value') land mask) in + if blocks then begin + (* Dutil.log "call to %s blocks here." vf.vname; *) + alwaysBlocks () + end + else begin + (* Dutil.log "call to %s is non-blocking." vf.vname; *) + neverBlocks () + end + | None -> + (* The flags argument is a variable *) + if not (hasAttribute "blockingunless" caller.vattr) then begin + Dutil.warn "%s called with a variable flags argument." + callee.vname; + alwaysBlocks () + end else + conditionallyBlocks () + end + | _ -> E.s (Dutil.error "Bad BLOCKINGUNLESS attr") + + +(**************************************************************************** + ** Part 3.2: The rest of the analysis ** + ****************************************************************************) + +let curFunc = ref Cil.dummyFunDec +let curFuncSummary : blockingState option ref = ref None +let functionSummaries: (blockingState * int) IH.t = IH.create 50 + +(* A list of places that call blocking functions after explicitly disabling + interrupts *) +let blockingErrors: ((location*fundec*interruptBit), mustEnable) H.t = + H.create 10 + +exception AddPrecondition of mustEnable + +(********* Functions that update the state ********) +let enableInterrupts s : blockingState = + {s with interruptState = Enabled} +let disableInterrupts s : blockingState = + {s with interruptState = Disabled} + +let assertInterruptsEnabled calleename s : blockingState = + match s.interruptState with + Enabled | UnchangedEnabled -> s + | Unchanged -> { s with interruptState = UnchangedEnabled } + | Disabled -> + error "Call to %s will always fail." calleename; + { s with interruptState = Enabled } + | Top -> { s with interruptState = Enabled } + | IrqRestore -> + (* E.s (unimp "Call to %s in an IRQ_RESTORE function" calleename) *) + s + + +let restoreInterrupts s lv : blockingState = + try + {s with interruptState = List.assoc lv s.savedFlags} + with Not_found -> + Dutil.warn "Blocking error: restoring the interrupt state from %a, which I don't recognize. State is \"%a\"\n" + d_lval lv d_blockingState s; + {s with interruptState = Top} +let saveInterrupts s lv : blockingState = + if List.mem (lv,s.interruptState) s.savedFlags then + s (* nothing to do *) + else begin + (* Delete any previous bindings for lv *) + let different (lv',_) = not (lv' =? lv) in + let others = + if List.for_all different s.savedFlags then s.savedFlags + else List.filter different s.savedFlags + in + { s with savedFlags = (lv,s.interruptState)::others } + end + +(* Handle the precondition part of summary. *) +let callFunctionHandleMayBlock s call : blockingState = + let (f:varinfo),_,_,_ = call in + let summary,_ = + try + IH.find functionSummaries f.vid + with Not_found -> + emptySummary,0 + in + (* If there are BLOCKING or NOBLOCKING annotations, those take precedence *) + let summary = handleBlockingAnnotations summary + ~curstate:s.interruptState ~caller:(!curFunc).svar ~call in + (* E.log "Calling %s, summary is %a\n" f.vname d_blockingState summary; *) + match summary.precondition with + | None -> s + | Some (chain, wt) -> begin + let chain' = call::chain, wt in + + match s.interruptState with + | Top + | Disabled -> + (* This is an error! + Report only one error per line *) + begin + let where = (!currentLoc, !curFunc, s.interruptState) in + try + let old = H.find blockingErrors where in + H.replace blockingErrors where (shorter old chain') + with Not_found -> + (* First error on this line *) + H.add blockingErrors where chain' + end; + s + | Enabled | UnchangedEnabled -> + s + | IrqRestore -> + E.s (unimp + "Calling a blocking function from an IRQ_RESTORE function") + | Unchanged -> + (* since call has a precondition that interrupts be enabled, + the current function now does as well. *) + if s.precondition = None then + raise (AddPrecondition chain') + else + (* The precondition already existed; choose the shorter reason. *) + { s with precondition = betterMayBlock s.precondition (Some chain') } + end + +(* call this after callFunctionHandleMayBlock *) +let callFunctionSetNewIntState s call : blockingState = + let (callee:varinfo),_,_,_ = call in + let summary,_ = + try + IH.find functionSummaries callee.vid + with Not_found -> + emptySummary,0 + in + if summary.interruptState = Unchanged then + s + else if summary.interruptState =? s.interruptState then + s + else if summary.interruptState = UnchangedEnabled then + assertInterruptsEnabled callee.vname s + else if (hasAttribute "noblocking" callee.vattr) then + s (* We trust this function. *) + else begin + if summary.interruptState = Top then + log "setting interrupt state = Top because of call to %s\n" callee.vname; + {s with interruptState = summary.interruptState} + end + +(******* Flow functions **********) + +(* State at each statement *) +let stateMap : blockingState IH.t = IH.create 50 + + +let doInstr (i:instr) (old: blockingState) : blockingState = + match i with + | Asm(_,["sti" | "sti; hlt"],_,_,_,_) -> + enableInterrupts old + | Asm(_,["cli"],_,_,_,_) -> + disableInterrupts old + + | Asm(_,["pushfl ; popl %0"],[None,_,lv],_,_,_) -> + saveInterrupts old lv + | Asm(_,["pushfl ; popl %0 ; cli"],[None,_,lv],_,_,_) -> + let s = saveInterrupts old lv in + disableInterrupts s + | Asm(_,["pushl %0 ; popfl"],_,[None,_,Lval lv],_,_) -> + restoreInterrupts old lv + | Asm(_,["pushfl ; popl %0"|"pushfl ; popl %0 ; cli"|"pushl %0 ; popfl"], + _,_,_,_) -> + E.s (error "Bad arguments to assembly %a" d_instr i) + + | Asm(_,_,_,_,_,_) -> +(* E.log "%a: Unknown assembly %a\n" d_loc !currentLoc d_instr i; *) + old + + (* This call only returns if interrupts are enabled *) + | Call(_,Lval(Var vf, NoOffset),_,_) when vf.vname = assertIntsEnabledFun -> + assertInterruptsEnabled vf.vname old + + | Call(reto,Lval(Var vf, NoOffset),args,_) when + (hasAttribute "irq_restore" vf.vattr) + || (hasAttribute "irq_save" vf.vattr) -> + (* Maybe this function has an irq_save/irq_restore annotation on it. + FIXME: if so, we consider only the annotation and ignore the summary*) + if hasAttribute "irq_restore" vf.vattr then begin + match filterAttributes "irq_restore" vf.vattr with + | [Attr("irq_restore", [what])] -> + if hasAttribute "irq_save" vf.vattr then + E.s (unimp "irq_save and irq_restore on the same function"); + let what' = compileFunctionAttribute vf.vtype args ~reto what in + restoreInterrupts old what' + | _ -> E.s (error "bad irq_restore attribute on function") + end + else begin + match filterAttributes "irq_save" vf.vattr with + | [Attr("irq_save", [what])] -> + let lv = compileFunctionAttribute vf.vtype args ~reto what in + saveInterrupts old lv + | _ -> E.s (error "bad irq_save attribute on function") + end + + | Call(_,f,args,loc) -> + (* For an indirect call, we may get many possible calls. + Handle them in parallel: first, check the precondition summaries, + then check the interruptState summaries. *) + let calls = getCalls f args loc in + let s' = + List.fold_left callFunctionHandleMayBlock + old + calls + in + let s'' = List.fold_left callFunctionSetNewIntState + s' + calls + in + s'' + + | Set _ -> + old + +let joinInterruptBit olds news where: interruptBit = + if olds =? news then olds + else match olds, news with +(* Unchanged, Enabled *) +(* | Enabled, Unchanged -> *) +(* if old.precondition <> None || newa.precondition <> None then *) +(* E.s (bug "Has precondition = enabled, but has state = Unchanged."); *) +(* (\* record this as a precondition and restart the function. *\) *) +(* Dutil.warn "Blocking analysis: join of %a and %a means that %s has the precondition that interrupts are enabled." *) +(* d_bit old.interruptState d_bit newa.interruptState *) +(* (!curFunc).svar.vname; *) +(* raise (AddPrecondition ([], JoinWithEnabled !currentLoc)) *) + | Unchanged, UnchangedEnabled + | UnchangedEnabled, Unchanged -> + (* Along one path, we asserted that interrupts were enabled. *) + Unchanged + | Enabled, UnchangedEnabled + | UnchangedEnabled, Enabled -> + Enabled + | Enabled, Unchanged + | Unchanged, Enabled -> + (* Hack to reduce the number of false positives. + Assume that the join of Unchanged and Enabled is Unchanged. + This is sound, since at most we will underestimate + the locations at which interrupts are enabled. + If we ever wanted to do e.g. a locking analysis, we'd have + to remove this case *) + Unchanged + | _ -> begin + if olds = Top || news = Top then + (* Don't bother warning; we've already complained that the state + is Top *) + () + else + Dutil.warn + "inconsistent interrupt state%a: %a vs %a" + insert where d_bit olds d_bit news; + Top + end + +let joinStates ~old ~newa : blockingState option = + if newa =? old then None + else begin + let interruptState = + joinInterruptBit old.interruptState newa.interruptState nil + in + let savedFlags = + if newa.savedFlags =? old.savedFlags then + old.savedFlags + else begin + (* FIXME: reenable this notice *) + (* Dutil.log "Blocking analysis: possible inconsistent saving of flags."; *) + (* return the intersection of the lists *) + List.fold_left + (fun acc save -> + if List.mem save old.savedFlags then save::acc else acc) + [] + newa.savedFlags + end + in + let precondition = (* if preconditionEnabled then Some [] else *) + (* It's okay for the precondition values to differ *) + betterMayBlock old.precondition newa.precondition + in + (* if we were already at top and precondition hasn't changed, no need to keep + exploring. We've already warned about any problems. *) + if (old.interruptState = interruptState) && old.precondition =? precondition then + None + else + Some { interruptState = interruptState; + precondition = precondition; + savedFlags = savedFlags } + end + +let recordSummary (state: blockingState) : unit = + (* Don't put IrqRestore in summaries *) + let interruptSummary = + if state.interruptState = IrqRestore then Unchanged + else state.interruptState + in + match !curFuncSummary with + None -> + curFuncSummary := Some { interruptState = interruptSummary; + precondition = state.precondition; + savedFlags = []}; + | Some oldSummary -> + let interruptSummary = + joinInterruptBit oldSummary.interruptState interruptSummary + (text " at function return") + in + curFuncSummary := Some { interruptState = interruptSummary; + precondition = betterMayBlock + oldSummary.precondition + state.precondition; + savedFlags = []} + + +(* When an annotated function returns, ensure that it has done as the annotation + promised.*) +let checkReturn (state: blockingState) ~(reto:exp option) : unit = + if hasAttribute "irq_restore" (!curFunc).svar.vattr then begin + if state.interruptState <> IrqRestore then + E.s (error "irq_restore function does not restore the flags") + end; + begin + match filterAttributes "irq_save" (!curFunc).svar.vattr with + [] -> () + | [Attr("irq_save", [what])] -> + (* Assert state includes what->Unchanged, indicating the initial value + was saved in what. *) + let ctx = Dattrs.formalsContext !curFunc in + let ctx' = match reto with + Some e -> Dattrs.addBinding ctx "__ret" e + | None -> ctx + in + let what' = compileLvalAttribute ctx' what in + if not (List.mem (what', Unchanged) state.savedFlags) then + E.s (error "irq_save function does not save the flags correctly") + | _ -> E.s (error "bad irq_save attribute on function") + end + +module InterruptsFlow = struct + let name = "InterruptsEnabled" + let debug = ref false + type t = blockingState + let copy x = x + let stmtStartData : t IH.t = stateMap + let pretty = d_blockingState + let computeFirstPredecessor s a = a + + let combinePredecessors s ~(old:t) newa = + if !debug then + E.log " Joining %a and %a at %d.\n" + d_blockingState old d_blockingState newa s.sid; + joinStates ~old ~newa + + let doInstr a i = + DF.Done (doInstr a i) + + let doStmt s a = + (* on Return, merge all of the states (interruptState and precondition only) + into a summary *) + (match s.skind with + Return (reto,_) -> + checkReturn a ~reto; + recordSummary a + | _ -> ()); + DF.SDefault + + let doGuard e a = + DF.GDefault + + let filterStmt s = true +end +module FlowEngine = DF.ForwardsDataFlow (InterruptsFlow) + + +let initialInterruptState (fd:fundec) oldSummary: blockingState = + (* If this is an IRQ_RESTORE function, initialize the state to the + exp that should be restored *) + let savedFlags = + match filterAttributes "irq_restore" fd.svar.vattr with + | [] -> [] (* The common case *) + | [Attr("irq_restore", [what])] -> + if hasAttribute "irq_save" fd.svar.vattr then + E.s (unimp "irq_save and irq_restore on the same function"); + let what' = compileLvalAttribute (Dattrs.formalsContext fd) what in + (* When the function returns, we will check that the interrupt + state has been set to this magic "IrqRestore" value that is only + created here. *) + [what',IrqRestore] + | _ -> E.s (error "bad irq_restore attribute on function") + in + let interruptState = + if oldSummary.precondition = None then Unchanged + else Enabled + in + { interruptState = interruptState; + precondition = oldSummary.precondition; + savedFlags = savedFlags; + } + + +let doBlockingAnalysis (f:file) : unit = + Stats.time "Cfg.computeFileCFG" Cfg.computeFileCFG f; + + let worklist : fundec list ref = ref [] in + let addToWorklist (fn:fundec) : unit = + if not (List.memq fn !worklist) then + worklist := fn::!worklist + in + let inversecallgraph = buildInversecallgraph f in + + (* Returns true if the summary has changed. *) + let rec doOneFunc (fd:fundec) : bool = + let oldSummary, numPasses = + try + let state, numPrevPasses = IH.find functionSummaries fd.svar.vid in + state, numPrevPasses+1 + with Not_found -> + (* If a function is not in the table, we use "emptySummary" as its + summary. So compare the analysis results to emptySummary. + If they are equivalent, we don't need to reanalyze functions that + call this one. *) + emptySummary, 1 + in + E.log "Starting %s. Pass %d\n" fd.svar.vname numPasses; + try begin + IH.clear stateMap; + curFunc := fd; + curFuncSummary := None; + if (isLeaf fd.svar) && (numPasses >= 2) then + E.s (bug "recomputing the summary for a leaf function."); + let fst = List.hd fd.sbody.bstmts in + IH.add stateMap fst.sid (initialInterruptState fd oldSummary); + (* InterruptsFlow.debug := (fd.svar.vname = "ide_spin_wait_hwgroup"); *) + Stats.time "DF.ForwardsDataFlow" FlowEngine.compute [fst]; + IH.clear stateMap; + let cfs = !curFuncSummary in + curFunc := dummyFunDec; + curFuncSummary := None; + + (* Now look at the new summary *) + match cfs with + | None -> + if not (hasAttribute "noreturn" fd.svar.vattr) then + warn "Function has no reachable return statement. Should it be labeled noreturn?"; + false + | Some newSummary -> + E.log " Done with %s. Summary: %a\n" + fd.svar.vname d_blockingState newSummary; + + (* Save the new summary. Even if there is no official change, + there may be a shorter precondition error. *) + IH.replace functionSummaries fd.svar.vid (newSummary,numPasses); + (* Has the summary changed? *) + let oldmayblock = oldSummary.precondition <> None in + let newmayblock = newSummary.precondition <> None in + (* It's possible that we may change from a summary that blocks + to one that doesn't, because of the discovery that it calls + a function that enables interrupts before calling the blocking + function. *) +(* if oldmayblock && not newmayblock then *) +(* E.s (bug "analysis is broken"); *) + (oldSummary.interruptState <> newSummary.interruptState) + || (oldmayblock <> newmayblock) + end + with + | Failure "hd" -> + false + | AddPrecondition pre -> + (* Add a precondition to a function summary that doesn't already + have one. *) + if oldSummary.precondition <> None then + E.s (bug "loop in AddPrecondition."); + let newSummary = {emptySummary with precondition = Some pre} in + IH.replace functionSummaries fd.svar.vid (newSummary,numPasses); + (* Start over with the new precondition. *) + ignore (doOneFunc fd); + true (* This summary has changed even if the second call to doOneFunc + has no changes. *) + in + + (* Step 1: add everything to the worklist *) + let leafFunctions: fundec list ref = ref [] in + iterGlobals f + (function GFun(fn, _) -> + if isLeaf fn.svar then + leafFunctions := fn::!leafFunctions + else + addToWorklist fn + | _ -> () ); + (* Put leaf functions first in the worklist so we can + make fewer passes over non-leaf functions. + Also, reverse the worklist in the hopes that callers are usually placed + after callees. + Note: this isn't really needed now that we have the defer list below, + but it can't hurt. + *) + worklist := Util.list_append !leafFunctions (List.rev !worklist); + if (!worklist = []) then + E.s (error "No functions to do the blocking analysis on."); + + (* Step 2: iterate *) + + (* At first, we only analyze a function if everything it calls + (except itself) has already been analyzed. *) + let shouldDefer fd : bool = + let dependencies = callgraphLookup fd.svar in + not (List.for_all + (fun (vf,_,_,_) -> vf == fd.svar || IH.mem functionSummaries vf.vid) + dependencies) + in + let defer: fundec list ref = ref [] in + let doWorklist (okayToDefer:bool) : unit = + while !worklist <> [] do + let fd = List.hd !worklist in + worklist := List.tl !worklist; + if okayToDefer && (shouldDefer fd) then + defer := fd::!defer + else begin + let changed = Stats.time "Blocking.doOneFunc" doOneFunc fd in + if changed then begin + let callers = + try IH.find inversecallgraph fd.svar.vid + with Not_found -> [] + in + List.iter addToWorklist callers + end; + end + done + in + + (* Start with non-recursive and simply-recursive functions. + (doWorklist true) will empty the worklist, but it may move some functions + to defer. Keep moving functions from defer back to the worklist.*) + let rec loop (oldNumDeferred:int) = + E.log "Beginning a pass over the worklist. %d funcs in worklist.\n" + (List.length !worklist); + assert (!defer = [] && !worklist <> []); + doWorklist true; + assert (!worklist = []); + + (* Now take things in the deferred list, and move them back to th + worklist *) + let numDeferred = List.length !defer in + if numDeferred > oldNumDeferred then + E.s (bug "infinite loop."); + worklist := List.rev !defer; + defer := []; + + if numDeferred = 0 then + () (* all done *) + else if numDeferred = oldNumDeferred then begin + E.log "The iteration algorithm is stuck; now processing all functions\n"; + (* We're stuck. There must be mutually recursive functions in + the graph *) + doWorklist false (* No more procrastinating ... do every function now *) + end + else begin + (* We're making progress, but we're not there yet. Keep going. *) + loop numDeferred + end + in + loop max_int; + + (* Step 3: report errors *) + let reportOneError (loc,fd,st) (reason:mustEnable) : unit = + currentLoc := loc; + let callChain, wt = reason in + Dutil.error "Blocking error: when the interrupt state is %a, %s calls a function that requires them to be enabled. Call trace:\n %a\n %a\n" + d_bit st + fd.svar.vname + (docList ~sep:(text "\n ") (d_call ())) callChain + d_whyType wt + ; + () + in + H.iter reportOneError blockingErrors; + E.log "\nDone with the blocking analysis\n"; + flush !E.logChannel; + + Cfg.clearFileCFG f; + () + + + +(**************************************************************************** + ** Part omega: Cleanup and entrypoint ** + ****************************************************************************) + +let cleanup (): unit = + IH.clear callgraph; + IH.clear funcsOfNode; + IH.clear functionSummaries; + H.clear blockingErrors; + IH.clear stateMap; + () + + + +let blockingAnalysis (f:file) : unit = + Stats.time "Compute the call graph" buildCallGraph f; +(* Stats.time "Gc.full_major" Gc.full_major (); *) +(* Gc.print_stat !E.logChannel; *) +(* Ptrnode.initialize (); (\* Clear the state to free memory. *\) *) +(* Stats.time "Gc.full_major" Gc.full_major (); *) +(* Gc.print_stat !E.logChannel; *) +(* flush !E.logChannel; *) + Stats.time "Infer blocking functions" doBlockingAnalysis f; + cleanup (); + () + diff --git a/src/infer/inferkinds.ml b/src/infer/inferkinds.ml new file mode 100644 index 0000000..6988600 --- /dev/null +++ b/src/infer/inferkinds.ml @@ -0,0 +1,230 @@ +(* + * + * Copyright (c) 2001-2006, + * Matt Harren + * 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 Dutil +open Dattrs + +module E = Errormsg +module IH = Inthash +module H = Hashtbl + +module N = Ptrnode + +(* similar to examineType, but for listGlobalAnnotations instead of + printGlobalAnnotations. *) +let rec examineNode (where: string) (t:typ): unit = + let reportNodeDoc (what:doc): unit = + warn "Type \"%a\" in %s %a" dx_type t where insert what + in + let reportNode (what:string): unit = + reportNodeDoc (text what) + in + match unrollType t with + TVoid _ + | TBuiltin_va_list _ + | TInt _ + | TFloat _ + | TEnum _ -> () + + | TPtr (bt, a) + | TArray (bt, _, a) when hasAttribute "trusted" a -> + () + + | TPtr (bt, a) -> + examineNode where bt; + let k, _ = N.inferredKindOf a in + let needsBounds = + N.kindNeedsBounds k && + not (hasAttribute "bounds" a) && + not (hasAttribute "size" a) + in + let needsNT = + N.kindIsNullterm k && + not (hasAttribute "nullterm" a) + in + begin + match needsBounds, needsNT with + | _, true -> reportNode "should be annotated NT." + | true, false -> reportNode "needs a bound annotation." + | false, false -> () + end + | TArray (bt, lo, a) -> + examineNode where bt; + let k, _ = N.inferredKindOf a in + if N.kindIsNullterm k && not (hasAttribute "nullterm" a) then + reportNode "should be annotated NT."; + if isOpenArray t && not (hasAttribute "bounds" a) then begin + reportNode "contains an open array." + end + | TFun (rt, args, isva, a) -> + examineNode "" rt; + List.iter (fun (n, t, _) -> + examineNode ("") t) + (argsToList args) + | TComp _ -> () (* We visit these separately. *) + | TNamed _ -> E.s (bug "unrollType") + + +let reportNeededAnnotations (f: file) : unit = + let oldPCI = !print_CIL_Input in + print_CIL_Input := true; + + let totKind : (N.opointerkind, int ref) H.t = H.create 17 in + let totalNodes : int ref = ref 0 in + (* Collect stats on the kinds of every local or cast that might + need inferred bounds *) + let visitLocalOrCast (t:typ): unit = + match unrollType t with + TPtr(_,a) -> + incr totalNodes; + let k,_ = N.inferredKindOf a in + N.addToHisto totKind 1 k + | _ -> () + in + let visitAllCasts (fd: fundec) : unit = + let castVisitor = object (self) + inherit nopCilVisitor + method vexpr e = + (match e with + CastE(t, _) -> visitLocalOrCast t + | _ -> ()); + DoChildren + end + in + ignore(visitCilBlock castVisitor fd.sbody) + in + + (* Maintain a map from globals to the location of their first declaration. + If a var has no location (probably because it's Poly), use the + location of it's declaration. *) + let declarations: location IH.t = IH.create 50 in + let setLoc vi: unit = + if !currentLoc == locUnknown then begin + if IH.mem declarations vi.vid then + currentLoc := IH.find declarations vi.vid + end else + if not (IH.mem declarations vi.vid) then + IH.add declarations vi.vid !currentLoc + in + let globalsVisited: unit IH.t = IH.create 50 in + let doGlobal g: unit = + match g with + GVarDecl (vi, l) + when Dattrs.isTrustedType vi.vtype + || Dattrs.isSpecialFunction vi.vtype -> + () + | GVarDecl (vi, l) when isFunctionType vi.vtype + && not (IH.mem globalsVisited vi.vid) -> + currentLoc := l; + setLoc vi; + let rt, formals, _, _ = splitFunctionType vi.vtype in + examineNode ("the return value of "^vi.vname) rt; + List.iter (fun (n,t,_) -> + examineNode ("formal \""^n^"\" of "^vi.vname) t) + (argsToList formals); + IH.add globalsVisited vi.vid () + + | GFun (fdec, l) + when Dattrs.isTrustedType fdec.svar.vtype + || Dattrs.isSpecialFunction fdec.svar.vtype -> + () + | GFun (fdec, l) -> + currentLoc := l; + setLoc fdec.svar; + if not (IH.mem globalsVisited fdec.svar.vid) then begin + (* Examine the prototype, since we haven't already seen a + declaration of this func: *) + IH.add globalsVisited fdec.svar.vid (); + let rt, formals, _, _ = splitFunctionType fdec.svar.vtype in + examineNode ("the return value of "^fdec.svar.vname) rt; + List.iter (fun vi -> examineNode + ("formal \""^vi.vname^"\" of "^fdec.svar.vname) + vi.vtype) + fdec.sformals; + end; + (* Regardless of whether we've seen an earlier declaration, examine + locals and casts. *) + (* Locals are mostly covered by inference. But base types of + pointers may need annotating. *) + List.iter (fun vi -> + match unrollType vi.vtype with + TPtr (bt, a) as t-> + visitLocalOrCast t; + examineNode ("local \""^vi.vname^"\"") bt + | TArray (bt, _, a) -> + visitLocalOrCast bt; + examineNode ("local \""^vi.vname^"\"") bt + | _ -> ()) + fdec.slocals; + visitAllCasts fdec + + | GVarDecl (vi, l) + | GVar (vi, _, l) when not (IH.mem globalsVisited vi.vid) -> + currentLoc := l; + setLoc vi; + IH.add globalsVisited vi.vid (); + examineNode ("global \""^vi.vname^"\"") vi.vtype + | GCompTag (ci, l) -> + currentLoc := l; + List.iter + (fun fi -> examineNode ("field \""^fi.fname^"\"") fi.ftype) + ci.cfields + | _ -> () + in + iterGlobals f doGlobal; + print_CIL_Input := oldPCI; + () + +(* The entry point from Deputy. Calls Markptr, Solver *) +let inferKinds (f: file) : file = + if f.globinit <> None then + (* CCured has special handling of globinit, but we can't use that + strategy because main may not be in this file. *) + ignore (E.warn "Inference: skipping global initializers.\n"); + + let marked = Stats.time "markptr" Markptr.markFile f in + + begin + try + Stats.time "solver" (Solver.solve marked) Ptrnode.idNode + with _ -> + () + end; + + reportNeededAnnotations marked; + + marked diff --git a/src/infer/inferkinds.mli b/src/infer/inferkinds.mli new file mode 100644 index 0000000..e1186e4 --- /dev/null +++ b/src/infer/inferkinds.mli @@ -0,0 +1,3 @@ + +(* The entry point from Deputy. Calls Markptr, Solver *) +val inferKinds: Cil.file -> Cil.file diff --git a/src/infer/markptr.ml b/src/infer/markptr.ml new file mode 100644 index 0000000..8a70149 --- /dev/null +++ b/src/infer/markptr.ml @@ -0,0 +1,947 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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 H = Hashtbl +module IH = Inthash +module E = Errormsg + +module N = Ptrnode + +(* We will accumulate the marked globals in here *) +let theFile: global list ref = ref [] + +let lu = locUnknown +let verbose = Doptions.verbose + +let currentFile = ref dummyFile +let currentFunction: fundec ref = ref dummyFunDec +let currentResultType = ref voidType + +let noStackOverflowChecks = ref false + +(* Remember the structures we have marked already. This way we detect forward + * references *) +let markedCompInfos: unit IH.t = IH.create 17 + +(* Remember the nodes for which the PointsTo information is unreliable + * because they point to forward-declared structures *) +let mustRecomputePointsTo: N.node IH.t = IH.create 17 + +let callId = ref (-1) (* Each call site gets a new ID *) + +let allocFunctions: (string, unit) H.t = H.create 17 + +(* weimer: utility function to ease the transition between our flag formats *) +let setPosArith n why = N.setFlag n N.pkPosArith why +let setArith n why = N.setFlag n N.pkArith why +let setUpdated n why = N.setFlag n N.pkUpdated why +let setIntCast n why = N.setFlag n N.pkIntCast why +let setInterface n why = N.setFlag n N.pkInterface why +let setNoProto n why = N.setFlag n N.pkNoPrototype why +let setString n why = N.setFlag n N.pkString why +let setReferenced n why = N.setFlag n N.pkReferenced why +let setEscape n why = N.setFlag n N.pkEscape why +let setStack n why = N.setFlag n N.pkStack why +let default_why () = N.ProgramSyntax(!currentLoc) + +(* We keep track of a number of type that we should not unroll *) +let dontUnrollTypes : (string, bool) H.t = H.create 19 + +let rec mustUnrollTypeInfo (ti: typeinfo) : bool = + (not (H.mem dontUnrollTypes ti.tname)) && + (match ti.ttype with + | TPtr _ -> true + | TArray _ -> true + | TFun _ -> true + | TNamed (ti', _) -> mustUnrollTypeInfo ti' + | _ -> false) + + +(* if some enclosing context [like the attributes for a field] says that + * this array should be sized ... we do not want to forget it! *) +let addArraySizedAttribute arrayType enclosingAttr = + if filterAttributes "sized" enclosingAttr <> [] then + typeAddAttributes [Attr("sized",[])] arrayType + else + if hasAttribute "safeunion" enclosingAttr then + typeAddAttributes [Attr("safeunion",[])] arrayType + else + arrayType + +(* Grab the node from the attributs of a type. Returns dummyNode if no such + * node *) +let nodeOfType : typ -> N.node = + (fun t -> + match unrollType t with + TPtr(_, a) -> begin + match N.nodeOfAttrlist a with + Some n -> n + | None -> N.dummyNode + end + | _ -> N.dummyNode) + +(* Pass also the place and the next index within the place. Returns the + * modified type and the next ununsed index *) +let rec doType (t: typ) (p: N.place) + (nextidx: int) : typ * int = + match t with + (TVoid _ | TInt _ | TFloat _ | TEnum _ ) -> t, nextidx + | TBuiltin_va_list _ -> t,nextidx + | TPtr (bt, a) -> begin + match N.nodeOfAttrlist a with + Some n -> TPtr (bt, a), nextidx (* Already done *) + | None -> + let bt', i' = doType bt p (nextidx + 1) in + let n = N.getNode p nextidx bt' a in + (* See if the bt is a forward referenced TComp *) + (match unrollType bt with + TComp(ci, _) when not (IH.mem markedCompInfos ci.ckey) -> + IH.add mustRecomputePointsTo n.N.id n + + | _ -> ()); + TPtr (bt', n.N.attr), i' + end + | TArray (bt, len, a) -> begin + (* wes: we want a node for the array, just like we have a node for + * each pointer *) + match N.nodeOfAttrlist a with + Some n -> TArray (bt, len, a), nextidx (* Already done *) + | None -> + let bt', i' = doType bt p (nextidx + 1) in + let n = N.getNode p nextidx bt' a in + n.N.is_array <- true; + TArray (bt', len, n.N.attr), i' + end + + | TComp (c, at) -> + t, nextidx (* A reference to a regular composite type, leave alone *) + + (* Strip the type names so that we have less sharing of nodes. However, + * we do not need to do it if the named type is a structure, and we get + * nicer looking programs. We also don't do it for base types *) + | TNamed (bt, a) -> + if mustUnrollTypeInfo bt then begin + let t = typeAddAttributes a bt.ttype in + let t', nextidx' = doType t p nextidx in + t', nextidx' + end else + (* A type reference. Leave alone. We'll handle the type inside when + * we do the GType *) + t, nextidx + + | TFun (restyp, args, isva, a) -> + let noproto = hasAttribute "missingproto" a in + let restyp = + if noproto && not (isPointerType restyp) then + voidPtrType + else restyp + in + let restyp', i0 = doType restyp p nextidx in + let args', i' = match args with + None -> None, i0 + | Some argl -> + let argl', i' = + List.fold_left + (fun (args', nidx) (an, at, aa) -> + let t', i' = doType at p nidx in + ((an,t',aa) :: args', i')) ([], i0) argl + in + Some (List.rev argl'), i' + in + let newtp = TFun(restyp', args', isva, a) in + let newtp' = Dvararg.processFormatAttribute newtp in + newtp', i' + +and doField (f: fieldinfo) : N.node = + let fftype = addArraySizedAttribute f.ftype f.fattr in + let t', i' = doType fftype (N.PField f) 1 in + (* Now create the node corresponding to the address of the field *) + let nd = N.newNode (N.PField f) 0 t' f.fattr in + f.fattr <- addAttributes f.fattr nd.N.attr ; + f.ftype <- t'; + nd + + +(** This is called once for each compinfo DEFINITION. Do not call for + * declarations. It will process the fields and will add the nodes + * corresponding to the address of the fields. *) +and markCompInfo (comp: compinfo) (comptagloc: location) : unit = + (* We must do its fields *) + List.iter (fun f -> ignore (doField f)) comp.cfields; + (* Keep track of the compinfo we have done. We do this after we have done + * the fields, just in case some of the fields refer to the whole structure. + *) + IH.add markedCompInfos comp.ckey () + +(* Create a field successor. Just get the node from the field attributes. + * Also add an EOFFSET edge from the pointer to struct to pointer to field. *) +let fieldOfNode (n: N.node) (fi: fieldinfo) : N.node = + if N.useOffsetNodes then begin + (* Make a new node *) + let fieldn = N.getNode (N.POffset (n.N.id, fi.fname)) 0 fi.ftype [] in + (* And add the ESafe edge *) + let _ = N.addEdge n fieldn N.EOffset (Some !currentLoc) in + fieldn + end else begin + (* In the original scheme we have one node for the address of a field. + * The problem with this is that it is shared to much and contributes to + * the spreading of WILDness *) + match N.nodeOfAttrlist fi.fattr with + Some fieldn -> + (* Add an EOffset edge from n to fieldn *) + let _ = N.addEdge n fieldn N.EOffset (Some !currentLoc) in + fieldn + + | None -> + (* We should have created nodes for all fieldinfo *) + E.s (bug "Field %s.%s does not have a node" + (compFullName fi.fcomp) fi.fname) + end + +let startOfNode (n: N.node) : N.node = + match unrollType n.N.btype with + TArray (bt, len, a) -> + let next = + match N.nodeOfAttrlist a with + Some oldn -> oldn + | _ -> E.s (bug "Array type does not have a node") + in + let _ = N.addEdge n next N.EIndex (Some !currentLoc) in + next + + | _ -> n (* It is a function *) + + + +(* Compute the sign of an expression. Extend this to a real constant folding + * + the sign rule *) +type sign = SPos | SNeg | SAny | SLiteral of int64 + +let rec signOf = function + Const(CInt64(n, _, _)) -> SLiteral n + | Const(CChr c) -> signOf (Const (charConstToInt c)) + | SizeOf _ -> SPos (* We do not compute it now *) + | UnOp (Neg, e, _) -> begin + match signOf e with + SPos -> SNeg + | SLiteral n -> SLiteral (Int64.neg n) + | SNeg -> SNeg + | _ -> SAny + end + | UnOp (LNot, e, _) -> SPos + | BinOp (PlusA, e1, e2, _) -> begin + match signOf e1, signOf e2 with + SPos, SPos -> SPos + | SLiteral n, SPos when n >= Int64.zero -> SPos + | SPos, SLiteral n when n >= Int64.zero -> SPos + | SLiteral n1, SLiteral n2 -> SLiteral (Int64.add n1 n2) + | SNeg, SNeg -> SNeg + | SLiteral n, SNeg when n <= Int64.zero -> SNeg + | SNeg, SLiteral n when n <= Int64.zero -> SNeg + | _ -> SAny + end + | BinOp (MinusA, e1, e2, _) -> begin + match signOf e1, signOf e2 with + SPos, SNeg -> SPos + | SLiteral n, SNeg when n >= Int64.zero -> SPos + | SPos, SLiteral n when n <= Int64.zero -> SPos + | SLiteral n1, SLiteral n2 -> SLiteral (Int64.sub n1 n2) + | SNeg, SPos -> SNeg + | SLiteral n, SPos when n <= Int64.zero -> SNeg + | SNeg, SLiteral n when n >= Int64.zero -> SNeg + | _ -> SAny + end + | _ -> SAny + + +(* Handle Deputy's allocator annotation. *) +let doAlloc (vi : varinfo) : unit = + let attrs = typeAttrs vi.vtype in + if hasAttribute "dalloc" attrs || hasAttribute "drealloc" attrs then + H.add allocFunctions vi.vname () + +(* Handle Deputy's memcpy, memset, and memcmp annotations. We need to add + * appropriate kinds for these for the inference to work properly. *) +let doMemcpy (varAttrs : attributes) (varType : typ) : unit = + match unrollType varType with + | TFun (_, Some args, _, attrs) -> + if hasAttribute "dmemcpy" attrs || + hasAttribute "dmemcmp" attrs || + hasAttribute "dmemset" attrs then + List.iter + (fun (_, argType, _) -> + match N.nodeOfAttrlist (typeAttrs argType) with + | Some n -> + n.N.kind <- N.FSeq; + n.N.why_kind <- N.UserSpec + | None -> ()) + args + | _ -> () + +(* Do varinfo. We do the type and for all variables we also generate a node + * that will be used when we take the address of the variable (or if the + * variable contains an array) *) +let doVarinfo (vi: varinfo) : unit = + (* Compute a place for it *) + let original_location = !currentLoc in (* weimer: better places *) + if vi.vdecl != locUnknown then + currentLoc := vi.vdecl; + let place = + if vi.vglob then + if vi.vstorage = Static then + N.PStatic (!currentFile.fileName, vi.vname) + else + N.PGlob vi.vname + else + N.PLocal (!currentFile.fileName, !currentFunction.svar.vname, vi.vname) + in + let vi_vtype = addArraySizedAttribute vi.vtype vi.vattr in + (* Do the type of the variable. Start the index at 1 *) + let t', _ = doType vi_vtype place 1 in + vi.vtype <- t'; + (* Associate a node with the variable itself. Use index = 0 *) + let n = N.getNode place 0 vi.vtype vi.vattr in + + (* Add this to the variable attributes. Note that this node might have been + * created earlier. Merge the attributes and make sure we get the _ptrnode + * attribute *) + vi.vattr <- addAttributes vi.vattr n.N.attr; + + (* Add appropriate kinds for arguments of memcpy and friends. *) + doAlloc vi; + doMemcpy vi.vattr vi.vtype; + + currentLoc := original_location + +(* Do an expression. Return an expression, a type and a node. The node is + * only meaningful if the type is a TPtr _. In that case the node is also + * refered to from the attributes of TPtr. Otherwise the node is N.dummyNode *) +let rec doExp ?(inSizeof:bool = false) (e: exp): exp * typ * N.node = + let markAddrOfLocal lv lvn : unit = + (* when taking the address of an lvalue, check whether we're taking the + address of a local var. *) + let locals = (!currentFunction).slocals in + let formals = (!currentFunction).sformals in + (match lv with + Var vi, _ when List.mem vi locals || List.mem vi formals -> + (* Taking the address of a local variable*) + setStack lvn (default_why ()) + | _ -> ()) + in + match e with + Lval lv -> + let lv', lvn = doLvalue lv false in + (* We are reading from it, so mark it as referenced *) + setReferenced lvn (default_why ()); + Lval lv', lvn.N.btype, nodeOfType lvn.N.btype + + | AddrOf lv -> + let lv', lvn = doLvalue lv false in + markAddrOfLocal lv lvn; + AddrOf lv', TPtr(lvn.N.btype, lvn.N.attr), lvn + + | StartOf lv -> + let lv', lvn = doLvalue lv false in + let next = startOfNode lvn in + markAddrOfLocal lv next; + StartOf lv', TPtr(next.N.btype, next.N.attr), next + + | UnOp (uo, e, tres) -> (* tres is an arithmetic type *) + UnOp(uo, doExpAndCast e tres, tres), tres, N.dummyNode + + | SizeOf (t) -> + let t', _ = doType t (N.anonPlace()) 1 in + SizeOf (t'), !typeOfSizeOf, N.dummyNode + + | SizeOfE (e) -> + let e', et', en' = doExp ~inSizeof:true e in + SizeOfE(e'), !typeOfSizeOf , N.dummyNode + + | SizeOfStr (s) -> + e, !typeOfSizeOf, N.dummyNode + + | AlignOf (t) -> + let t', _ = doType t (N.anonPlace()) 1 in + AlignOf (t'), !typeOfSizeOf, N.dummyNode + + | AlignOfE (e) -> + let e', et', en' = doExp ~inSizeof:true e in + AlignOfE(e'), !typeOfSizeOf , N.dummyNode + + (* pointer subtraction. do the subexpressions *) + | BinOp (MinusPP, e1, e2, tres) -> + let e1', _, _ = doExp e1 in + let e2', _, _ = doExp e2 in + BinOp(MinusPP, e1', e2', tres), tres, N.dummyNode + + (* non-pointer arithmetic *) + | BinOp (((PlusA|MinusA|Mult|Div|Mod|Shiftlt|Shiftrt| + Lt|Gt|Le|Ge|Eq|Ne|BAnd|BXor|BOr|LAnd|LOr) as bop), + e1, e2, tres) -> + BinOp(bop, doExpAndCast e1 tres, + doExpAndCast e2 tres, tres), tres, N.dummyNode + + (* pointer arithmetic *) + | BinOp (((PlusPI|MinusPI|IndexPI) as bop), e1, e2, tres) -> + let e1', e1t, e1n = doExp e1 in + let sign = + signOf + (match bop with PlusPI|IndexPI -> e2 | _ -> UnOp(Neg, e2, intType)) + in + (match sign with + SLiteral z -> + if z < Int64.zero then setArith e1n (default_why ()) else + if z > Int64.zero then setPosArith e1n (default_why ()) else + () + + | SPos -> setPosArith e1n (default_why ()) + + | _ -> + if bop = IndexPI then (* Was created from p[e] *) + setPosArith e1n (default_why ()) + else + setArith e1n (default_why ()) ); + if sign = SLiteral Int64.zero then + e1', e1t, e1n + else + BinOp (bop, e1', doExpAndCast e2 intType, e1t), e1t, e1n + + + | CastE (newt, e) -> + let newt', _ = doType newt (N.anonPlace ()) 1 in + let e' = + if Dattrs.isTrustedType newt then begin + (* Trusted Cast. Do not insert an edge. *) + let e', _, _ = doExp e in + e' + end else if Dattrs.isNulltermDrop newt then begin + (* An NTDROP. Don't propagate pkString across the edge. *) + doExpAndCast ~castKind:N.EEK_stringdrop e newt' + end else + (* Ordinary cast *) + doExpAndCast e newt' + in + CastE (newt', e'), newt', nodeOfType newt' + + | Const (CStr s) as e -> + let n = N.getNode N.PStr 1 charType Dattrs.stringAttrs in + (e, typeOf e, n) + | Const (CWStr s) as e -> + let n = N.getNode N.PWStr 1 !wcharType Dattrs.stringAttrs in + (e, typeOf e, n) + + | Const _ -> (e, typeOf e, N.dummyNode) + + + +(* Do initializers. *) +and doInit (vi: varinfo) (i: init) (l: location) : init * typ = + + (* Baseoff is the offset to the current compound *) + let rec doOne (baseoff: offset) off (what: init) : init * typ = + let off' = addOffset off baseoff in + match what with + | SingleInit ei -> begin + (* Fake an assignment *) + let lv', ei' = doSet (Var vi, off') ei l in + SingleInit ei', typeOfLval lv' + end + | CompoundInit (t, initl) -> + let t', _ = doType t (N.anonPlace ()) 1 in + let initl' = + foldLeftCompound + ~implicit:false + ~doinit:(fun newoff what t acc -> + let what', _ = doOne off' newoff what in + (newoff, what') :: acc) + ~ct:t' ~initl:initl ~acc:[] in + CompoundInit (t', List.rev initl'), t' + + in + doOne NoOffset NoOffset i + + +and doSet (lv: lval) (e: exp) (l: location) : lval * exp = + let lv', lvn = doLvalue lv true in + (* We are writing to it, so mark it as referenced *) + setReferenced lvn (N.ProgramSyntax(l)) ; + let e' = doExpAndCast e lvn.N.btype in + (* sg: If assigning thru a pointer or to a global, mark adresses in e' + * as pkEscape. The former is a conservative approximation since + * depending on where lv can point, the value may probably not escape *) + (match lv' with + Mem _, _ -> expMarkEscape e' (* thru a pointer *) + | Var vi, _ -> + if vi.vglob then expMarkEscape e' else () ); (* to a global *) + lv', e' + +and expMarkEscape (e: exp) : unit = + match e with + + Lval lv -> + let lvnode = nodeOfType (typeOfLval lv) in + setEscape lvnode (default_why ()) + + | StartOf lv -> + let lvnode = (* like typeOf, but keeps attrs of arrays *) + match unrollType (typeOfLval lv) with + TArray (t,_,al) -> nodeOfType (TPtr(t, al)) + | _ -> E.s (E.bug "expMarkEscape: StartOf on a non-array") + in + setEscape lvnode(default_why ()) + + | AddrOf lv -> + let _, alvnode = doLvalue lv false (* gets node for &lv *) + in setEscape alvnode(default_why ()) + + | CastE(_, e1) -> expMarkEscape e1 + | UnOp((Neg|BNot), e1, _) -> expMarkEscape e1 + + | BinOp( (Lt|Gt|Le|Ge|Eq|Ne(*|LtP|GtP|LeP|GeP|EqP|NeP*)), _, _, _) -> () + | BinOp(_, e1, e2, _) -> expMarkEscape e1; expMarkEscape e2 + | _ -> () + + +(* Do an lvalue. We assume conservatively that this is for the purpose of + * taking its address. Return a modifed lvalue and a node that stands for & + * lval. Just ignore the node and get its base type if you do not want to + * take the address of. *) +and doLvalue ((base, off) : lval) (iswrite: bool) : lval * N.node = + let base', startNode = + match base with + Var vi -> begin + let vn = + match N.nodeOfAttrlist vi.vattr with + Some n -> n + | _ -> N.dummyNode + in + (* Now grab the node for it *) + base, vn + end + | Mem e -> + let e', et, ne = doExp e in + if iswrite then + setUpdated ne (default_why ()); + Mem e', ne + in + let newoff, newn = doOffset off startNode in + (base', newoff), newn + +(* Now do the offset. Base types are included in nodes. *) +and doOffset (off: offset) (n: N.node) : offset * N.node = + match off with + NoOffset -> off, n + + | Field(fi, resto) -> + let nextn = fieldOfNode n fi in + let newo, newn = doOffset resto nextn in + Field(fi, newo), newn + + | Index(e, resto) -> begin + let nextn = startOfNode n in + setPosArith nextn (default_why ()) ; + let newo, newn = doOffset resto nextn in + let e', et, _ = doExp e in + Index(e', newo), newn + end + + +(* Now model an assignment of a processed expression into a type *) +and expToType ?(castKind=N.EEK_cast) (e,et,en) t (callid: int) : exp = + let debugExpToType = false in + if not (Dattrs.isTrustedType et) && not (Dattrs.isTrustedType t) then begin + let destn = nodeOfType t in + if debugExpToType then + ignore (E.log "expToType e=%a (NS=%d) -> TD=%a (ND=%d)\n" + d_plainexp e en.N.id d_plaintype t destn.N.id); + match en == N.dummyNode, destn == N.dummyNode with + true, true -> e (* scalar -> scalar *) + | false, true -> e (* Ignore casts of pointer to non-pointer *) + | false, false -> (* pointer to pointer *) + if debugExpToType then + ignore (E.log "Setting %a : %a (%d -> %d)\n" + d_plainexp e d_plaintype et en.N.id destn.N.id); + ignore (N.addEdge en destn (N.ECast castKind) (Some !currentLoc)); + e + + | true, false -> (* scalar -> pointer *) + (* Check for zero *) + if isZero e then + () (* setNull destn *) + else begin + if isPointerType et then + E.s (Dutil.bug "Casting %a to pointer type %a, but it has no node." + Dattrs.dx_exp e Dattrs.dx_type t); + setIntCast destn (default_why ()) + end; + e + end else + e + + +and doExpAndCast ?(castKind: N.extra_edge_kind option) e t = + expToType ?castKind (doExp e) t (-1) + +and doExpAndCastCall e t callid = + expToType (doExp e) t callid + + + + + +(*****************************************************************) + + +let rec doBlock blk = + if not (hasAttribute "trusted" blk.battrs) then + List.iter doStmt blk.bstmts; + blk + +and doStmt (s: stmt) : unit = + match s.skind with + Goto _ | Break _ | Continue _ -> () + | Return (None, _) -> () + | Return (Some e, l) -> + currentLoc := l; + let e' = doExpAndCast e !currentResultType in + expMarkEscape e'; + s.skind <- Return (Some e', l) + | Instr il -> + s.skind <- Instr (mapNoCopyList doInstr il) + | Loop (b, l, lb1, lb2) -> + currentLoc := l; + s.skind <- Loop (doBlock b, l, lb1, lb2) + | Block b -> s.skind <- Block (doBlock b) + | If(e, b1, b2, l) -> + currentLoc := l; + s.skind <- If (doExpAndCast e intType, doBlock b1, doBlock b2, l) + | Switch (e, b, cases, l) -> + currentLoc := l; + s.skind <- Switch(doExpAndCast e intType, doBlock b, cases, l) + | TryFinally (b, h, l) -> + currentLoc := l; + s.skind <- TryFinally(doBlock b, doBlock h, l) + | TryExcept (b, (il, e), h, l) -> + currentLoc := l; + s.skind <- TryExcept(doBlock b, (mapNoCopyList doInstr il, + doExpAndCast e intType), + doBlock h, l) + +and doInstr (i:instr) : instr list = + match i with + | Asm (attrs, tmpls, outs, ins, clob, l) -> + currentLoc := l; + let outs' = + List.map + (fun (i,n, o) -> + let o', lvn = doLvalue o true in + setReferenced lvn (default_why ()); + (i,n, o')) + outs + in + let ins' = + List.map + (fun (i,n, e) -> + let e', _, _ = doExp e in + (i,n, e')) + ins + in + [Asm(attrs, tmpls, outs', ins', clob, l)] + + | Set (lv, e,l) -> + currentLoc := l; + let lv', e' = doSet lv e l in + [Set(lv', e',l)] + + | Call (reso, orig_func, args, l) -> begin + currentLoc := l; + Stats.time "doFunctionCall" (doFunctionCall reso orig_func args) l + end + +and doFunctionCall + (reso: lval option) + (func: exp) + (args: exp list) + (l: location) = + incr callId; (* A new call id *) + + (* Do the function itself *) + let func', pfuncn = + match func with + Lval lv -> + let lv', lvn = doLvalue lv false in + setReferenced lvn (default_why ()); + Lval lv', lvn + | _ -> E.s (Dutil.bug "Called function is not an lvalue") + in + let (rt, formals, isva, attrs) = + match unrollType (typeOf func') with + TFun(rt, formals, isva, attrs) -> + rt, argsToList formals, isva, attrs + | _ -> E.s (Dutil.bug "Call to a non-function") + in + let args' = + if isva then + (* This might add prototypes to theFile *) + Dvararg.prepareVarargArguments + (fun t -> + let vi = makeTempVar !currentFunction t in + doVarinfo vi; + vi) + func' (List.length formals) args + else + args + in + let freeArg = + match Dattrs.getZeroOneAttr ["dfree"; "drealloc"] attrs with + | Some (Attr ("dfree", [ACons (name, [])])) + | Some (Attr ("drealloc", [ACons (name, []); _])) -> Some name + | _ -> None + in + (* Now check the arguments *) + let rec loopArgs formals args = + match formals, args with + [], [] -> [] + | [], a :: args -> + (* We ran out of formals. This is either in a vararg functions or + * else this is bad, so we make sure to mark that the argument is + * used in a function without prototypes *) + (* Do the arguments because they might contain pointer types *) + let a', _, an = doExp a in + if an != N.dummyNode && not isva then + Dutil.warn "Calling function %a with too many args." + d_exp func; + a' :: loopArgs [] args + + | (fn, ft, _) :: formals, a :: args -> + let a' = + if Some fn <> freeArg then + doExpAndCastCall a ft !callId + else + let a', _, _ = doExp a in a' + in + a' :: loopArgs formals args + + | _ :: _, [] -> + E.s (Dutil.error "Calling function %a with too few args." + d_exp func) + in + (* Now scan the arguments again and add EArgs edges *) + let args'' = loopArgs formals args' in + List.iter (fun a' -> + let a'n = nodeOfType (typeOf a') in + if a'n != N.dummyNode then + ignore (N.addEdge pfuncn a'n N.EArgs (Some l))) args''; + + let reso' = + (* Now check the return value *) + match reso, unrollType rt with + None, TVoid _ -> None + | Some _, TVoid _ -> + ignore (warn "void value is assigned."); + None + + | None, _ -> None (* "Call of function is not assigned" *) + | Some dest, _ -> begin + (* Do the lvalue, just so that the type is done *) + let dest', destn = doLvalue dest true in + (* We are using the pointer, so mark it referenced. *) + setReferenced destn (default_why ()); + (* Add the cast from the return type to the destination of the call. + * Make up a phony expression and a node so that we can call + * expToType. *) + let dest't = typeOfLval dest' in + (* Also add an EArgs edge *) + let dest'n = nodeOfType dest't in + if dest'n != N.dummyNode then + ignore (N.addEdge pfuncn dest'n N.EArgs (Some l)); + (* For allocation functions do not connect the returned value to the + * result because the returned value is an integer *) + (match func' with + Lval(Var f, NoOffset) when H.mem allocFunctions f.vname -> () + | _ -> + ignore (expToType (CastE(rt, mkString ("")), + rt, nodeOfType rt) dest't + !callId)); + Some dest' + end + in + [Call(reso', func', args'', l)] + + +let doFormals (fdec: fundec) = + currentFunction := fdec; + (* Go through the formals and copy their type and attributes from + * the type of the function. Then add the nodes for the address of the + * formals. Then restore the sharing with the function type. *) + let rt, targs, isva, fa = splitFunctionTypeVI fdec.svar in + let rec scanFormals targs sformals = + match targs, sformals with + [], [] -> () + | (tan, tat, taa) :: targs, sf :: sformals -> + sf.vtype <- tat; + let n = + N.getNode (N.PLocal(!currentFile.fileName, + !currentFunction.svar.vname, tan)) + 0 tat taa in + sf.vattr <- addAttributes taa n.N.attr; + scanFormals targs sformals + | _ -> E.s (bug "scanFormals(%s) non-matching formal lists" + fdec.svar.vname) + in + scanFormals (argsToList targs) fdec.sformals; + (* Restore the sharing by writing the type *) + setFormals fdec fdec.sformals; + () + +let doFunctionBody (fdec: fundec) = + currentFunction := fdec; + let rt,_,_,_ = splitFunctionTypeVI fdec.svar in + currentResultType := rt; + (* Do the other locals *) + List.iter doVarinfo fdec.slocals; + (* Do the body *) + fdec.sbody <- doBlock fdec.sbody + + + +(* Now do the globals *) +let doGlobal (g: global) : global = + match g with + | GPragma _ | GText _ | GAsm _ + | GEnumTag _ | GCompTagDecl _ | GEnumTagDecl _ -> g + + (* We process here only those types that we must not unroll. + * The others we'll process as we see them used.*) + | GType (t, l) -> + currentLoc := l; + (* See if we have the "nounroll" attribute *) + if hasAttribute "nounroll" (typeAttrs t.ttype) then + H.add dontUnrollTypes t.tname true; + if not (mustUnrollTypeInfo t) then begin + let t', _ = doType t.ttype (N.PType t.tname) 1 in + t.ttype <- t'; + g + end else + if !N.printVerboseOutput then + GText ("// Definition of unrolled type "^t.tname^" was removed") + else + GText ("//") + + | GCompTag (comp, l) -> + currentLoc := l; + markCompInfo comp l; + g + + | GVarDecl (vi, l) -> + currentLoc := l; + Stats.time "global doVarinfo" doVarinfo vi; + g + + | GVar (vi, init, l) -> + currentLoc := l; + Stats.time "global doVarinfo" doVarinfo vi; + (match init.init with + None -> () + | Some i -> + let i', _ = Stats.time "doInit" (doInit vi i) l in + init.init <- Some i'); + g + + | GFun (fdec, l) -> + currentLoc := l; + Stats.time "global doVarinfo" doVarinfo fdec.svar; + Stats.time "doFormals" doFormals fdec; + let dobox = not (Dattrs.isTrustedType fdec.svar.vtype) in + if dobox then + Stats.time "doFunctionBody" doFunctionBody fdec; + g + + +(********************************************************) + + +(* Now do the file *) +let markFile fl = + currentFile := fl; + + N.initialize (); + IH.clear mustRecomputePointsTo; + IH.clear markedCompInfos; + H.clear dontUnrollTypes; + H.clear allocFunctions; + + (* This is where we process all the functions. *) + theFile := []; + Stats.time "doGlobal" + (List.iter (fun g -> let g' = doGlobal g in + theFile := g' :: !theFile)) fl.globals; + + (* Now we have to scan the nodes again. There might be some nodes whose + * type is pointer to TComp and which do not have any EPointsTo edges + * because the TComp was a forward reference. Now that should have been + * fixed, so try to regenerate the EPoints to edges *) + IH.iter (fun _ n -> N.setNodePointsTo n) mustRecomputePointsTo; + + (* Now do the globinit *) + let newglobinit = + match fl.globinit with + None -> None + | Some g -> begin + match doGlobal (GFun(g, locUnknown)) with + GFun (g', _) -> Some g' + | _ -> E.s (bug "markptr: globinit") + end + in + if !verbose then + ignore (E.log "after markptr\n"); + + let newglobals = List.rev !theFile in + + let newfile = {fl with globals = newglobals; globinit = newglobinit} in + + H.clear dontUnrollTypes; + H.clear allocFunctions; + IH.clear mustRecomputePointsTo; + IH.clear markedCompInfos; + theFile := []; + currentFile := dummyFile; + + newfile diff --git a/src/infer/markptr.mli b/src/infer/markptr.mli new file mode 100644 index 0000000..cc53436 --- /dev/null +++ b/src/infer/markptr.mli @@ -0,0 +1,41 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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. + * + *) + +(* Call this to construct the pointer graph *) +val markFile: Cil.file -> Cil.file + +val noStackOverflowChecks: bool ref diff --git a/src/infer/ptrnode.ml b/src/infer/ptrnode.ml new file mode 100644 index 0000000..c35b8b9 --- /dev/null +++ b/src/infer/ptrnode.ml @@ -0,0 +1,1935 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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. + * + *) + + +(* Implements nodes in a graph representing the pointer locations in a + * program *) +open Cil +open Pretty +open Trace + +module H = Hashtbl +module IH = Inthash +module E = Errormsg + +(* Deputy uses separate compilation, so just about anything can + escape. So far, we only use this for pkReferenced *) +let separateCompilation = true + +(* If defaultIsNotWild then pointers without a qualifier are SAFE and only + * the arrays that are specfically SIZED contain a size field and only the + * variables that are specifically TAGGED contain tags *) +let defaultIsWild = ref false + + +let useFSEQ = ref true +let useStrings = ref true +let extendStringBuffers = ref false + +let allowOverride = ref true + +let useOffsetNodes = true + +let printVerboseOutput = ref false + +(* Whether to check the chains *) +let doCheckChains = false + + +(* This function will be set by the Type module *) +let isSubtype: (typ -> typ -> bool) ref = ref (fun _ _ -> false) +let origSubtype = !isSubtype + +(* flag to force functions to never be tagged *) +let wild_solve_untagged_functions = ref false + +(* force functions to always be tagged *) +let wild_solve_tag_all_functions = ref false + +(* True if the wild solver is used. *) +let use_wild_solver = ref false + +(** How much detail to print. -1 means do not print the graph *) +let emitGraphDetailLevel : int ref = Doptions.emitGraphDetailLevel + +let graphDetailLevelLegend = +"the level of detail in the .infer files:\n" ^ +"\t 0 - just the nodes, kind and the chains\n" ^ +"\t 1 - also the types, location, name and flags\n" ^ +"\t 2 - also the edges (without) justification\n" ^ +"\t 3 - everything" + +let keepDetails () = + !emitGraphDetailLevel > 0 + +(* A marker that the solver places, if we use lean fats *) +let useLeanFats = ref false + +let allowPartialElementsInSequence = ref false + +let hasPrefix p s = + let pl = String.length p in + (String.length s >= pl) && String.sub s 0 pl = p + +let hasSuffix suff s = + let ls = String.length s in + let lsuff = String.length suff in + ls >= lsuff && suff = String.sub s (ls - lsuff) lsuff + +(* A place where a pointer type can occur *) +type place = + PGlob of string (* A global variable or a global function *) + | PType of string (* A global typedef *) + | PStatic of string * string (* A static variable or function. First is + * the filename in which it occurs *) + | PLocal of string * string * string (* A local varialbe. The name of the + * file, the function and the name of + * the local itself *) + | POffset of int * string (* An offset node, give the host node + * id and a field name *) + | PField of fieldinfo (* A field of a composite type *) + + | PAnon of int (* Anonymous. This one must use a + * fresh int every time. Use + * anonPlace() to create one of these + * *) + | PStr (* The global node for all string + * literals. They all have the same + * kind, so we don't need separate + * nodes.*) + | PWStr (* The global node for all wide string + * literals. *) + +let anonId = ref (-1) +let anonPlace () : place = + incr anonId; + PAnon !anonId + +(* Each node corresponds to a place in the program where a qualifier for a + * pointer type could occur. As a special case we also add qualifiers for + * variables in expectation that their address might be taken *) +type node = + { id: int; (* A program-wide unique identifier *) + where: place * int; (* A way to identify where is this + * coming from. We use this to make + * sure we do not create duplicate + * nodes. The integer is an index + * within a place, such as if the + * type of a global contains several + * pointer types (nested) *) + + btype: typ; (* The base type of this pointer *) + mutable attr: attributes; (* The attributes of this pointer + * type *) + mutable is_array: bool; (* This node is associated with an + * array, not with a pointer. *) + + mutable flags: (whyflag option) array; + + mutable succ: edge list; (* All edges with "from" = this node *) + mutable pred: edge list; (* All edges with "to" = this node *) + + + (* The rest are the computed results of constraint resolution *) + mutable kind: opointerkind; + mutable why_kind: whykind; + mutable sized: bool ; (* An array may be SIZED at which + * point it has a length field + * stored right before it. This + * leads to INDEX pointers. *) + + mutable locked: bool; (* do not change this kind later *) + mutable mark: bool; (* For mark-and-sweep GC of nodes. + * Most of the time is false *) + mutable rep : (node * chain ) option; + (* the next node in the chain to the representative of this class. + * use get_rep to get the final representative *) + mutable loc : Cil.location; (* where did this node come from? *) + + shouldInfer: bool; (* True if this is a local or a cast + and we can do more aggressive + inference. *) + } + +and opointerkind = + Safe (* a COUNT(1) pointer *) + | Sentinel (* a COUNT(0) pointer. If a pointer is not referenced, + not NT, is not annotated SAFE, and does not use + arithmetic, it gets this kind.*) + + | Seq (* Needs lower and upper bounds *) + | FSeq (* Needs upper bound *) + + | SeqN + | FSeqN + | String (* An NT COUNT(0) pointer *) + + | UnknownN (* An NT pointer with no annotated bounds. + Inference turns this into String, FSeqN, or SeqN. + If no pkArith flag is present after solving, this + will default to String.*) + + | Unknown (* If no pkArith or pkString flag is present after solving, + this will default to Safe.*) + +and whyflag = (* why is this flag set for this node? *) + | ProgramSyntax of Cil.location + + (* This flag is set because it is set on some other node (node1 + the + * chain:node1->this). We also give the original source of the flag. *) + | FlagSpreadFromNode of node * chain * node + + | DownCast of node + | SubtypeFailed of node + | RequiredByEdge of edge + | RequiredByPointerKind of opointerkind + | RequiredByFlag of int + | FlUserSpec of Cil.location (* Annotated by a user *) + | MayEscape of Cil.location (* We are using separate compilation, + and this node is not a local. + Therefore, we assume it can be used + by anybody. *) + +and whykind = (* why did we give it this kind? *) + BadCast of edge (* always attach to ECast edges *) + | BadSequenceCast of edge + | Incompat of node * chain * node (* Two nodes that should be in the same + * equivalence class are incompatible *) + + | BoolFlag of int + | PolyInt (* This is a void* connected only to scalars *) + | Default + | UserSpec + | Unconstrained + | PrintfArg (* printf inference *) + | Special of string * location + + (* This kind is set because it is set on some other node (node1 + the + * chain:node1->this). We also give the original source of the kind. *) + | SpreadFromNode of node * chain * node + + +and edge = + { eid: int; + mutable efrom: node; + mutable eto: node; + mutable ekind: edgekind; + mutable eloc: location; + } + + +and edgekind = + ECast of extra_edge_kind (* T_from ref q_from <= T_to ref q_to. We also + * cary some additional explanation for this + * edge. *) + | EOffset (* From a pointer to struct to a pointer to + * field *) + | EIndex (* q_to = if q_from = wild then wild else index *) + + | ECompat (* the kinds of these two nodes must be + * compatible: either both wild, index or + * safe. This edge type is added by the solver + * for its convenience. In cases like + * int * 1 * 2 x; + * int * 3 * 4 y; + * We will connect 1 and 3 with ECompat. *) + of chain (* An ECompat edge can always be explained + * using a list of ECast edges *) + | ESameKind (* Special edge that does not require + * compatibility of the types involved, but does + * require that they be of the same KIND. *) + of extra_edge_kind_sk (* See below for uses of ESameKind *) + | EPointsTo (* from's base type included to *) + | EArgs (* From the pointer to the function to the + * actual arguments and result values. Before we + * added this edge we relied on WILDness to + * spread from the function pointer to the + * actual argument by means of EPoints to edge + * to the formals and then ECast edges. But that + * did not work when there were no formals + * declared ! *) + +(* More info about ECast edges *) +and extra_edge_kind = + EEK_cast (* A true cast *) + | EEK_stringdrop (* An NTDROP cast in deputy. We do not push + pkString forwards across this edge. + (pkString flows backwards as usual) *) + | EEK_cxxOverride (* Due to the Cxx inheritance. See markcxx *) + | EEK_extends (* Due to an extends relationship *) + | EEK_mkptr (* Due to a mkptr or alignseq *) + | EEK_union (* Edges added between union fields *) + | EEK_rtti (* Edges due to auto RTTI *) + +(* More info about ESameKind edges *) +and extra_edge_kind_sk = + | EEK_trustedCast (* This edge is added between the formal + * argument and the result value in an instance + * of trusted_cast function. This does not + * require compatibility of the types involved + * but does require that the two types be of the + * same KIND *) + | EEK_taggedUnion (* Behaves like an trustedCast, but is sound. + * We use this to connect union fields that must + * have the same kind in case we cast from one to + * another, but we can ignore types on these edges + * since those are checked dynamically. *) + + +(************** CHAINS ********************) + +(** An implementation of chains using constructors for sym and trans *) +and chain = + (* The chain why a node has a certain representative or why a + * ECompat edge exists *) + RIdent (* Identity: a relationship between identical nodes *) + + | RSingle of edge + (* This is an ECast edge. This chain is used for + * ECompat edges that arise "below" a ECast edge. *) + + | RSym of chain (* If "chain" explains ECompat(n1-n2) then, + * "RSym(chain)" explains ECompat(n2-n1). *) + + (* Transitivity *) + | RTrans of node * chain * chain * node * int + (* Remember the first and the last nodes, and the length *) + + + | RList of node * (bool * edge) list * node * int + (* A list of elements along with the information whether they are + * reversed. Remember the first and the last node and the length. *) + +(** Keep a table with the shortest path *) +type pathEntry = + { mutable peLen: int; (* Nr of RSingle *) + mutable peChain: chain + } + +let inftyLen = 1000000 (* A very large length *) +let idPathEntry = { peLen = 0; peChain = RIdent } + +(* matth: unused in Deputy *) +let shortestPath: (int * int, pathEntry) H.t = H.create 11111 + +let getShortestChain (nfrom: node) (nto: node) : pathEntry * bool = + if nfrom.id = nto.id then + idPathEntry, false + else + let from', to', sym = + if nfrom.id < nto.id then + nfrom.id, nto.id, false + else + nto.id, nfrom.id, true + in + let pe = + Util.findOrAdd shortestPath (from', to') + (fun _ -> { peLen = inftyLen; peChain = RIdent }) in + pe, sym + +let d_edge (e: edge) = dprintf "%d->%d" e.efrom.id e.eto.id + +let rec d_chain () (r: chain) = + match r with + RIdent -> nil + | RSingle e -> d_edge e (* dprintf "%d->%d" e.efrom.id e.eto.id *) + | RSym r -> text "sym(" ++ d_chain () r ++ text ")" + | RTrans (_, r1, r2, _, _) -> + if !emitGraphDetailLevel > 2 then + d_chain () r1 ++ text "," ++ d_chain () r2 + else text "..." + | RList (_, l, _, _) -> + dprintf "list(%a)" + (docList + (fun (isrev, a) -> + if isrev then text "sym(" ++ d_edge a ++ text ")" + else d_edge a)) + l + +let rec dumpChain = function + RIdent -> ignore (E.log "RID\n") + | RSingle e -> ignore (E.log "Edge %a\n" insert (d_edge e)) + | RSym r -> + ignore (E.log "(RSym \n"); + dumpChain r; + ignore (E.log ")\n") + + | RTrans (_, r1, r2, _, _) -> + ignore (E.log "(RTrans \n"); + dumpChain r1; + ignore (E.log ") and (\n"); + dumpChain r2; + ignore (E.log ")\n") + | RList (_, l, _, _) -> + ignore (E.log "list(\n"); + List.iter + (fun (isrev, a) -> + if isrev then + ignore (E.log "sym(%a)" insert (d_edge a)) + else + ignore (E.log "Edge %a," insert (d_edge a))) + l + +let debugChains = false + +let mkRIdent = RIdent +let mkRSingle e = RSingle e + + (* A few helper functions for manipulating chains *) +let mkRSym (r: chain) = + match r with + RIdent -> RIdent + | RSym r1 -> r1 + | _ -> RSym r + +let isSym (r: chain) = + match r with + RSym r1 -> Some r1 + | _ -> None + +(* Get one edge from the chain *) +let rec getOneEdge (r: chain) : edge option = + match r with + RSingle e' -> Some e' + | RSym r -> getOneEdge r + | RTrans (_, r1, r2, _, _) -> getOneEdge r1 + | RList (_, ((_, h) :: _), _, _) -> Some h + | RIdent -> None + | RList _ -> None + +let rec isOneEdge (r: chain) : edge option = + match r with + RSingle e' -> Some e' + | RSym r -> isOneEdge r + | RList (_, [(_, e)], _, _) -> Some e + | _ -> None + + (* Return a list of elements in a chain. The boolean value says + * whether the edge is reversed *) +let rec chainToList (c: chain) : (bool * edge) list = + (* We have the tail already. We have to cons on the beginning of it the + * argument, possibly symmetric *) + + (* Remember all the tails, indexed by the node number *) + let tails: (int, (bool * edge) list) H.t = H.create 19 in + let rec loop (sym: bool) (c: chain) + (tail: (bool * edge) list) = + match c with + RIdent -> tail + | RSingle e -> begin + (* Maybe this cancels out with something in the tail *) + match tail with + (sym', e') :: tail' when e == e' -> + if sym <> sym' then + tail' + else begin + ignore (E.warn "duplicate edge in chain"); + (* (sym, e) :: *) tail + end + | _ -> begin + (* This is the place where we extend the tail. Check if we can + * use a shorter tail *) + let f = if sym then e.eto.id else e.efrom.id in + let res = (sym, e) :: tail in + Util.findOrAdd tails f (fun _ -> res) + end + end + | RSym c -> loop (not sym) c tail + | RTrans (_, r1, r2, _, _) -> + (* ignore (E.log "chainToList(%x)\n" (Obj.magic c)); *) + if sym then + loop sym r2 (loop sym r1 tail) + else + loop sym r1 (loop sym r2 tail) + | RList (_, l, _, _) -> + if sym then (* Must reverse the list as well *) + List.fold_left + (fun acc (isrev, h) -> + loop (sym <> isrev) (RSingle h) acc) + tail + l + else if tail = [] then + l (* since sym = false && tail = [] *) + else + ( try + List.fold_right + (fun (isrev, h) acc -> + loop (sym <> isrev) (RSingle h) acc) + l + tail + with e -> + (ignore (E.warn "List.fold_right raises %s" + (Printexc.to_string e)) ; raise e) + ) + in + loop false c [] + + +let rec getFirstAndLastNode (sym: bool) (c: chain) : node * node * int = + match c with + RSingle e -> + let fn, ln = if sym then e.eto, e.efrom else e.efrom, e.eto in + fn, ln, 1 + + | RSym c -> getFirstAndLastNode (not sym) c + | RTrans (fn, _, _, ln, len) + | RList (fn, _, ln, len) -> + if sym then ln,fn,len else fn,ln,len + | _ -> E.s (E.bug "getFirstAndLastEdge: %a" d_chain c) + + +(* A helper function for concatenating chains. Call when both of the chains + * are non-empty. *) +let mkRTransHelper (r1: chain) (r2: chain) : chain = + let fn1, ln1, len1 = getFirstAndLastNode false r1 in + let fn2, ln2, len2 = getFirstAndLastNode false r2 in + (* Get the data about this whole path *) + let pe, sym = getShortestChain fn1 ln2 in + (* See if the new one has any chance of being better *) + if pe.peLen <= len1 + len2 then + if sym then mkRSym pe.peChain else pe.peChain (* Keep the old one *) + else begin + (* Prepare the possible result *) + let res = RTrans(fn1, r1, r2, ln2, len1 + len2) in + (* The new one is better. See how small it can get *) + if debugChains then + ignore (E.log "Finding best chain from %d->%d. Right now %d->%d(%d) + %d->%d(%d)\n" + fn1.id ln2.id fn1.id ln1.id len1 fn2.id ln2.id len2); + let l = chainToList res in + let l_len = List.length l in + if debugChains && l_len > 40 then begin + ignore (E.log " res=%a@!" + (docList + (fun (sym, e) -> + if sym then dprintf "<-%d" e.efrom.id + else dprintf "->%d" e.eto.id)) + l); + end; + let bestLen, bestChain = + if l_len < len1 + len2 then + l_len, (if l_len = 0 then RIdent else RList (fn1, l, ln2, l_len)) + else + len1+len2, res + in + (* Update the entry *) + if debugChains then + ignore (E.log "Setting best chain from %d->%d of length %d %s\n" + fn1.id ln2.id bestLen + (if bestLen < len1 + len2 then "(compressed)" else "")); + pe.peLen <- bestLen; + pe.peChain <- if sym then mkRSym bestChain else bestChain; + bestChain + end + +let mkRTransChain (r1: chain) (r2: chain) = + let isSymOf (r1: chain) (r2: chain) = + match r1, r2 with + | r1, RSym r1' when r1 == r1' -> true + | RSym r2', r2 when r2 == r2' -> true + | _, _ -> false + in + begin + match r1, r2 with + RIdent, r2 -> r2 + | r1, RIdent -> r1 + (* It is important to recognize some special cases that lead to + * exponential explosion *) + | r1, r2 when isSymOf r1 r2 -> RIdent + | r1, RTrans (_, r1', r2, _, _) when isSymOf r1 r1' -> r2 + | RTrans (_, r1, r2, _, _), r2' when isSymOf r2 r2' -> r1 + | _, _ -> mkRTransHelper r1 r2 + end + + + + +(* A mapping from place , index to ids. This will help us avoid creating + * duplicate nodes *) +let placeId: (place * int, node) H.t = H.create 1111 + +(* A mapping from ids to nodes. Rarely we need to find a node based on its + * index. *) +let idNode: node IH.t = IH.create 1111 + +(* Next identifier *) +let lastNodeId = ref (-1) + + + +let pkInterface = 0 (* this is an interface node *) +let pkUpdated = 1 (* we write through this pointer *) +let pkIntCast = 2 (* can contain an integer *) +let pkPosArith = 3 (* subject to positive pointer arithmetic *) +let pkArith = 4 (* subject to arbitrary pointer arithmetic *) +let pkString = 5 (* A String node. The value at the end of the + buffer is a nul. matth, sept05: This + flows forwards and backwards now.*) +let pkReachIndex = 6 (* can reach an Index node *) +let pkNoPrototype = 7 (* Used as actual argument in a function without + * prototype *) +let pkEscape = 8 (* value may be assigned thru a pointer and + * escape to the heap *) +let pkNotSafe = 9 (* constraint used by solvers: node must not be Safe *) + +let pkReferenced = 10 (* might be eventually referenced *) + +let pkRtti = 11 + +let pkCompatWithScalars = 12 + (* This flag means that a void* node (or its equivalence class) must be + * compatible with a scalar. Example: + * void *1 *2 v; + * int *3 x; + * v = x; + * In this case, node 1 should have this flag. + * (1) This flag is only valid on "void*" nodes. If a non-"void*" node + * has this flag, that node should be WILD by the end of solving. + * (2) This flag will always be present on the rep of a class if any node + * in that class has it. + * (3) If a node (or its rep) has this flag, then polymorphic_replace + * will return Int for the type of that node. + * (4) This flag is propagated whenever new reps are created. + *) + +(* Could point to the stack; CHECK_STORE_PTR and CHECK_RETURN needed. + * This is too conservative, since we flow this flag through globals and the + * heap, even though we know the checks will prevent that at runtime. But + * it's good enough for now. *) +let pkStack = 13 + +let pkOneWord = 14 (** Specified by user to be one word *) + +let pkFlagName = (* should match up with the order above *) + [| "Interface Node" ; + "Updated" ; + "Contains an Integer" ; + "Positive Arithmetic" ; + "Arithmetic" ; + "Reaches String" ; + "Reaches Index" ; + "No Prototype" ; + "Value Escapes to the Heap" ; + "Cannot be SAFE" ; + "Referenced"; + "Has RTTI" ; + "Compatible with Scalars"; + "Might Point To Stack"; + "One Word" |] + +let pkNumberOfFlags = Array.length pkFlagName +let pkLastFlag = pkNumberOfFlags - 1 + +(* These are bitmasks of flags. *) +let pkCastPredFlags = [pkUpdated ; pkPosArith ; pkArith ; pkEscape ; + pkReferenced] +let pkCNIPredFlagsNoString = (* for ECast EEK_stringdrop *) + [pkReachIndex ; pkReferenced ] +let pkCNIPredFlags = (* all ECasts except stringdrop *) + pkString :: pkCNIPredFlagsNoString +let pkCastSuccFlagsNoString = (* for ECast EEK_stringdrop *) + [pkIntCast ; pkStack] +let pkCastSuccFlags = (* all ECasts except stringdrop *) + pkString :: pkCastSuccFlagsNoString +let pkOffsetSuccFlags = [pkEscape] +let pkOffsetPredFlags = [pkReferenced] + +(* A list of all indices into the array *) +let allFlags = + let rec allIndices (n: int) : int list = + if n > pkLastFlag then [] else n :: allIndices (n + 1) + in + allIndices 0 + +let emptyFlags () = Array.make pkNumberOfFlags None + +(* set a boolean bitflag *) +let setFlag n f why = + if n.flags.(f) = None then n.flags.(f) <- Some(why) +(* check a boolean bitflag *) +let hasFlag n f = n.flags.(f) <> None + + +let canHaveRtti (t: typ) : bool = isVoidType t + +let allKinds = + [ Safe; Sentinel; Seq; + FSeq; SeqN; FSeqN; + String; UnknownN; + Unknown ] + +(* Just some code to check that we have added all pointer kinds to allKinds. + * If the compiler complains about an inexhaustive pattern then you have + * probalby added new pointer kinds. Add them to the pattern AND TO allKinds + * above. *) +let _ = + List.iter + (function + | Safe | Sentinel + | String | UnknownN + | Seq | SeqN + | FSeq | FSeqN + | Unknown -> ()) + allKinds + +(* Print the graph *) +let d_place () = function + PGlob s -> dprintf "Glob(%s)" s + | PType s -> dprintf "Type(%s)" s + | PStatic (f, s) -> dprintf "Static(%s.%s)" f s + | PLocal (f, func, s) -> dprintf "Local(%s.%s.%s)" f func s + | POffset (nid, fld) -> dprintf "Offset(%d, %s)" nid fld + | PField(fi) -> dprintf "Field(%s.%s)" fi.fcomp.cname fi.fname + | PAnon id -> dprintf "Anon(%d)" id + | PStr -> text "Str" + | PWStr -> text "WStr" + +(* Print the place "nicely", in a human-readable format *) +let d_place_nice () (p,i) = match p with + PGlob s -> dprintf "the global %s" s + | PType s -> dprintf "the type %s" s + | PStatic (f, s) -> dprintf "the static variable %s" s + | PLocal (f, func, s) -> dprintf "the local variable %s" s + | POffset (nid, fld) -> dprintf "the field %s of node %d" fld nid + | PField(fi) -> dprintf "the field %s" fi.fname + | PAnon id -> text "an unnamed location (often an inserted cast)" + | PStr -> text "global string literal node." + | PWStr -> text "global wide-string literal node." + +let d_placeidx () (p, idx) = + dprintf "%a.%d" d_place p idx + +let d_opointerkind () = function + Safe -> text "SAFE" + | Sentinel -> text "SNT" + | FSeq -> text "FSEQ" + | FSeqN -> text "FSEQN" + | UnknownN -> text "UNKNOWN_NT" + | String -> text "STRING" + | Seq -> text "SEQ" + | SeqN -> text "SEQN" + | Unknown -> text "UNKNOWN" + +let d_eekind () = function + EEK_cast -> nil + | EEK_stringdrop -> text "(ntdrop)" + | EEK_cxxOverride -> text "(cxx_override)" + | EEK_extends -> text "(extends)" + | EEK_mkptr -> text "(mkptr)" + | EEK_union -> text "(union)" + | EEK_rtti -> text "(rtti)" + +let d_ekind () = function + ECast eek -> text "Cast" ++ d_eekind () eek + | EOffset -> text "Offset" + | EIndex -> text "Index" + | ECompat(r) -> dprintf "Compat(%a)" d_chain r + | ESameKind EEK_trustedCast -> text "TCast" + | ESameKind EEK_taggedUnion -> text "Union" + | EPointsTo -> text "Points" + | EArgs -> text "Args" + +let d_whyflag (n: node) () = function + | ProgramSyntax(l) -> dprintf "Syntax at %a" d_loc l + | DownCast(n) -> dprintf "Downcast With Node %d" n.id + | SubtypeFailed(n) -> dprintf "Subtyping Failed With Node %d" n.id + | RequiredByEdge(e) -> dprintf "Required By %a Edge %d->%d" + d_ekind e.ekind e.efrom.id e.eto.id + | RequiredByPointerKind(o) -> dprintf "Required For %a Nodes" + d_opointerkind o + | RequiredByFlag(i) -> dprintf "Required By Flag [%s]" + pkFlagName.(i) + | FlagSpreadFromNode(near,r_near_this,orig) -> + dprintf "Spread from %d (%a). Transitive from %d" + near.id d_chain r_near_this orig.id + | FlUserSpec l -> text "User-specified at " ++ d_loc () l + | MayEscape l -> text "May escape this file at " ++ d_loc () l + + +let ptrAttrCustom = + (* Define a hash table for printing the attributes *) + let ptrAttrCustomTable: (string, string * (attrparam list -> doc)) H.t = + let h: (string, string * (attrparam list -> doc)) H.t = H.create 31 in + let noArgs (al: attrparam list) : doc = + match al with + [] -> nil + | _ -> raise Not_found + in + let doArgs (al: attrparam list) : doc = + dprintf "(@[%a@])" + (docList (d_attrparam ())) al + in + let addSimple (n: string) = + H.add h n ("__" ^ String.uppercase n, noArgs) + in + List.iter addSimple + ["ronly"; "seq"; "fseq"; "seqn"; "fseqn" ]; + H.add h "selector" ("__SELECTOR", doArgs); + H.add h "selectedwhen" ("__SELECTEDWHEN", doArgs); + H.add h "size" ("__SIZE", doArgs); + H.add h "count" ("__COUNT", doArgs); + h + in + fun ~(printnode: bool) (a: attribute) -> + match a with + Attr("_ptrnode", [AInt n]) -> + if printnode then + Some (dprintf "__NODE(%d)" n) + else begin + Some nil + end + | Attr("safe", []) -> + if printnode then Some (text "__SAFE") else Some nil + | Attr("discriminated_union", []) -> Some nil + | Attr("stack", []) -> Some (text "__STACK") + | Attr("trustedunion", []) -> Some (text "__TRUSTEDUNION") + | Attr("safeunion", []) -> Some (text "__SAFEUNION") + | Attr("heapify", []) -> Some (text "__HEAPIFY") + | Attr("nocure", []) -> Some (text "__NOCURE") + | Attr("nounroll",[]) -> Some (text "__NOUNROLL") + | Attr("noescape", []) -> Some (text "__NOESCAPE") + | Attr("ccuredvararg", [ASizeOf t]) -> Some (text "__CCUREDVARARG(" ++ + d_type () t ++ text ")") + | Attr("ccuredformat", [AInt fidx]) -> Some (text "__CCUREDFORMAT(" ++ + num fidx ++ text ")") + | Attr("override", [AStr s]) -> Some (text ("__OVERRIDE(\"" ^ s ^ "\")")) + | Attr("main_input", []) -> Some (text ("")) + | Attr("metacomp", []) -> Some (text "") + | Attr("mergecomp", []) -> Some (text "") + | Attr("mdsize", _) -> Some (text "") + | Attr("annotated", _) -> Some (text "") + | Attr (n, args) -> begin + try + let n', args' = H.find ptrAttrCustomTable n in + Some (text n' ++ (args' args)) + with Not_found -> None + end + +(* Now define a special way of printing the infer file *) +class ccuredInferPrinterClass = object + inherit defaultCilPrinterClass as super + + method pAttr (a: attribute) : doc * bool = + match ptrAttrCustom ~printnode:true a with + Some d -> d, false + | None -> super#pAttr a + + (* We do not print some pragmas *) + method dGlobal (out: out_channel) (g: global) : unit = + match g with + | GPragma(Attr(n, _), _) -> + if hasPrefix "ccured" n || hasPrefix "cil" n then + if !printVerboseOutput then begin + fprint out 80 (text "// "); + super#dGlobal out g + end else + () + else + () + + | GText t -> + if !printVerboseOutput || not (t = "//\n") then + super#dGlobal out g + + | g -> super#dGlobal out g + +end +let ccuredInferPrinter = new ccuredInferPrinterClass + +let d_type = printType ccuredInferPrinter + +let d_whykind (n: node) () = function + | BadCast e -> + dprintf "cast(%a(%d) <= %a(%d)) at %a" + d_type e.eto.btype e.eto.id d_type e.efrom.btype e.efrom.id + d_loc e.eloc + | BadSequenceCast e -> + dprintf "cast(%a(%d) <= %a(%d)) at %a (and cannot be sequence)" + d_type e.eto.btype e.eto.id d_type e.efrom.btype e.efrom.id + d_loc e.eloc + | Incompat (n1, why_n1_n2, n2) -> + dprintf "Incompat %d and %d (%a)" + n1.id n2.id d_chain why_n1_n2 + | BoolFlag(i) -> dprintf "from_flag(%s)" pkFlagName.(i) + | PolyInt -> dprintf "void* equivalent to scalar" + | Default -> text "by_default" + | UserSpec -> text "user_spec" + | Unconstrained -> text "unconstrained" + | PrintfArg -> text "printf_arg" + | Special (s, l) -> text (s ^ " at ") ++ d_loc () l + | SpreadFromNode(near,r_near_this,orig) -> + dprintf "Spread from %d (%a). Transitive from %d\n" + near.id d_chain r_near_this orig.id + +let d_node () n = + num n.id + ++ text " : " + ++ (match n.rep with + None -> nil + | Some (nrep, _) -> dprintf "(rep is %d) " nrep.id) + ++ (if !emitGraphDetailLevel > 1 then d_placeidx () n.where else nil) + ++ (if !emitGraphDetailLevel > 1 then text " L=" ++ Cil.d_loc () n.loc else nil) + ++ line + ++ text " K=" ++ d_opointerkind () n.kind + ++ text "/" ++ (d_whykind n) () n.why_kind + ++ (if !emitGraphDetailLevel > 0 then text " T=" ++ d_type () n.btype else nil) + ++ + (if !emitGraphDetailLevel > 0 && + (Array.fold_left (fun acc elt -> acc || elt <> None) false n.flags) + then begin + line ++ text "Flags: " + ++ (align + ++ (docArray ~sep:(text "") + (fun i flag_opt -> match flag_opt with + (* Do not print the pkNotSafe flag. It is for internal + * use and in the case of polymorphic_void* we + * actuallly may make such nodes SAFE, creating + * confusion *) + | Some(why) when i <> pkNotSafe -> + dprintf "@![%s]: %a" pkFlagName.(i) (d_whyflag n) why + | _ -> nil + ) () n.flags) + ++ unalign ++ line) + end else begin + nil + end) + ++ + (if !emitGraphDetailLevel > 1 then + line + ++ text " S=" + ++ (align + ++ (docList ~sep:(chr ',' ++ break) + (fun e -> + num e.eto.id + ++ text ":" + ++ d_ekind () e.ekind + ++ text "@" ++ d_loc () e.eloc) + () + n.succ) + ++ unalign) + ++ line + ++ text " P=" + ++ (align + ++ (docList ~sep:(chr ',' ++ break) + (fun e -> + num e.efrom.id + ++ text ":" + ++ d_ekind () e.ekind) + () + n.pred) + ++ unalign) + else nil) + + ++ line + +let nodeOfAttrlist al = + let findnode n = + try Some (IH.find idNode n) + with Not_found -> E.s (E.bug "Cannot find node with id = %d\n" n) + in + match filterAttributes "_ptrnode" al with + [] -> None + | [Attr(_, [AInt n])] -> findnode n + | (Attr(_, [AInt n]) :: _) as filtered -> + ignore (E.warn "nodeOfAttrlist(%a)" d_attrlist filtered); + findnode n + | _ -> E.s (E.bug "nodeOfAttrlist") + +let nodeOfType (t: typ) : node option = nodeOfAttrlist (typeAttrs t) + +(* weimer: find the node that points to this one *) +let nodeThatPointsTo (child : node) = + try + let e = List.find (fun e -> e.ekind = EPointsTo) child.pred in + Some e.efrom + with Not_found -> None + +let k2attr = function + Safe -> Attr("safe", []) + | Seq -> Attr("seq", []) + | FSeq -> Attr("fseq", []) + | SeqN -> Attr("seqn", []) + | FSeqN -> Attr("fseqn", []) + | String -> Attr("string", []) + | k -> E.s (E.unimp "k2attr:%a" d_opointerkind k) + +let nullterm_kind = 64 +let rec k2number = function + | Sentinel -> 0 + | Safe -> 1 + | Seq -> 2 + | FSeq -> 3 + | String -> 6 + | SeqN -> nullterm_kind + k2number Seq + | FSeqN -> nullterm_kind + k2number FSeq + | k -> E.s (E.unimp "k2number:%a" d_opointerkind k) + + + +(* The inferred kind for this node. Optionally, do it only for inferrable + * nodes. *) +let inferredKindOf ?(localOnly=false) + (allAttributes: attributes) : opointerkind * whykind = + let default = + if hasAttribute "nullterm" allAttributes then + UnknownN, Default + else + Unknown, Default + in + let rec loop al = + (* If there's no UserSpec kind, look at the node *) + match al with + Attr ("_ptrnode", [AInt n])::_ -> begin + let nd = IH.find idNode n in + (* If local only is set, then we look at the place for this node *) + if not localOnly || + (match nd.where with + (PLocal _ | PAnon _), 1 -> true + | _ -> false) then + nd.kind, nd.why_kind + else + default + end + | _::rest -> loop rest + | [] -> (* No NODE() attribute *) + default + in + loop allAttributes + + +(* The kind of this pointer. If there is no BND attribute, + defaults to inferredKind *) +let kindOfAttrlist allAttributes: opointerkind * whykind = + let isNullterm = hasAttribute "nullterm" allAttributes in + let rec loop al = + match al with + Attr("bounds", [a1;a2])::rest -> begin + match Dattrs.checkParam a1, Dattrs.checkParam a2 with + | Dattrs.PKThis, Dattrs.PKThis -> + if isNullterm then + String, UserSpec + else + (* Sentinel, UserSpec *) + inferredKindOf allAttributes + | Dattrs.PKThis, Dattrs.PKOffset (AInt 1) -> (* SAFE -> SAFE*) + (if isNullterm then FSeqN else Safe), + UserSpec + | Dattrs.PKThis, Dattrs.PKOffset a -> (* COUNT -> FSEQ *) + (if isNullterm then FSeqN else FSeq), + UserSpec + | _ -> (* BND -> SEQ *) + (if isNullterm then SeqN else Seq), + UserSpec + end + | Attr("size", _)::rest -> + (if isNullterm then FSeqN else FSeq), + UserSpec + | _::rest -> loop rest + | [] -> (* No BND annotation *) + inferredKindOf allAttributes + in + loop allAttributes + +let kindIsNullterm (k:opointerkind) : bool = + match k with + | Safe | Sentinel | Seq | FSeq | Unknown -> false + | String | SeqN | FSeqN | UnknownN -> true + +let kindNeedsBounds (k:opointerkind) : bool = + match k with + | Safe | Sentinel | String | Unknown | UnknownN -> false + | Seq | FSeq | SeqN | FSeqN -> true + + + +(* Replace the ptrnode attribute with the actual qualifier attribute *) +type whichAttr = + AtPtr (* In a pointer type *) + | AtArray (* In an array type *) + | AtOpenArray (* In an array type without a size *) + | AtVar (* For a variable *) + | AtOther (* Anything else *) + + +let replacePtrNodeAttrList ~(which:whichAttr) al = +(* ignore (E.log "replacePtrNode: %a\n" + (d_attrlist true) al); *) + let foundKind : string ref = ref "" in + let foundInNode : bool ref = ref false in + let foundAnother (innode: bool) (s: string) = + if innode then begin + foundInNode := true; + foundKind := s (* Discard all others *) + end else + (* Look at non-node ones only if we haven't found a node *) + if not !foundInNode then foundKind := s + in + (* Scan the attributes and look at pointer kind attributes and at node + * attributes. Remove all pointer-kind attributes and set foundKind and + * foundInNode if it was found in a node. *) + let rec loop = function + [] -> [] + | a :: al -> begin + match a with + Attr("_ptrnode", [AInt n]) -> begin + try + let nd = IH.find idNode n in + let found = + if nd.kind = Unknown then begin + ignore (E.warn "Found node %d with kind Unknown\n" n); + "" + end else + match k2attr nd.kind with + Attr(s, _) -> s + in + foundAnother true found; + a :: loop al + with Not_found -> begin + ignore (E.warn "Cannot find node %d\n" n); + a :: loop al + end + end + | Attr("safe", []) -> foundAnother false "safe"; loop al + | Attr("seq", []) -> foundAnother false "seq"; loop al + | Attr("fseq", []) -> + foundAnother false (if !useFSEQ then "fseq" else "seq"); loop al + | Attr("seqn", []) -> + foundAnother false (if !useStrings then "seqn" else "seq"); loop al + | Attr("fseqn", []) -> + foundAnother false + (if !useFSEQ then + (if !useStrings then "fseqn" else "fseq") + else (if !useStrings then "seqn" else "seq")); loop al + | Attr("string", []) when !useStrings -> + foundAnother false "string"; loop al + | Attr("rostring", []) when !useStrings -> + foundAnother false "rostring"; loop al + | _ -> a :: loop al + end + in + let al' = loop al in (* Get the filtered attributes *) + let kres = + match which with + AtPtr -> + if !foundKind <> "" then !foundKind + else if !defaultIsWild then "wild" else "safe" + | (AtArray | AtOpenArray) -> + if !foundKind = "seqn" then "nullterm" + else if !foundKind = "fseqn" then "nullterm" + else if !foundKind = "string" then "nullterm" + else if !foundKind = "rostring" then "nullterm" + else !foundKind + | (AtVar | AtOther) -> !foundKind + in + if kres <> "" then + addAttribute (Attr(kres,[])) al' + else + al' + +let nodeExists (p: place) (idx: int) = + H.mem placeId (p, idx) + +let existsEdge ~(start : node) ~(dest : node) ~(kind : edgekind) = + List.fold_left (fun acc e -> acc || + (e.eto.id = dest.id && e.ekind = kind)) false start.succ + +let isECompat e = + match e.ekind with + ECompat _ -> true + | _ -> false + +let isECast e = + match e.ekind with + ECast _ -> true + | _ -> false + +let isESameKind e = + match e.ekind with + ESameKind _ -> true + | _ -> false + +let lastEdgeIdx = ref 0 (* 0 is reserved for the union edge *) +let addEdge ~(start: node) ~(dest: node) ~(kind: edgekind) + ~(eloc : Cil.location option) = + + incr lastEdgeIdx; + let nedge = + { eid = !lastEdgeIdx; + efrom = start; eto= dest; ekind = kind; + eloc = match eloc with + Some(loc) -> loc + | None -> !currentLoc } in + start.succ <- nedge :: start.succ; + dest.pred <- nedge :: dest.pred ; + nedge + +let removeSucc n sid = + n.succ <- List.filter (fun e -> e.eto.id <> sid) n.succ + +let removePred n pid = + n.pred <- List.filter (fun e -> e.efrom.id <> pid) n.pred + +(* Delete an edge from the graph *) +let removeEdge e = + if not (List.memq e e.efrom.succ) then + E.s (bug "edge not in e.efrom.succ"); + if not (List.memq e e.eto.pred) then + E.s (bug "edge not in e.eto.pred"); + e.efrom.succ <- List.filter ((!=) e) e.efrom.succ; + e.eto.pred <- List.filter ((!=) e) e.eto.pred + +(** Set the EPointsTo edges for a node. *) +let setNodePointsTo (n: node) = + let doOneType = function + (* This will add points to to pointers embedded in structures or in + * functions (function return or arguments) *) + TPtr (bt, a) -> begin + (match nodeOfAttrlist a with + | Some n' -> ignore (addEdge n n' EPointsTo (Some n.loc)) + | _ -> (* + ignore + (warn "Node %d points to a pointer of type %a without a node" + n.id d_type bt); *) + ()); + ExistsFalse + end + | _ -> ExistsMaybe + in + ignore (existsType doOneType n.btype); + + + (* If a structure contains an array, a pointer to that structure also + * contains a pointer to the array. We need this information to + * properly handle wild pointers. *) + let lookForInternalArrays = function + TArray(bt,len,al) -> begin + (match nodeOfAttrlist al with + | Some n' -> ignore (addEdge n n' EPointsTo (Some !currentLoc)) + | _ -> ()); + ExistsFalse + end + + | _ -> ExistsMaybe + in + ignore (existsType lookForInternalArrays n.btype) + +(* Make a new node *) +let newNode ~(p: place) ~(idx: int) ~(bt: typ) ~(al: attributes) : node = + let where = p, idx in + incr lastNodeId; + (* Maybe it has a kind specified by the user *) + let kind,why_kind = kindOfAttrlist al in + let shouldInfer = match p with + PLocal _ | PAnon _ -> true + | _ -> false + in +(* if !lastNodeId = 1 then + ignore (E.log "newNode: %a\n" d_opointerkind kind); *) +(* E.log "%a: new node %d has attrs %a, kind %a\n" d_loc !currentLoc *) +(* !lastNodeId d_attrlist al d_opointerkind kind; *) + let n = { id = !lastNodeId; + btype = bt; + attr = addAttribute (Attr("_ptrnode", [AInt !lastNodeId])) al; + is_array = false; + where = where; + flags = emptyFlags () ; + locked = false; + succ = []; + kind = kind; + why_kind = why_kind; + sized = false ; + mark = false; + pred = []; + rep = None; + loc = !Cil.currentLoc; + shouldInfer = shouldInfer; } + in + if hasAttribute "noescape" al then + setFlag n pkStack (FlUserSpec !Cil.currentLoc); + if separateCompilation && not shouldInfer then + (* Not a local or cast. Therefore, assume it's referenced somewhere. *) + setFlag n pkReferenced (MayEscape !Cil.currentLoc); + +(* ignore (E.log "Created new node(%d) at %a\n" n.id d_placeidx where); *) + H.add placeId where n; + IH.add idNode n.id n; + (* We do not yet set the EPointsTo edges because we might have forward + * references. But once we have created all the nodes, we should call the + * setNodePointsTo *) + setNodePointsTo n; + n + + +(** Dummy node is a node with the ID=0 *) +let dummyNode = newNode (PGlob "@dummy") 0 voidType [] + + +(* Get a node for a place and an index. Give also the base type and the + * attributes *) +let getNode ~(p: place) ~(idx: int) ~(bt: typ) ~(al: attributes) : node = + (* See if exists already *) + let where = (p, idx) in + try + H.find placeId where + with Not_found -> newNode p idx bt al + + + (** Check that a node points to another node *) +let rec checkPointsTo (seen: int list) (* To prevent recursion *) + (nstart: node) + (nend_id: int) : bool = + (* Scan all EPoints successors of nstart *) + if nstart.id = nend_id then true + else begin + if List.exists (fun s -> s = nstart.id) seen then begin + ignore (E.log "checkPointsTo: circularity at %d\n" nstart.id); + false + end else begin + let seen' = nstart.id :: seen in + List.exists (fun e -> + e.ekind = EPointsTo && + checkPointsTo seen' e.eto nend_id) nstart.succ + end + end + + + (* Check that a node does not occur twice in a chain. We use + * this function to debug circular chains *) +let rec checkChain + (start: node) (* The node that we think the edge should + * be starting from *) + (r: chain) : node * int list = + if not (keepDetails ()) then + E.s (bug "checkChains but not keeping details"); + let edges = chainToList r in + let rec loop (start: node) (* The next expected node *) + (seen: int list) (* Nodes we've seen already *) = function + [] -> start, seen + | (sym, e) :: rest -> + (* Orient the edge appropriately *) + let estart, eend = if sym then e.eto, e.efrom else e.efrom, e.eto in + (* Check that we start at the right points. estart must be pointing to + * start or viceversa *) + if start.id <> 0 && + not (checkPointsTo [] start estart.id) && + not (checkPointsTo [] estart start.id) then begin + ignore (E.warn + "Disconnected chain: start=%d, edge %d->%d\n seen = %a\n" + start.id e.efrom.id e.eto.id + (docList num) (List.rev seen)); + raise (Failure "bad chain: disconnected") + end; + (* Complain if we've seen eend.id already *) + if List.exists (fun s -> s = eend.id) seen then begin + ignore (E.warn + "Circular chain: start=%d, edge %d->%d\n seen = %a\n" + start.id e.efrom.id e.eto.id + (docList num) (List.rev seen)); + raise (Failure "bad chain: circular") + end; + loop eend (eend.id :: (if start.id = 0 then [estart.id] else seen)) + rest + in + loop start [] edges + +let checkChainEnds (nstart: node) (nend: node) (r: chain) : unit = + try + let end', seen' = checkChain nstart r in + if not (checkPointsTo [] end' nend.id) && + not (checkPointsTo [] nend end'.id) then begin + ignore (E.warn "checkChainEnds. Ends at %d and expected %d\n" + end'.id nend.id); + raise (Failure "bad chain: misoriented edge") + end + with e -> begin + ignore (E.log "Failed the check that chain starts at %d and ends at %d\n" + nstart.id nend.id); + (); + end + + +(* Override mkRTrans to do some checking *) +let mkRTrans (r1: chain) (r2: chain) = + let res = mkRTransChain r1 r2 in + if doCheckChains && res != r1 && res != r2 then begin + try + ignore (checkChain dummyNode res); + with e -> begin + ignore (E.warn "Trying to mkRTrans of"); + dumpChain r1; + ignore (E.log " and \n"); + dumpChain r2; + raise e + end + end; + res + + + + +(* Given a flag for a node, produce the original node where the flag + * originates, the true chain why it originates, and the chain:orig->this *) +let rec trueSourceOfFlag (n: node) (f:int) : node * whyflag * chain = + match n.flags.(f) with + | Some(FlagSpreadFromNode(near,r_near_n,source)) when near.id <> n.id -> + let orig, why, r_orig_near = trueSourceOfFlag near f in + orig, why, mkRTrans r_orig_near r_near_n + | Some w -> n, w, mkRIdent + | None -> E.s (bug "trueSourceOfFlag(%d, %d)" n.id f) + + + + +(* obtain the representative of this equivalence class. Also return the + * reaons n -> representative *) +let rec get_rep_why (n: node) : node * chain = + match n.rep with + Some(nr,why_n_nr) -> + let final_result, why_nr_final_result = get_rep_why nr in + if final_result == nr then + nr, why_n_nr + else begin + (* Do path compression *) + let why_n_final_result = mkRTrans why_n_nr why_nr_final_result in + if not (hasFlag n pkRtti) then begin + (if hasFlag n pkCompatWithScalars then + let orig,_,_ = trueSourceOfFlag n pkCompatWithScalars in + setFlag final_result pkCompatWithScalars + (FlagSpreadFromNode(n,why_n_final_result,orig))); + n.rep <- Some(final_result, why_n_final_result) ; + end ; + final_result, why_n_final_result + end + | None -> n, mkRIdent + +let rec get_rep n = fst (get_rep_why n) + +let rec join n1 n2 (why_n1_n2: chain) (* The chain goes n1 -> n2 *) = + (if doCheckChains then checkChainEnds n1 n2 why_n1_n2); + let n1r, why_n1_n1r = get_rep_why n1 in + let n2r, why_n2_n2r = get_rep_why n2 in + if n1r.id = n2r.id then begin + () (* only join if they are distinct *) + end else begin + if isVoidType n1r.btype then begin (* n2r becomes the new rep *) + if not (hasFlag n1r pkRtti) then begin + (* chain: n1r -> n1 -> n2 -> n2r *) + let why_n1r_n2r = + mkRTrans (mkRSym why_n1_n1r) (mkRTrans why_n1_n2 why_n2_n2r) + in + n1r.rep <- Some(n2r, why_n1r_n2r); + if hasFlag n1r pkCompatWithScalars then begin + let res,_,_ = trueSourceOfFlag n1r pkCompatWithScalars in + setFlag n2r pkCompatWithScalars + (FlagSpreadFromNode(n1r, why_n1r_n2r, res)) + end + end + end else if isVoidType n2r.btype then begin (* n1r becomes the new rep *) + if not (hasFlag n2r pkRtti) then begin + let why_n2r_n1r = + mkRTrans (mkRSym why_n2_n2r) (mkRTrans (mkRSym why_n1_n2) why_n1_n1r) + in + n2r.rep <- Some(n1r, why_n2r_n1r); + if hasFlag n2r pkCompatWithScalars then + let res,_,_ = trueSourceOfFlag n2r pkCompatWithScalars in + setFlag n1r pkCompatWithScalars + (FlagSpreadFromNode(n2r, why_n2r_n1r, res)) + end + end else + (* Do not join nodes whose representatives are not void-ptr *) + () + end +(* + ignore (E.warn "join %d(%b) %d(%b) -> %d(%b)" + n1.id (hasFlag n1 pkCompatWithScalars) + n2.id (hasFlag n2 pkCompatWithScalars) + (get_rep n1).id (hasFlag (get_rep n1) pkCompatWithScalars) + ) *) + +(* Given a kind for a node, produce the original node where the kind + * originates, the true chain why it originates, and the chain:orig->this *) +let rec trueSourceOfKind (n: node) : node * whykind * chain = + match n.why_kind with + | SpreadFromNode(near,r_near_n,source) -> + let orig, why, r_orig_near = trueSourceOfKind near in + orig, why, mkRTrans r_orig_near r_near_n + | w -> n, w, mkRIdent + + +(* Type names, computed in such a way that compatible types have the same id, + * even if they are syntactically different. Right now we flatten structures + * but we do not pull common subcomponents out of unions and we do not unroll + * arrays. *) + + +(* Some structs (those involved in recursive types) are named. This hash maps + * their name to the ID *) +let namedStructs : (string, string) H.t = H.create 110 + + +(* Keep track of the structs in which we are (to detect loops). When we + * detect a loop we remember that *) +let inStruct : (string, bool ref) H.t = H.create 110 + + +let rec typeIdentifier (t: typ) : string = + let res = typeId t in + H.clear inStruct; (* Start afresh next time *) + res + +and typeId = function + TInt(ik, a) -> ikId ik ^ attrsId a + | TVoid a -> "V" ^ attrsId a + | TFloat (fk, a) -> fkId fk ^ attrsId a + | TEnum _ -> ikId IInt (* !!! *) + | TNamed (t, a) -> typeId (typeAddAttributes a t.ttype) + | TComp (comp, a) when comp.cstruct -> begin + (* See if we are in a loop *) + try + let inloop = H.find inStruct comp.cname in + inloop := true; (* Part of a recursive type *) + "t" ^ prependLength comp.cname (* ^ attrsId comp.cattr *) + with Not_found -> + let inloop = ref false in + let isanon = hasPrefix "__anon" comp.cname in + if not isanon then H.add inStruct comp.cname inloop; + let fieldsids = + List.fold_left (fun acc f -> acc ^ typeId f.ftype) "" comp.cfields in + (* If it is in a loop then keep its name *) + let res = fieldsids (* ^ attrsId comp.cattr *) in + if not isanon then H.remove inStruct comp.cname; + if !inloop && not (H.mem namedStructs comp.cname) then begin + H.add namedStructs comp.cname res; + "t" ^ prependLength comp.cname (* ^ attrsId comp.cattr *) + end else + res + end + | TComp (comp, a) when not comp.cstruct -> + "N" ^ (string_of_int (List.length comp.cfields)) ^ + (List.fold_left (fun acc f -> acc ^ typeId f.ftype ^ "n") + "" comp.cfields) ^ + attrsId (addAttributes comp.cattr a) + | TPtr (t, a) -> "P" ^ typeId t ^ "p" ^ attrsId a + | TArray (t, lo, a) -> + let thelen = "len" in + "A" ^ typeId t ^ "a" ^ prependLength thelen ^ attrsId a + | TFun (tres, args, va, a) -> + "F" ^ typeId tres ^ "f" ^ + (string_of_int (List.length (argsToList args))) ^ + (List.fold_left (fun acc (_, at, _) -> acc ^ typeId at ^ "f") + "" (argsToList args)) ^ (if va then "V" else "v") ^ attrsId a + | _ -> E.s (E.bug "typeId") + +and ikId = function + IChar -> "C" + | ISChar -> "c" + | IUChar -> "b" + | IInt -> "I" + | IUInt -> "U" + | IShort -> "S" + | IUShort -> "s" + | ILong -> "L" + | IULong -> "l" + | ILongLong -> "W" + | IULongLong -> "w" + +and fkId = function + FFloat -> "O" + | FDouble -> "D" + | FLongDouble -> "T" + +and prependLength s = + let l = String.length s in + if s = "" || (s >= "0" && s <= "9") then + E.s (E.unimp "String %s starts with a digit\n" s); + string_of_int l ^ s + +and attrsId al = + match al with + [] -> "_" + | _ -> "r" ^ List.fold_left (fun acc (Attr(an,_)) -> acc ^ an) "" al ^ "r" + + + +(************ Print statistics about the graph ******************) +let addToHisto (histo: ('a, int ref) H.t) (much: int) (which: 'a) : unit = + let r = Util.findOrAdd histo which (fun _ -> ref 0) in + r := !r + much + +let getHisto (histo: ('a, int ref) H.t) (which: 'a) : int = + try let r = H.find histo which in !r with Not_found -> 0 + +let sortHisto (histo: ('a, int ref) H.t) : ('a * int) list = + let theList : ('a * int) list ref = ref [] in + H.iter (fun k r -> theList := (k, !r) :: !theList) histo; + List.sort (fun (_,v1) (_,v2) -> - (compare v1 v2)) !theList + +let showFirst (showone: 'a -> int -> unit) + (many: int) (lst: ('a * int) list) = + let rec loop i = function + (n, s) :: rest when i >= 0 && s > 0 -> + showone n s; + loop (i - 1) rest + | _ -> () + in + loop many lst + +(*** Statistics ***) + + +type incompat = node * chain * node + +type incompatClass = + { + icId: int; + mutable icCompats: incompat list; (* A list of incompats in this class *) + mutable icNodes: (int, node * int ref) H.t; (* A hashtable indexed by + * node id; for each node also keep a count + * of how many incompats it is part of *) + } + + +(* Create a list of equivalence classes *) +let incompatEquivalence: (node * (node * edge) list) list ref = ref [] +let nrIncompatClasses = ref 0 +let nrIncompatCasts = ref 0 + +let reportIncompats (incompats: (int * int, incompat) H.t) = + incompatEquivalence := []; + nrIncompatClasses := 0; + nrIncompatCasts := 0; + let debugIncompat = false in + let icLastId = ref (-1) in (* A counter for incompat classes *) + (* Scan all incompats and construct the list of equivalence classes *) + let nodeClass: (int, incompatClass) H.t = H.create 11 in + let allClasses: (int, incompatClass) H.t = H.create 11 in + H.iter (fun _ ((n1, why_n1_n2, n2) as inc) -> + let c = chainToList why_n1_n2 in + if debugIncompat then + ignore (E.log "Processing incompat %d and %d\n" n1.id n2.id); + let theReprClass = + (* Scan first and find out the equivalence classes in which this chain + * should go (indexed by class id). This could be empty if all nodes + * are new. *) + let classes: (int, incompatClass) H.t = H.create 7 in + let markClassNode (n: node) = + (* Omit the extreme nodes *) + if n.id <> n1.id && n.id <> n2.id then begin + try + let cls = H.find nodeClass n.id in + ignore (Util.findOrAdd classes cls.icId (fun _ -> cls)) + with Not_found -> + () + end + in + List.iter + (fun (_, e) -> + markClassNode e.efrom; markClassNode e.eto) c; + let theRepr = ref None in + (* Now we must union all the classes *) + H.iter (fun _ cls -> + if debugIncompat then + ignore (E.log " already in class %d\n" cls.icId); + match !theRepr with + None -> theRepr := Some cls + | Some cls' -> + (**** UNION ****) + if debugIncompat then + ignore (E.log " unioning class %d to %d\n" cls.icId cls'.icId); + cls'.icCompats <- cls'.icCompats @ cls.icCompats; + H.remove allClasses cls.icId; + H.iter + (fun nid (nd, pCount) -> + let _, pCount' = + Util.findOrAdd cls'.icNodes nid (fun _ -> (nd, ref 0)) in + H.replace nodeClass nid cls'; + pCount' := !pCount' + !pCount) + cls.icNodes) + classes; + (* Maybe we need to create a new class *) + (match !theRepr with + None -> + incr icLastId; + if debugIncompat then + ignore (E.log "create a new class %d\n" !icLastId); + let cls = + { icId = !icLastId; icCompats = []; icNodes = H.create 5 } in + H.add allClasses !icLastId cls; + cls + + | Some cls -> cls) + in + if debugIncompat then + ignore (E.log "Found the representative class %d\n" theReprClass.icId); + (* Now add this chain to the class *) + theReprClass.icCompats <- inc :: theReprClass.icCompats; + let addIncToNode (n: node) = + if n.id <> n1.id && n.id <> n2.id then begin + H.replace nodeClass n.id theReprClass; + let _, pCount = + Util.findOrAdd theReprClass.icNodes n.id (fun _ -> (n, ref 0)) in + incr pCount + end + in + + List.iter (fun (_, e) -> addIncToNode e.efrom; addIncToNode e.eto) c; + + ) incompats; + if debugIncompat then + ignore (E.log "printing classes\n"); + (* Now we have a list of classes of incompats *) + H.iter + (fun _ cls -> + (* Find the node with maximum count, and which is not Anon *) + incr nrIncompatClasses; + let maxNode = ref None in + let maxCount = ref 0 in + H.iter (fun nid (nd, pCount) -> + if !pCount > !maxCount + && (match nd.where with PAnon _, _ -> false | _ -> true) then begin + maxNode := Some nd; + maxCount := !pCount + end) cls.icNodes; + let reprNode = + match !maxNode with + None -> dummyNode + | Some nd -> nd + in + (* Now for each incompat we collect the extreme nodes along with the + * extreme edges *) + let extremes: (int * int, node * edge) H.t = H.create 7 in + List.iter + (fun (n1, why_n1_n2, n2) -> + let c = chainToList why_n1_n2 in + if List.length c = 0 then begin + if keepDetails() then + ignore (E.warn "Chain for incompat %d and %d is empty" + n1.id n2.id) + end else begin + let _, e1 = List.nth c 0 in + let _, e2 = List.nth (List.rev c) 0 in + ignore (Util.findOrAdd extremes (n1.id, e1.eid) + (fun _ -> (n1, e1))); + ignore (Util.findOrAdd extremes (n2.id, e2.eid) + (fun _ -> (n2, e2))) + end) + cls.icCompats; + (* Now print them *) + let extremesList = ref [] in + H.iter + (fun _ (n, e) -> + incr nrIncompatCasts; + extremesList := (n, e) :: !extremesList) + extremes; + incompatEquivalence := + (reprNode, !extremesList) :: !incompatEquivalence;) + allClasses; + if !nrIncompatClasses > 0 && not (keepDetails()) then begin + ignore (E.warn "Cannot print details for the equivalence classes because you turned off the generation of the browser info") + end + + +let printGraphStats () = + (* Keep a histograph per kind *) + if !isSubtype == origSubtype then + E.s (bug "printGraphStats: isSubtype is not set\n"); + let totKind : (opointerkind, int ref) H.t = H.create 17 in + let totalNodes = ref 0 in + let unusedNodes = ref 0 in + let voidStarNodes = ref 0 in + let splitNodes = ref 0 in + let metaPtrNodes = ref 0 in + (* The number of bad casts *) + let badCastsCount = ref 0 in + let downCastCount = ref 0 in + (* All the incompats *) + let incompats: (int * int, node * chain * node) H.t = H.create 113 in + (* A list of the edges involved in bad casts, and whether or not each is + * a sequence cast. Will be sorted and printed *) + let badCastsList: (edge * bool) list ref = ref [] in + (* Index the bad casts by location because one bad bad cast can be counted + * many times (if it is in a macro). Use a separate hashtable, + * rather than badCastsList, for performance. *) + (* let badCastsLoc: (location, unit) H.t = H.create 113 in *) + let badCastsVoid = ref 0 in + let badCastsFPtr = ref 0 in + (* Keep track of spread_from_edge. For each node how many other nodes have + * WILD/spread_from_edge(n). *) + let spreadTo : (int, int ref) H.t = H.create 117 in + let examine_node id n = + incr totalNodes; + (match unrollType n.btype with + TVoid _ -> incr voidStarNodes + | _ -> ()); + (* See if it is not-used. We check that it does not have ECompat, ECast + * or ESameKind edges *) + if n.kind = Safe then begin + let isUsedEdge e = + match e.ekind with + ECast _ | ECompat _ | ESameKind _ -> true + | _ -> false + in + if not (List.exists isUsedEdge n.succ || + List.exists isUsedEdge n.pred) then + incr unusedNodes; + end; + addToHisto totKind 1 n.kind; + in + IH.iter examine_node idNode; + badCastsList := List.sort + (fun (e1, _) (e2, _) -> compareLoc e1.eloc e2.eloc) + !badCastsList; + List.iter + (fun (e, isseq) -> + incr badCastsCount; + ignore (E.log "** %d: Bad cast %sat %a (%a *%d ->%a *%d)\n" + !badCastsCount + (if isseq then "(seq) " else "") + d_loc e.eloc d_type e.efrom.btype e.efrom.id + d_type e.eto.btype e.eto.id)) + !badCastsList; + (* sm: prepend string 'ptrkinds:' so I can easily grep for this info *) + ignore (E.log "ptrkinds: Graph contains %d nodes (%d are used)\n" + !totalNodes (!totalNodes - !unusedNodes)); + (* Now subtract the unused ones *) + totalNodes := !totalNodes - !unusedNodes; + (try + let rsafe = H.find totKind Safe in + rsafe := !rsafe - !unusedNodes + with Not_found -> ()); + let percent (n: int) : float = + if !totalNodes = 0 then begin + if n <> 0 then + ignore (E.warn "Ptrnode.percent: divide by 0"); + 100.0 + end else + (float_of_int n) + /. float_of_int (!totalNodes) *. 100.0 + in + H.iter + (fun k r -> ignore (E.log "ptrkinds: %a - %d (%3.0f%%)\n" + d_opointerkind k !r (percent !r))) + totKind; + ignore (E.log "%d pointers are void*\n" !voidStarNodes); + ignore (E.log "%d bad casts of which %d involved void* and %d involved function pointers\n" + !badCastsCount !badCastsVoid !badCastsFPtr); + if !badCastsCount = 0 then + ignore (E.log "No bad casts, so no downcasts\n") + else begin + ignore (E.log "%d (%d%%) of the bad casts are downcasts\n" + !downCastCount (100 * !downCastCount / !badCastsCount)); + end ; + ignore (E.log "%d (%d%%) of the nodes are split\n" + !splitNodes (int_of_float (percent !splitNodes))); + ignore (E.log "%d (%d%%) of the nodes are have a metadata pointer\n" + !metaPtrNodes (int_of_float (percent !metaPtrNodes))); + reportIncompats incompats; + let incompatCount = ref 0 in + List.iter + (fun (n, extremes) -> + let nrExtremes = List.length extremes in + if nrExtremes > 0 then begin + ignore (E.log "%d incompatible types flow into node %a *%d\n" + nrExtremes + d_type n.btype n.id); + List.iter + (fun (n, e) -> + incr incompatCount; + ignore (E.log " Type %a *%d at %a\n" + d_type n.btype n.id d_loc e.eloc)) extremes + end) + !incompatEquivalence; + ignore (E.log "%d incompatible equivalence classes\n" !incompatCount); + H.clear totKind; + H.clear spreadTo; + () + + + + +let printInferGraph (c: out_channel) = + output_string c "#if 0\n/* Now the graph */\n"; + output_string c "/* Now the solved graph (simplesolve) */\n"; + + (* Get the nodes ordered by ID *) + let allsorted = + Stats.time "sortgraph" + (fun () -> + let all : node list ref = ref [] in + IH.iter (fun id n -> all := n :: !all) idNode; + List.sort (fun n1 n2 -> compare n1.id n2.id) !all) () + in + Stats.time "printnodes" + (List.iter (fun n -> ( + fprint c 80 (d_node () n) + ))) + allsorted; + output_string c "/* End of solved graph*/\n#endif\n"; + () + + +let printInfer (f: string) (file: Cil.file) = + begin + let c = + try open_out f (* Might throw an exception *) + with e -> E.s (E.error "Cannot open infer output file %s" f) + in + Util.tryFinally + (fun _ -> + dumpFile ccuredInferPrinter c f file; + Stats.time "printgraph" printInferGraph c) + (fun _ -> + close_out c) + () + end + +let initialize () = + H.clear placeId; + IH.clear idNode; + H.clear namedStructs; + H.clear inStruct; + lastEdgeIdx := 0; + lastNodeId := 0; (* We reserve the ID=0 to the dummyNode *) + if dummyNode.id <> 0 then + E.s (E.bug "Ptrnode:dummyNode does not have ID=0"); + (* And add the dummyNode in the graph *) + IH.add idNode dummyNode.id dummyNode; + if not !useStrings && !use_wild_solver then begin + useStrings := true; + ignore (E.warn "You must use strings when using the WILD solver! I turned them back on!"); + end; + + () diff --git a/src/infer/ptrnode.mli b/src/infer/ptrnode.mli new file mode 100644 index 0000000..6258f05 --- /dev/null +++ b/src/infer/ptrnode.mli @@ -0,0 +1,472 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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. + * + *) + +(* Initialize the pointer graph *) +val initialize: unit -> unit + +(* If defaultIsNotWild then pointers without a qualifier are SAFE and only + * the arrays that are specfically SIZED contain a size field and only the + * variables that are specifically TAGGED contain tags *) +val defaultIsWild: bool ref + +(* flag to force all functions to be untagged, in the WILD solver *) +val wild_solve_untagged_functions: bool ref + +(* flag to force all functions to be tagged, in the WILD solver *) +val wild_solve_tag_all_functions: bool ref + +(* True if the wild solver is used. *) +val use_wild_solver: bool ref + + +(** Whether we use Offset nodes. If false then we use the node stored with + * the address of a fieldinfo *) +val useOffsetNodes: bool + +(** Whether to print verbose curing output source file *) +val printVerboseOutput: bool ref + +(* Turn on/off the use of FSEQ *) +val useFSEQ: bool ref + +(** Turn on/off the use of RWSTRING, ROSTRING and NULLTERM *) +val useStrings: bool ref + +(** Whether to extend the strign buffers with the null character. If false, + * then we use the last character for the null *) +val extendStringBuffers: bool ref + +(** Whether to override user-specified annotations *) +val allowOverride: bool ref + +(** Allow partial elements in sequences *) +val allowPartialElementsInSequence: bool ref + +(** Whether to emit more details in the .infer file. *) +val emitGraphDetailLevel: int ref +val graphDetailLevelLegend: string (* The meaning of different values *) + +(* A marker that the solver places, if we use lean fats *) +val useLeanFats: bool ref + + +(* A place where a pointer type can occur *) +type place = + PGlob of string (* A global variable or a global function *) + | PType of string (* A global typedef *) + | PStatic of string * string (* A static variable or function. First is + * the filename in which it occurs *) + | PLocal of string * string * string (* A local variable. The name of the + * file, the function and the name of + * the local itself *) + | POffset of int * string (* An offset node, give the host node + * id and a field name *) + | PField of Cil.fieldinfo (* A field of a composite type *) + + | PAnon of int (* Anonymous. This one must use a + * fresh int every time. Use + * anonPlace() to create one of these + * *) + | PStr (* The global node for all string + * literals. They all have the same + * kind, so we don't need separate + * nodes.*) + | PWStr (* The global node for all wide string + * literals. *) + +type chain (* A chain of edges *) + +(* Each node corresponds to a place in the program where a qualifier for a + * pointer type could occur. As a special case we also add qualifiers for + * variables in expectation that their address might be taken *) +type node = + { id: int; (* A program-wide unique identifier *) + where: place * int; (* A way to identify where is this + * coming from. We use this to make + * sure we do not create duplicate + * nodes. The integer is an index + * within a place, such as if the + * type of a global contains several + * pointer types (nested) *) + + btype: Cil.typ; (* The base type of this pointer *) + mutable attr: Cil.attribute list; (* The attributes of this pointer + * type *) + mutable is_array: bool; (* This node is associated with an + * array, not with a pointer. *) + + mutable flags: (whyflag option) array; + + mutable succ: edge list; (* All edges with "from" = this node *) + mutable pred: edge list; (* All edges with "to" = this node *) + + (* The rest are the computed results of constraint resolution *) + mutable kind: opointerkind; + mutable why_kind: whykind; + mutable sized: bool ; (* An array may be SIZED at which + * point it has a length field + * stored right before it. This + * leads to INDEX pointers. *) + + mutable locked: bool; (* do not change this kind later *) + mutable mark: bool; (* For mark-and-sweep GC of nodes. + * Most of the time is false *) + + mutable rep : ((node * chain) option); + (* a representative pointer in this node's equivalence class. use + * this only for nodes whose btype is void. use get_rep to get the + * final representative. The chain is always from the node to the + * representative. *) + mutable loc : Cil.location; (* where did this node come from? *) + + shouldInfer: bool; (* True if this is a local or a cast + and we can do more aggressive + inference. *) + } + +(*** If you add pointer kinds, make sure you extend the definition of + * allKinds *) +and opointerkind = + Safe (* a COUNT(1) pointer *) + | Sentinel (* a COUNT(0) pointer. If a pointer is not referenced, + not NT, is not annotated SAFE, and does not use + arithmetic, it gets this kind.*) + + | Seq (* Needs lower and upper bounds *) + | FSeq (* Needs upper bound *) + + | SeqN + | FSeqN + | String (* An NT COUNT(0) pointer *) + + | UnknownN (* An NT pointer with no annotated bounds. + Inference turns this into String, FSeqN, or SeqN. + If no pkArith flag is present after solving, this + will default to String.*) + + | Unknown (* If no pkArith or pkString flag is present after solving, + this will default to Safe.*) + +and whykind = (* why did we give it this kind? *) + + (* Give the edge of a bad cast. *) + BadCast of edge + + | BadSequenceCast of edge + + | Incompat of node * chain * node (* Two nodes that should be in the same + * equivalence class are incompatible *) + + | BoolFlag of int (* Due to a flag *) + | PolyInt (* This is a void* connected only to scalars *) + | Default + | UserSpec + | Unconstrained + | PrintfArg (* printf inference *) + | Special of string * Cil.location + (* This kind is set because it is set on some other node (node1 + the + * chain:node1->this). We also give the original source of the kind. *) + | SpreadFromNode of node * chain * node + +and edge = + { eid: int; + mutable efrom: node; + mutable eto: node; + mutable ekind: edgekind; + mutable eloc: Cil.location; + } + +and whyflag = (* why is this flag set for this node? *) + | ProgramSyntax of Cil.location (* This flag was set because of the usage + * of this node in the program *) + + (* This flag is set because it is set on some other node (node1 + the + * chain:node1->this). We also give the original source of the flag. *) + | FlagSpreadFromNode of node * chain * node + + | DownCast of node + + | SubtypeFailed of node + + | RequiredByEdge of edge + + | RequiredByPointerKind of opointerkind + + | RequiredByFlag of int (* This flag is required by another flag *) + + | FlUserSpec of Cil.location + + | MayEscape of Cil.location (* We are using separate compilation, + and this node is not a local. + Therefore, we assume it can be used + by anybody. *) + + +and edgekind = + ECast of extra_edge_kind (* T_from ref q_from <= T_to ref q_to. We also + * cary some additional explanation for this + * edge. *) + | EOffset (* This is an edge added from a pointer to a + * structure to a pointer to a field. The + * destination of this edge should be either a + * POffset node or the node associated with the + * address of a field. WILDness spreads in both + * directions across this edge. *) + | EIndex (* q_to = if q_from = wild then wild else index *) +(* | ENull *) (* a NULL flows in the direction of the edge *) + | ECompat (* the kinds of these two nodes must be + * compatible: either both wild, index or + * safe. This edge type is added by the solver + * for its convenience. In cases like + * int * 1 * 2 x; + * int * 3 * 4 y; + * We will connect 1 and 3 with ECompat. *) + of chain (* the two types we were comparing when we + * decided that these had to be equal *) + | ESameKind (* Special edge that does not require + * compatibility of the types involved, but does + * require that they be of the same KIND. *) + of extra_edge_kind_sk (* See below for uses of ESameKind *) + | EPointsTo (* from's base type included to *) + | EArgs (* From the pointer to the function to the + * actual arguments and result values. Before we + * added this edge we relied on WILDness to + * spread from the function pointer to the + * actual argument by means of EPoints to edge + * to the formals and then ECast edges. But that + * did not work when there were no formals + * declared ! *) +(* More info about ECast edges *) +and extra_edge_kind = + EEK_cast (* A true cast *) + | EEK_stringdrop (* An NTDROP cast in deputy. We do not push + pkString forwards across this edge. + (pkString flows backwards as usual) *) + | EEK_cxxOverride (* Due to the Cxx inheritance. See markcxx *) + | EEK_extends (* Due to an extends relationship *) + | EEK_mkptr (* Due to a mkptr or alignseq *) + | EEK_union (* Edges added between union fields *) + | EEK_rtti (* Edges due to auto RTTI *) + +(* More info about ESameKind edges *) +and extra_edge_kind_sk = + | EEK_trustedCast (* This edge is added between the formal + * argument and the result value in an instance + * of trusted_cast function. This does not + * require compatibility of the types involved + * but does require that the two types be of the + * same KIND *) + | EEK_taggedUnion (* Behaves like an trustedCast, but is sound. + * We use this to connect union fields that must + * have the same kind in case we cast from one to + * another, but we can ignore types on these edges + * since those are checked dynamically. *) + +val mkRIdent: chain + +val mkRSingle: edge -> chain +val mkRSym: chain -> chain +val mkRTrans: chain -> chain -> chain + +val isSym: chain -> chain option + +val getOneEdge: chain -> edge option + +val isOneEdge: chain -> edge option + +val get_rep : node -> node (* find the representative of this node's + * equivalence class *) + +val join : node -> node -> chain -> unit + (* join these two nodes into the same equivalence class because of + * the given edge. *) + +val doCheckChains: bool (* Whether to check the chains *) +val checkChainEnds: node -> node -> chain -> unit + +val get_rep_why : node -> node * chain + (* given a node, return the list of edges that join'd it to its + * representative *) + +val setFlag : node -> int -> whyflag -> unit +val hasFlag : node -> int -> bool + +(* Given a flag for a node, produce the original node where the flag + * originates, the true chain why it originates, and the chain:orig->this *) +val trueSourceOfFlag: node -> int -> node * whyflag * chain + +(* Given a flag for a node, produce the original node where the flag + * originates, the true chain why it originates, and the chain:orig->this *) +val trueSourceOfKind: node -> node * whykind * chain + +val pkInterface: int (* this is an interface node *) +val pkUpdated: int (* we write through this pointer *) +val pkIntCast: int (* can contain an integer *) +val pkPosArith: int (* subject to positive pointer arithmetic *) +val pkArith: int (* subject to arbitrary pointer arithmetic *) +val pkString: int (* A String node *) +val pkReachIndex: int (* can reach an Index node *) +val pkNoPrototype: int (* Used as actual argument in a function without + * prototype *) +val pkEscape: int (* can "escape" i.e. be assigned to a global or through a + * pointer *) +val pkNotSafe: int (* constraint used by solvers: node must not be Safe *) + +val pkReferenced: int (* might be eventually referenced *) + +val pkRtti: int (* has run-time type information *) +val pkCompatWithScalars: int (* void* node is compat with scalars *) +val pkStack: int (* Could point to the stack; CHECK_STORE_PTR needed. *) + +val pkOneWord: int (* This is specified by the user to be one word *) + +val pkLastFlag: int +val pkNumberOfFlags: int + +(* The names for the flags *) +val pkFlagName: string array + +(* One certain types can have RTTI *) +val canHaveRtti: Cil.typ -> bool + + +(** All the pointer kinds *) +val allKinds: opointerkind list + +(* The main graph *) +val idNode: node Inthash.t + +val dummyNode: node (* A node with ID=0. Use when you don't have one *) + +(* Get a node for a place and an index. Give also the base type and the + * attributes *) +val getNode: p:place -> idx:int -> bt:Cil.typ -> al:Cil.attribute list -> node + +(* Make a new node *) +val newNode: p:place -> idx:int -> bt:Cil.typ -> al:Cil.attribute list -> node + +(** Recompute the EPointsTo information for a node *) +val setNodePointsTo: node -> unit + +(* Make a new anonymous place *) +val anonPlace: unit -> place + +(** A bitwise-or of the flags that are pushed to the predecessor of a node + * (backward) and always through the ECompat edges *) +val pkCastPredFlags: int list + +(** A bitwise-or of the flags that are pushed to the successor of a node + * (forward) and always through the ECompat edges *) +val pkCastSuccFlags: int list +val pkCastSuccFlagsNoString: int list +val pkCNIPredFlags: int list +val pkCNIPredFlagsNoString: int list +val pkOffsetSuccFlags: int list +val pkOffsetPredFlags: int list +val allFlags: int list + +val d_opointerkind: unit -> opointerkind -> Pretty.doc +val d_whykind: node -> unit -> whykind -> Pretty.doc +val d_whyflag: node -> unit -> whyflag -> Pretty.doc +val d_node: unit -> node -> Pretty.doc +val d_place: unit -> place -> Pretty.doc +val d_place_nice: unit -> (place * int) -> Pretty.doc +val d_chain: unit -> chain -> Pretty.doc + +val ccuredInferPrinter: Cil.cilPrinter + +(*val printBrowser: string -> Cil.file -> unit*) +val printInfer: string -> Cil.file -> unit +val printInferGraph: out_channel -> unit + +val printGraphStats: unit -> unit + +(* Helpers for printGraphStats *) +val addToHisto: ('a, int ref) Hashtbl.t -> int -> 'a -> unit +val getHisto: ('a, int ref) Hashtbl.t -> 'a -> int + +val existsEdge: start:node -> dest:node -> kind:edgekind -> bool + +(* Add an edge to the graph *) +val addEdge: start:node -> dest:node -> kind:edgekind -> + eloc:Cil.location option -> edge + +val removeEdge: edge -> unit + +val isECompat: edge -> bool +val isECast: edge -> bool +val isESameKind: edge -> bool + + +val nodeOfAttrlist: Cil.attribute list -> node option + +(* The inferred kind for this node. If localOnly is true and the node is not + * local, then return Unknown *) +val inferredKindOf: ?localOnly:bool -> + Cil.attribute list -> opointerkind * whykind + + +(* The kind of this pointer. If there is no BND attribute, + defaults to inferredKind *) +val kindOfAttrlist: Cil.attribute list -> opointerkind * whykind + +val kindIsNullterm: opointerkind -> bool +val kindNeedsBounds: opointerkind -> bool + +(* Replace the ptrnode attribute with the actual qualifier attribute *) +type whichAttr = + AtPtr (* In a pointer type *) + | AtArray (* In an array type *) + | AtOpenArray (* In an array type without a size *) + | AtVar (* For a variable *) + | AtOther (* Anything else *) + +val replacePtrNodeAttrList: which:whichAttr + -> Cil.attribute list -> Cil.attribute list + +val k2attr: opointerkind -> Cil.attribute + +(** Return the numeric identifier of the kind *) +val k2number: opointerkind -> int + +(** The parent in the points-to relationship *) +val nodeThatPointsTo: node -> node option + + +(** A function pointer that can be used to compare two types *) +val isSubtype: (Cil.typ -> Cil.typ -> bool) ref + diff --git a/src/infer/solver.ml b/src/infer/solver.ml new file mode 100644 index 0000000..c583b2a --- /dev/null +++ b/src/infer/solver.ml @@ -0,0 +1,911 @@ +(* + * + * Copyright (c) 2001-2006, + * Wes Weimer + * George C. Necula + * Scott McPeak + * 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. + * + *) + +(* Weimer + * + * CCured pointer kind inference using an extension of the algorithm + * described in the paper submitted to PLDI'02. + * + * INPUT ASSUMPTIONS: + * + * The node hashtable includes the following edges: + * n1 ECAST n2 for the top-level nodes of casts + * n1 EOFFSET n2 from the top of a struct to its non-array fields + * n1 EINDEX n2 from the top of a struct to array fields + * + * Nodes have the following bits set iff the corresponding fact actually + * originate at that node: + * pkPosArith + * pkArith + * pkNull + * pkUpdated + * pkIntCast + * pkInterface + * pkSized + * pkNoPrototype (makes a function node wild) + * + * The "is_p x y" function returns true if x--cast-->y is from a polymorphic + * function and should not be considered. + * + * Returns "true" if we should typecheck the result because we let some + * user-annotated qualifier stand. + *) +(* + * How does the solver work? + * + * We treat every "void *" as a separate type variable and we keep + * equivalence classes of void* nodes that are connected by ECast or + * ECompat edges. ECast edges come from Markptr as part of our + * precondition. We create ECompat edges. + * + * (1) We examine every CAST in the program. While scanning the + * types to see if the cast is valid we add ECompat edges between + * inner types that must be equal and mark as Wild types that + * do not match up. We also mark nodes as Not Safe in casts where + * the sizes are wrong. + * (2) Check equivalence classes. All nodes joined by ECompat edges must + * have equal types. Make sure all nodes in all equiv classes have + * the same flags. + * (3) We assign base-case flags. For example, we assign + * "pkString" to nodes that are of type string. + * (4) We push those flags around using standard data-flow tricks. Nodes + * connected by ECompat edges have identical flags. + * (5) Once we have all the flags in place we distinguish between all + * the kinds of sequences. For example, a node that cannot be safe + * and has an integer cast into it but does not reach a string becomes + * FSEQ. + * (6) We turn all string-like nodes that lead only into ROString nodes + * into ROString nodes themselves. Note all nodes connected by ECompat + * edges must have the same kind. + * (7) We push WILD as far as it can go. Generally WILD contaminates all + * outgoing edges and all points-to targets, however an edge from + * WILD to ROString is allowed. + * (8) All otherwise unconstrainted nodes become SAFE. + * + * Compared to previous solvers, this solver is much stricter about + * strings. No "safe -> string" or "safe -> rostring" casts should remain. + *) + +open Cil +open Ptrnode +open Pretty +open Trace +module E = Errormsg +module IH = Inthash + +let verbose = Doptions.verbose + +(* Added for compatibility with Deputy's warnings. *) +let warnLoc (loc : location) (fmt : ('a,unit,doc) format) : 'a = + let f d = + let saveLoc = !currentLoc in + currentLoc := loc; + Dutil.warn "%a" insert d; + currentLoc := saveLoc; + nil + in + Pretty.gprintf f fmt + +let bitsSizeOfOpt tau = + try Some(bitsSizeOf tau) + with SizeOfError _ -> None + +(* Euclid's algorithm for the GCD *) +let rec gcd a b = + if a = 0 || b = 0 then 1 + else if b > a then gcd b a + else match a mod b with + 0 -> b + | r -> gcd b r + +(* go through the source code and find where tau was declared *) +class findTypeVisitor tau = object + inherit nopCilVisitor + val tau_sig = typeSig tau + method vtype some_type = + if tau_sig = typeSig some_type then + ignore (warn "type %a was not given a node by markptr" d_type tau) ; + DoChildren +end + +(* equiv classes of nodes connected by ECompat edges. *) +module OrderedNode = + struct + type t = node + let compare n1 n2 = n1.id - n2.id + (* Avoid using Pervasives.compare, which is the same as "=", which may + * loop forever because nodes contain "Cil.typ"s. *) + end +module NodeSet = Set.Make(OrderedNode) +module NodeUF = Unionfind.Make(NodeSet) + + +(* + ** + *** The Solver! + ** + *) +let solve (the_file : Cil.file) (node_ht : node Inthash.t) : unit = begin + let node_eq = ref (NodeUF.empty) in (* ECompat equivalence classes *) + + let existsECompatEdge ~(start : node) ~(dest : node) = + List.fold_left (fun acc e -> acc || + (e.eto.id = dest.id && match e.ekind with ECompat _ -> true | _ -> + false)) false start.succ + in + + (* Spread a flag from one node to another one *) + let spreadFlag (f: int) (from: node) (why_from_to: chain) (nto: node) = + if not (hasFlag nto f) then begin + let orig, _, _ = trueSourceOfFlag from f in + setFlag nto f (FlagSpreadFromNode(from, why_from_to, orig)) + end + in + + + (* Say that n1 and n2 (which are usually matching inner pointers) must + * really be equal. This adds an ECompat edge between them and places + * them in the same equivalence class. We avoid making duplicate edges. + * We know if this edge is for inner pointers. Otherwise it is for void* + * equivalence classes *) + let rec addECompatEdge (isinner: bool) n1 n2 why_n1_n2 location = + if existsECompatEdge n1 n2 || + existsECompatEdge n2 n1 || + n1.id = n2.id then + () + else begin + (* Sometimes it might be convenient to swap the nodes in order to keep + * the explanations shorter. *) + let n1, n2, why_n1_n2 = + match isSym why_n1_n2 with + Some why_n2_n1 -> n2, n1, why_n2_n1 + | _ -> n1, n2, why_n1_n2 + in + + if doCheckChains then + checkChainEnds n1 n2 why_n1_n2; + + (* matth: I had originally removed this line from Deputy. + Does it break anything? *) + ignore(addEdge n1 n2 (ECompat why_n1_n2) (Some(location))); + + (* We only join in the equivalence classes (maintained through the .rep + * fields) if at least one is TPtr(void). OTherwise we use the NodeUF + * equivalence classes *) + if (isVoidType n1.btype || isVoidType n2.btype) then begin + join n1 n2 why_n1_n2 + end else + node_eq := NodeUF.make_equal (!node_eq) n1 n2 why_n1_n2 ; + end + in + + (* whenever we have to "loop until things settle", we used + * finished to keep track of our status *) + let finished = ref false in + + (* update changes node "n"'s kind to "k" because of "w" and sets + * finished to false. It also does logging and sanity checking. *) + let update n k w = begin + if (k <> n.kind) then begin + (* Check if the new kind is stronger than the old one *) + let shouldUpdate: bool = + match k, n.kind with + _, Unknown -> true (* Unknown is weakest *) + | Unknown, _ -> false + | _, Sentinel -> true (* Sentinel is next *) + | Safe, _ -> false (* this means Safe can only replace Unknown or + Sentinel *) + (* Strings replace non-strings *) + | String, (UnknownN|Safe) -> true + | FSeqN, (Seq|FSeq|Safe) -> true + | SeqN, (Seq|FSeq|Safe) -> true + + (* Seq replaces FSeq, which in turn replaces SAFE, + unless the user specified otherwise *) + | (Seq|SeqN), (FSeq|FSeqN|Safe|String|UnknownN) -> + n.why_kind <> UserSpec + | (FSeq|FSeqN), (Safe|String|UnknownN) -> + n.why_kind <> UserSpec + + | _, _ -> false + in + if shouldUpdate then begin + (* The new kind is stronger. We must update. *) + let trulyUpdate = + if n.why_kind = UserSpec then + if !allowOverride then begin + (* matth: If the user annotates a node as __RTTI + * and we infer it to be FSeqR or SeqR, assume that that's what + * the user intended, and don't print a warning. *) + (match n.kind, k with + | FSeq, FSeqN + | Seq, SeqN -> () + | _ -> ignore (warnLoc n.loc + "Solver: Changing User Specified %a node %d (%a) to %a." + d_opointerkind n.kind n.id + d_place_nice n.where + d_opointerkind k)); + true + end else begin + (* Use "ignore" so that we do not stop here. But we'll stop + * after solving *) + E.hadErrors := true; + ignore (errorLoc n.loc + "Solver: Should change User Specified %a node %d (%a) to %a." + d_opointerkind n.kind n.id + d_place_nice n.where + d_opointerkind k); + false + end + else + true (* If it is not User_Spec then always update *) + in + if trulyUpdate then begin + n.kind <- k ; + n.why_kind <- w ; + finished := false + end + end + end else (* Already have the same kind *) + () + end + in + + (* Help Function: find the attributes of a type *) + let node_of_type tau = + nodeOfAttrlist (typeAttrs tau) + in + + (* Step 0 + * ~~~~~~ + * Our first pass over the set of nodes. + * Set all of the flag starting conditions that we know about. + *) + if !verbose then ignore (E.log "Solver: Step 0 (Base Case)\n") ; + + + (* loop over all the nodes ... *) + IH.iter (fun id n -> + (* calling a function without a prototype makes it wild *) + if hasFlag n pkNoPrototype then begin + Dutil.errorwarn "You passed too many arguments to a function (see above). We should make the function WILD."; + end ; + + begin + match n.kind with + | String when !useStrings -> + setFlag n pkString (RequiredByPointerKind n.kind); + setFlag n pkOneWord (FlUserSpec n.loc) + + | FSeq + | Seq -> () + + | FSeqN + | SeqN + | UnknownN when !useStrings -> + setFlag n pkString (RequiredByPointerKind n.kind) + + | Safe -> setFlag n pkOneWord (FlUserSpec n.loc) + + | _ -> () + end ; + + if hasAttribute "size" n.attr || hasAttribute "count" n.attr then + setFlag n pkOneWord (FlUserSpec n.loc); + + ) node_ht ; + + (* Step 1 + * ~~~~~~ + * Consider every cast. + * + * Generate ECOMPAT edges between aligned sub-pointers. + * Generate BADCAST constaints on failed pointers (make 'em WILD) + * Generate ARITH constaints on upcasts (make 'em not SAFE). + *) + if !verbose then ignore (E.log "Solver: Step 1 (Casts)\n") ; + + let the_edge = ref None in + + (* Whenever we compare two types for equality we should mark all + * matching inner pointers with ECOMPAT edges. This function is called + * by the type-scanning phase on all pairs of pointers that should + * match up. *) + let handle_inner_pointers loc explanation tau1 tau2 = + try begin + match (node_of_type tau1),(node_of_type tau2) with + | Some(n1),Some(n2) -> + addECompatEdge true n1 n2 explanation loc; + + | Some(n),None + | None,Some(n) when (isVoidType n.btype) -> begin + (* Link a "void*" equivalence class with the scalars. *) + setFlag n pkCompatWithScalars (FlagSpreadFromNode(n,explanation,n)) ; + let (nr,why_n_nr) = get_rep_why n in + setFlag nr pkCompatWithScalars (FlagSpreadFromNode(n,why_n_nr,n)) + end + + | _,_ -> (* in this unfortunate case, we don't know how to get + * to the nodes of these types. Try to print a useful error + * message *) + begin + if node_of_type tau1 = None then + ignore (visitCilFile (new findTypeVisitor tau1) the_file) ; + if node_of_type tau2 = None then + ignore (visitCilFile (new findTypeVisitor tau2) the_file) ; + + E.s (E.bug "Solver: cannot link inner pointers:@!%a@!%a@!%a\n" + d_type tau1 d_type tau2 + (docOpt (fun e -> + dprintf "%d->%d" e.efrom.id e.eto.id)) !the_edge) + end + end with e -> begin + ignore (E.warn "handle_inner_pointers raises %s\n" + (Printexc.to_string e)) + end + in + (* This function is called by type comparison functions in Type.ml when the + * base types of two pointer types fails to compare properly. This function + * should be called on representatives only. *) + let handle_failure n1 why_n1_n2 n2 = + if n1.rep != None then + E.s (E.bug "handle_failure called on node %d which is not a representative" + n1.id); + if n2.rep != None then + E.s (E.bug "handle_failure called on node %d which is not a representative" + n2.id); + in + (* + * Step 1 Loop : examine every cast + *) + (* Sometimes we might need to create new ECast edges for auto RTTI. + * Remember them here *) + let step1_oneEdge e = (* look at every forward edge *) + the_edge := Some(e) ; + if isECast e then begin + if Type.debugType then + ignore (E.log "Considering Edge %d->%d\n" e.efrom.id e.eto.id); + + let from_rep, why_efrom_frep = get_rep_why e.efrom in + let to_rep, why_eto_trep = get_rep_why e.eto in + let from_rep_t = from_rep.btype in + let to_rep_t = to_rep.btype in + (* explanation: from_rep -> e.efrom -> e.eto -> to_rep *) + let why_frep_trep = + mkRTrans (mkRSym why_efrom_frep) + (mkRTrans (mkRSingle e) why_eto_trep) in + + (* Deal with void* casts. *) + if (isVoidType from_rep_t || isVoidType to_rep_t) then begin + let from_rep_is_void = isVoidType from_rep_t in + let to_rep_is_void = isVoidType to_rep_t in + + (* If one of the representatives types is void_ptr, + * and we are doing void* inferrence on this node, + * then we just add an ECompat edge and join the classes. + * If BOTH nodes are void*, only add the ECompat if we're doing + * inference on both of them. *) + if ( (from_rep_is_void || to_rep_is_void) + && (e.eto.shouldInfer || not to_rep_is_void) + && (e.efrom.shouldInfer || not from_rep_is_void)) then + addECompatEdge false from_rep to_rep why_frep_trep e.eloc + end else begin + (* Not a cast involving void*. Just go ahead and check the types *) + let from_size = try bitsSizeOf(from_rep_t) with SizeOfError _ -> 1 in + let to_size = try bitsSizeOf(to_rep_t) with SizeOfError _ -> 1 in + if from_size < to_size then begin + setFlag e.efrom pkNotSafe (DownCast e.eto); (* ARITH constraint *) + end ; + + Stats.time "subtype" (fun () -> + if not (Type.subtype + ~compat:(handle_inner_pointers e.eloc) + ~failure:(handle_failure) + ~why_small_big:(mkRSym why_frep_trep) + ~small:to_rep_t + ~big:from_rep_t) + then begin (* they are not subtypes *) + (* We do *NOT* pass polymorphic_replace to Type.all_scalars + * because we have already replaced the top-level void*s + * (with to_rep and from_rep). p_r would just replace any + * void*s in to_rep_type and from_rep_type -- but if there + * are any void*s in to_rep_type or from_rep_type then we + * don't want to say that it was "all scalars" here. In + * particular, this could happen in a case like: + * int i = 5 __1 ; + * void *__2 *__3 v = ( void *__4 *__5 )&i; + * Between 3 and 5. 4 will have the pkCompatWithScalars flag, + * but we don't to make 2 and 4 FSEQ here. *) + if (Type.all_scalars to_rep_t) && (Type.all_scalars from_rep_t) + (* if it must be compatible with scalars and we failed the + * subtyping then it must be WILD! *) + then begin + (* ARITH constraint *) + (* GN: Subtyping failed but they are all scalars. In that + * case all we need is the the origin node is not SAFE. I + * commented out the next line. *) + (* setFlag e.eto pkNotSafe (SubtypeFailed e.efrom) ; *) + setFlag e.efrom pkNotSafe (SubtypeFailed e.eto) ; + (* In this one special case, we'll infer that the two + * types should be SEQ *) + end else begin + handle_failure from_rep why_frep_trep to_rep + end + end + ) () + end + end else if e.ekind = EIndex then begin + (* while we're here, these arrays cannot be safe *) + setFlag e.eto pkNotSafe (RequiredByEdge e); + end + in + IH.iter (fun id cur -> + List.iter step1_oneEdge cur.succ ; (* look at every forward edge *) + the_edge := None ; + (* Set user-specified flags *) + match cur.kind with + Seq | SeqN -> + setFlag cur pkArith (RequiredByPointerKind cur.kind) ; + setFlag cur pkReferenced (RequiredByPointerKind cur.kind) ; + | FSeq | FSeqN -> + setFlag cur pkPosArith (RequiredByPointerKind cur.kind) ; + setFlag cur pkReferenced (RequiredByPointerKind cur.kind) ; + | Safe | String | UnknownN -> + setFlag cur pkReferenced (RequiredByPointerKind cur.kind) ; + | Unknown | Sentinel -> () + ) node_ht ; + + + (* Step 2 + * ~~~~~~ + * Skipped in Deputy! + *) + + + (* Step 3 + * ~~~~~~ + * Check our equivalence classes for consistency. + * + * All "void *" equivalence class nodes should have an ECompat edge to + * their rep. The rep has the flags for the whole class. + * + * All nodes in "void*" equivalence classes should link up everything + * they point to in "void*" equivalence classes as well. + * + * All nodes in equiv classes should have the same flags. + *) + (* First we add transitive closure of the ECast edges on "void *" *) + if !verbose then ignore (E.log "Solver: Step 3 (equiv)\n") ; + + let check_compat_fun e = + match e.ekind with + ECompat r -> + let to_t = e.eto.btype in + let from_t = e.efrom.btype in + (* Leave alone the edges that have a void-ptr !! *) + if isVoidType to_t || isVoidType from_t then + () + else begin + the_edge := Some(e) ; + if (not (Stats.time "subtype" + (fun () -> Type.equal + ~compat:(fun _ _ _ -> ()) (* gn: why ? *) + ~failure:(handle_failure) + ~why_t1_t2: r + ~t1:from_t + ~t2:to_t) ())) then + handle_failure e.eto r e.efrom; + + the_edge := None ; + end; + | _ -> () + + in + + Stats.time "equiv-check" + (IH.iter (fun id cur -> + let rep, why_cur_rep = get_rep_why cur in + + (* Check to see if any equivalence classes must be compatible with + * scalars AND ALSO with some non-void type. If so, that class becomes + * WILD. *) + if ( hasFlag cur pkCompatWithScalars && + not (hasFlag rep pkCompatWithScalars)) then begin + E.s (E.bug "Solver: node %d has pkCompatWithScalars flag but its rep %d does not" cur.id rep.id) + end ; + + if hasFlag rep pkCompatWithScalars && not (isVoidType rep.btype) then begin + ignore (warnLoc rep.loc "Solver: BAD CAST / EQ-SCALAR@!%a" + d_type rep.btype) + end ; + + if doCheckChains then + checkChainEnds cur rep why_cur_rep; + if rep != cur then begin + for i = 0 to pkLastFlag do + (* The RTTI flag is spread while the edges are being created *) + if i <> pkRtti && hasFlag cur i then + spreadFlag i cur why_cur_rep rep + done ; + end; + (* Once for each edge *) + List.iter check_compat_fun cur.succ ; + (* List.iter check_compat_fun cur.pred ; *) + )) node_ht ; + + (* Now we have equivalence classes of ECompat-joined nodes *) + let compat_eq_classes = NodeUF.eq_classes !node_eq in + + (* + * Step 3 Loop #2 : examine each "void *" equiv class + *) + + (* share all flags within equivalence classes *) + List.iter (fun eq_class -> + List.iter (fun from_elt -> + List.iter (fun to_elt -> + for i = 0 to pkLastFlag do + (* The RTTI flag is spread while the edges are being created *) + if i <> pkRtti && hasFlag from_elt i then + if not (hasFlag to_elt i) then + let why_from_to = NodeUF.why_equal !node_eq from_elt to_elt in + if doCheckChains then + checkChainEnds from_elt to_elt why_from_to; + spreadFlag i from_elt why_from_to to_elt + done ; + if (to_elt.why_kind = UserSpec) then begin + from_elt.kind <- to_elt.kind ; + from_elt.why_kind <- to_elt.why_kind + end ; + if (from_elt.why_kind = UserSpec) then begin + to_elt.kind <- from_elt.kind ; + to_elt.why_kind <- from_elt.why_kind + end ; + if (to_elt.why_kind = Default && from_elt.why_kind <> Default) then + to_elt.why_kind <- from_elt.why_kind + ) eq_class + ) eq_class + ) compat_eq_classes ; + + + (* Step 4 + * ~~~~~~ + * Push all of the boolean flags around. + *) + if !verbose then ignore (E.log "Solver: Step 4 (Data-Flow)\n") ; + (* loop over all the nodes ... *) + finished := false ; + + let worklist = Queue.create () in + + (* Find edge chain *) + let findEdgeChain (src: node) (e: edge) = + (* Find the chain src -> dst *) + let r1 = + match e.ekind with + ECompat r' -> r' + | _ -> mkRSingle e + in + (* Check that this edge has src as one of its ends *) + if doCheckChains && src.id <> e.efrom.id && src.id <> e.eto.id then + ignore (E.warn "findEdgeChain for src=%d and edge %d->%d\n" + src.id e.efrom.id e.eto.id); + (* See if the edge is going in the right direction *) + if e.efrom.id = src.id then r1 else mkRSym r1 + in + + + let setFlagsFromListChain dst src r_src_dst lst = + if doCheckChains then + checkChainEnds src dst r_src_dst; + List.iter (fun i -> + (* The RTTI flag is spread while the edges are being created *) + if i <> pkRtti && hasFlag src i && not (hasFlag dst i) + (* Do not spread the intCast flag to RTTI pointer *) + && (i <> pkIntCast || not (hasFlag dst pkRtti)) then begin + Queue.add dst worklist ; + spreadFlag i src r_src_dst dst + end + ) lst + in + + let setFlagsFromList dst src e lst = + let r_src_dst = findEdgeChain src e in + setFlagsFromListChain dst src r_src_dst lst + in + + let processDataFlow cur = begin + (* First consider all ECompat edges: + * flags should be equal across them. This is motivated by + * test/small1/apachebuf.c. Merely making ECompat-linked nodes have + * the same kind does not suffice: a pred of an ecompat-linked node + * may need to be made FSEQ because of a posarith on the other side + * of the ecompat link. *) + let inner_fun e = + if isECompat e || isESameKind e then begin + setFlagsFromList e.efrom e.eto e allFlags ; + setFlagsFromList e.eto e.efrom e allFlags ; + end + in + List.iter inner_fun cur.pred ; + List.iter inner_fun cur.succ ; + + (* Consider all Successor Edges, do data-flow *) + List.iter (fun e -> + (match e.ekind with + | ECast extra_kind -> + (* We do not propagate the pkString flag in the following cases: + * 1. The user explicitly dropped the NT flag. + * 2. The target is user-specified, in which case we do not want + * to override the user's choice. + * 3. The source is a non-local and non-cast (e.g., an argument) + * and it was not specified NT by the user. This check + * prevents NT from flowing into a function without the + * user's permission. *) + if extra_kind = EEK_stringdrop || e.eto.why_kind = UserSpec || + (e.efrom.why_kind <> UserSpec && not e.efrom.shouldInfer) then + setFlagsFromList e.eto cur e pkCastSuccFlagsNoString + else + setFlagsFromList e.eto cur e pkCastSuccFlags; + + (* If the successor node is referenced and we have the pkString + * flag, we propagate pkPosArith and pkArith flag to successor. We + * want to make sure that the accesses to these pointers will be + * checked against the bound, not using the NULLTERM functions *) + if hasFlag cur pkString && not (hasFlag e.eto pkOneWord) then + setFlagsFromList e.eto cur e [ pkPosArith; pkArith ] + + | EOffset -> + setFlagsFromList e.eto cur e pkOffsetSuccFlags ; + | _ -> ()) ; + ) cur.succ ; + + (* Consider all Predecessor Edges, do data-flow *) + List.iter (fun e -> + (match e.ekind with + ECast extra_kind -> (* track [F]SEQ information *) + setFlagsFromList e.efrom cur e pkCastPredFlags ; + + (* See comment above for explanation. *) + if e.efrom.why_kind = UserSpec || + (e.eto.why_kind <> UserSpec && not e.eto.shouldInfer) then + setFlagsFromList e.efrom cur e pkCNIPredFlagsNoString + else + setFlagsFromList e.efrom cur e pkCNIPredFlags; + | EIndex -> setFlagsFromList e.efrom cur e pkCNIPredFlagsNoString ; + | EOffset -> + setFlagsFromList e.efrom cur e pkOffsetPredFlags ; + | _ -> ()) ; + ) cur.pred ; + + end + in + + Stats.time "data-flow" (fun () -> + (* data-flow can actually take some time, so we'll use a work-list *) + IH.iter (fun id cur -> processDataFlow cur) node_ht; + while (Queue.length worklist > 0) do + (* first, run normal data-flow *) + while (Queue.length worklist > 0) do + let cur = Queue.take worklist in + processDataFlow cur + done ; + (* If one array has been compared against another, they must share + * the same flags. Notably, if you have: + * struct { int __INDEX a[8]; } *p; + * struct { int b[8]; } *q = p; + * we want b to end up being INDEX as well. *) + Hashtbl.iter (fun (t1,t2) why -> + let n1 = node_of_type t1 in + let n2 = node_of_type t2 in + match n1,n2 with + | Some(n1),Some(n2) -> + setFlagsFromListChain n1 n2 why [pkReachIndex] ; + setFlagsFromListChain n2 n1 (mkRSym why) [pkReachIndex] + | _ -> + ignore (E.warn "solver: cannot set flags equal for arrays %a and %a" + d_type t1 d_type t2) + ) Type.arraysThatHaveBeenComparedWithArrays ; + (* If this array step didn't update anything, we'll fall out of the + * outer loop and be done with data-flow. Otherwise we do it all + * again. *) + done + ) () ; + + + (* Step 5 + * ~~~~~~ + * Distinguish between sequences. We must do this after boolean flags + * (otherwise we cannot tell what reaches what, etc.) but before we do + * WILDs (because they interact with read-only strings). + * + * Also generate ARITH constraints: q != SAFE. + *) + if !verbose then ignore (E.log "Solver: Step 5 (sequences)\n") ; + + (* n is a polymorphic "void *" node if it points to void* and its + * representative points to void* as well. *) + let is_polymorphic_voidstar n = + match n.btype, (get_rep n).btype with + TVoid _ , TVoid _-> true + | _ -> false + in + + IH.iter (fun id cur -> + (* Generate "ARITH" style constraints: q != SAFE *) + List.iter (fun f -> + if hasFlag cur f then setFlag cur pkNotSafe (RequiredByFlag f) + ) [pkArith ; pkPosArith ] ; + + if hasFlag cur pkIntCast then + setFlag cur pkNotSafe (RequiredByFlag pkIntCast) ; + + if hasFlag cur pkString && not !useStrings then + E.s (bug "we are not using strings but node %d has the pkString flag" + cur.id); + + if hasFlag cur pkNotSafe || + hasFlag cur pkString || + hasFlag cur pkReachIndex then + begin + let new_kind,why = + if (hasFlag cur pkReachIndex) then + E.s (bug "no Index in Deputy") + else if hasFlag cur pkArith then + (if hasFlag cur pkString then SeqN else Seq),BoolFlag pkArith + + else if hasFlag cur pkPosArith then + (if hasFlag cur pkString then + (if !useFSEQ then FSeqN else SeqN) + else + (if !useFSEQ then FSeq else Seq)), BoolFlag pkPosArith + + (* NOT: pkReachIndex, pkReachSeq, pkPosArith, pkArith *) + else if hasFlag cur pkIntCast then + begin + if is_polymorphic_voidstar cur then + Safe, PolyInt + else + (if hasFlag cur pkString then FSeqN else FSeq), + BoolFlag pkIntCast + end + else if hasFlag cur pkString then + String, BoolFlag pkString + + (* NOT: pkString *) + else if hasFlag cur pkNotSafe then + (if !useFSEQ then FSeq else Seq), BoolFlag pkNotSafe + + else begin + E.s (bug "Unexpected combination of flags for node %d: %a\n" + cur.id + (docArray ~sep:nil + (fun idx elm -> + match elm with + None -> nil + | Some _ -> text ("\n\t" ^ pkFlagName.(idx)))) cur.flags) + end + in + update cur new_kind why + end + ) node_ht ; + + (* Step 7 + * ~~~~~~ + * Verify that SEQ-SEQ casts have the correct tiling. For example: + * struct A { int f1; } * __SEQ p1; + * struct B { int f2; int *f3; } * __SEQ p2; + * p1 = p2 ; + * This must result in WILD pointers, otherwise (p1++)->f1=5, *p2->f3 = 6 + * causes a crash. + *) + if !verbose then ignore (E.log "Solver: Step 7 (SEQ-SEQ Tiling)\n") ; + let isSeqish n = match n.kind with + Seq | SeqN | FSeq | FSeqN -> true + | _ -> false + in + Stats.time "seq-seq checking" (fun () -> + IH.iter (fun id cur -> + List.iter (fun e -> + if isECast e && isSeqish cur && isSeqish e.eto then begin + let from_target = (get_rep cur).btype in + let to_target = (get_rep e.eto).btype in + if isVoidType from_target || isVoidType to_target then + () + else begin + (* check for tiling! *) + let okay = + match bitsSizeOfOpt from_target, bitsSizeOfOpt to_target with + Some(from_size) ,Some(to_size) -> + let the_gcd = gcd from_size to_size in + let from_factor = to_size / the_gcd in + let to_factor = from_size / the_gcd in + Type.equal + ~compat:(fun _ _ _ -> ()) + ~failure:(fun _ _ _ -> ()) + ~why_t1_t2: mkRIdent + ~t1:(TArray(from_target, Some(integer from_factor), [])) + ~t2:(TArray(to_target, Some(integer to_factor), [])) + | _ -> + Type.equal + ~compat:(fun _ _ _ -> ()) + ~failure: (fun _ _ _ -> ()) + ~why_t1_t2: mkRIdent + ~t1:from_target + ~t2:to_target + in + if not okay then begin + ignore (warnLoc e.eloc "Solver: BAD CAST / SEQ-SEQ@! %a@!<- %a" + d_type to_target d_type from_target) + end + end + end + ) cur.succ + ) node_ht) () ; + + (* Step 8 + * ~~~~~~~ + * All other nodes are Safe, String, or Sentinel. + *) + if !verbose then ignore (E.log "Solver: Step 8 (Safe)\n") ; + IH.iter (fun id n -> + (* Replace Unknown/referenced with Safe, + Unknown/unreferenced with Sentinel, + and UnknownN with String *) + if n.kind = Unknown then begin + if hasFlag n pkReferenced then + update n Safe Unconstrained + else + update n Sentinel Unconstrained + end else if n.kind = UnknownN then begin + update n String Unconstrained + end ; + + (* Sanity Check! Typecheck.ml does much more than this. *) + if n.kind = Safe && + (hasFlag n pkNotSafe || + hasFlag n pkString || + hasFlag n pkReachIndex || + hasFlag n pkIntCast) && + not (n.why_kind = UserSpec) && + not (is_polymorphic_voidstar n) then begin + E.s (E.bug "Solver: botched node (left/made it safe) %d (%a)" + n.id d_place_nice n.where) + end ; + + ) node_ht +end diff --git a/src/infer/solver.mli b/src/infer/solver.mli new file mode 100644 index 0000000..6c397ea --- /dev/null +++ b/src/infer/solver.mli @@ -0,0 +1,38 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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 solve: Cil.file -> Ptrnode.node Inthash.t -> unit diff --git a/src/infer/type.ml b/src/infer/type.ml new file mode 100644 index 0000000..a48abb5 --- /dev/null +++ b/src/infer/type.ml @@ -0,0 +1,845 @@ +(* + * + * Copyright (c) 2001-2006, + * Wes Weimer + * George C. Necula + * Scott McPeak + * 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. + * + *) + +(* + * C Structural Type Equality + *) +open Cil +open Pretty +module N = Ptrnode +module E = Errormsg + +let debugType = false + +let useCompatOnRepresentative = false + +(* sm: When true, explicit padding elements are inserted, to try + * to fix the problem demonstrated by test/small2/alignprob.c; when + * false, we're back to the previous system. + * + * NOTE: The current implementation is really just a proof of concept, + * as the only entities that cause padding to be inserted are 'double's. + * A more elaborate system, one that ideally works for e.g. 64-bit + * aligned 'long' vs. 32-bit 'int', etc., is still future work. + *) +let newPadding = false (* matth: we don't need this for deputy, because we + don't change any layouts *) + +(* When true, if we conclude that two types are incompatible due to + * padding/alignment issues, log "padding mismatch". Generally, such + * cases are exactly those that would have been allowed in the previous + * system but not in the new system, so we can check that the new + * system isn't rejecting things that are ok and were allowed before. *) +let logPaddingMismatches = true + +let arraysThatHaveBeenComparedWithNonArrays = Hashtbl.create 511 +let arraysThatHaveBeenComparedWithArrays = Hashtbl.create 511 +(* A hash-table of arrays that have been compared with non-arrays. If that + * happened to an array that ends up INDEX, we flag an error (because INDEX + * changes the size/layout of the array, so our previous assessment was + * incorrect). + *) + + + (* replace a "void *" type with its representative *) + (* tau is already unrolled. The chain goes orig_tau -> replacedTau *) +let polymorphic_replace (tau: typ) : typ * N.chain = + match tau with + | (TPtr((TVoid _),attr)) -> begin + match N.nodeOfAttrlist attr with + Some(n) -> + let rep,why_n_rep = N.get_rep_why n in + (* gn: use the attributes of the representatives not ours !! *) + if N.hasFlag rep N.pkCompatWithScalars then begin + intType, why_n_rep + end else + (TPtr(rep.N.btype, rep.N.attr)), why_n_rep + | None -> tau, N.mkRIdent + end + | _ -> tau, N.mkRIdent + +let ok_to_call_compat t1 t2 = + isVoidPtrType t1 || isVoidPtrType t2 || + (isPointerType t1 && isPointerType t2) + + +(* A failure handler is called on two nodes whose base types fail to match + * up. This should make those nodes have WILD types (and thus force them to + * match up) *) +type failureHandler = N.node -> N.chain -> N.node -> unit + +(* A compatHandler is called on two nodes that must have an equal + * representation. This should put an ECompat edge between those two nodes. + *) +type compatHandler = N.chain -> Cil.typ -> Cil.typ -> unit + +(* Idealized representation of C types to make structural equality + * comparisons easier. *) +type layout = + Scalar of int (* length in bits *) + | Array of typ * (layout list) * int + (* original array type, layout of element type, size *) + | Pointer of typ (* original CIL pointer type + * either TPtr or TFun *) + (* GN: why not TPtr(TFun... )? *) + | Function of typ (* GN: add this one for TFun *) + | Anything of int (* length in bits, matches anything *) + | Padding of int (* sm: pad out to a specific bit boundary *) + +(* use this instead of "l1 = l2" because OCaml structural equality may + * exhaust all memory checking Cil.typ, and layout lists mention Cil.typs. + *) +let rec ll_eq_simple (l1 : layout list) (l2 : layout list) : bool = + match l1, l2 with + [], [] -> true + | Array(_,left,i) :: tl1 , Array(_,right,j) :: tl2 -> + (i = j) && (ll_eq_simple left right) && (ll_eq_simple tl1 tl2) + | Pointer(t1) :: tl1, Pointer(t2) :: tl2 + | Function(t1) :: tl1, Function(t2) :: tl2 -> + typeSig t1 = typeSig t2 && ll_eq_simple tl1 tl2 + | Anything(i) :: tl1, Anything(j) :: tl2 -> + i = j && ll_eq_simple tl1 tl2 + | Padding(i) :: tl1, Padding(j) :: tl2 -> + i = j && ll_eq_simple tl1 tl2 + | _ -> false + +let is_array (l: layout) : bool = + match l with + Array(_) -> true + | _ -> false + +(* Pretty printing *) +let rec d_layout () l = match l with + Scalar(i) -> dprintf "Scalar(%d)" i + | Anything(i) -> dprintf "Anything(%d)" i + | Array(_,ll,i) -> dprintf "Array %d %a" i d_layout_list ll + | Pointer(tau) -> dprintf "Ptr (%a)" d_type tau + | Function(tau) -> dprintf "Fun (%a)" d_type tau + | Padding(i) -> dprintf "Pad(%d)" i +and d_layout_list () ll = + dprintf "@[[%a]@]" (docList ~sep:(chr ';' ++ break) (d_layout ())) ll + +let global_layout_list_cache = Hashtbl.create 2047 + +(* does a CIL type's representation include any doubles? *) +let rec has_doubles (orig_t : typ) : bool = + let t = unrollType orig_t in + match t with + | TFloat (FDouble, _) -> true + | TArray (tau,_,_) -> (has_doubles tau) (* should sizeless be false? *) + | TComp (ci,_) -> + let test (fi: fieldinfo) : bool = + (has_doubles fi.ftype) + in + (List.exists test ci.cfields) + | _ -> false + +(* Convert a C/CIL type into a list of layouts. This usually amounts + * to flattening structures and making padding and alignment explicit. *) +let rec convert_type_to_layout_list (orig_t : typ) = + let t = unrollType orig_t in + let result = + match t with + TVoid _ -> (* failwith "convert_type_to_layout_list: void" *) [] + | TFloat (FDouble, _) when newPadding -> + (* sm: wide scalar is preceded by padding to its width; I also + * follow it with padding to make it clear that it ends on a 64-bit + * boundary, for compatibility with a type where a struct ends + * after a double *) + [Padding(64); Scalar(64); Padding(64)] + | TInt _ | TFloat _ | TEnum _ -> + [Scalar((try bitsSizeOf t with SizeOfError _ -> 0))] + | TPtr(_) -> [Pointer(t)] + | TFun(_) -> [Function(t)] (* gn: was [Pointer(t)] *) + + | TArray(tau,Some(e),_) when e = one -> convert_type_to_layout_list tau + | TArray(tau,Some(e),_) -> + let ll = convert_type_to_layout_list tau in + let e = constFold true e in + let len = begin match isInteger e with + Some(i64) -> Int64.to_int i64 + | None -> + E.s (E.unimp + "type: convert_type_to_layout_list: non-const length %a" + d_type t) + end in + ( match ll with + [Scalar(length)] -> + (* [Scalar(length * len)] *) + if (length = 0) then begin + ignore (E.warn "type: convert_type_to_layout_list: array contains nothing: %a" d_type t) + end ; + [Array(t,[Scalar(length*len)],1)] + | _ -> [Array(t,ll,len)]) + | TArray(tau,None,al) -> + convert_type_to_layout_list (TArray (tau,Some zero,al)) + | TComp(ci,al) when ci.cstruct -> + let total_size = try (bitsSizeOf t) with SizeOfError _ -> 0 in + let seen_size = ref 0 in + let ll = ref [] in + List.iter (fun fi -> + let field_size_bits = + match fi.fbitfield with + Some(size) -> size + | None -> (try bitsSizeOf fi.ftype with SizeOfError _ -> 0) + in + let field_offset_bits, field_width_bits = + (try bitsOffset t (Field(fi,NoOffset)) with SizeOfError _ -> 0,0) in + let field_offset = field_offset_bits in + if (!seen_size < field_offset) then begin + ll := !ll @ [Scalar(field_offset - !seen_size)]; + seen_size := field_offset + end ; + let field_ll = match fi.fbitfield with + Some(size) -> [Scalar(size)] + | None -> convert_type_to_layout_list fi.ftype + in + ll := !ll @ field_ll ; + seen_size := !seen_size + field_size_bits ; + ) ci.cfields ; + if (!seen_size < total_size) then begin + ll := !ll @ [Scalar(total_size - !seen_size)]; + end ; + if (newPadding && (has_doubles t)) then + (* sm: alignment padding at start and end *) + [Padding(64)] @ !ll @ [Padding(64)] + else + !ll + (* Unions. We have already added (in markptr) casts from the longest field + * to all of the others. From now on it is safe to work with the longest + * field instead of the union *) + | TComp(ci,al) when not ci.cstruct -> + let rec longest (sofar: typ) (sofarsize: int) = function + [] -> + if sofarsize = 0 then + E.s (bug "type: convert_type_to_layout_list: Could not find the longest field in %s\n" + (compFullName ci)) + else + sofar + + | fi :: restfi -> + let this_size = + try bitsSizeOf fi.ftype with SizeOfError _ -> 0 in + if this_size > sofarsize then + longest fi.ftype this_size restfi + else + longest sofar sofarsize restfi + in + convert_type_to_layout_list (longest voidType 0 ci.cfields) + | TComp _ -> E.s (E.bug "type: convert_type_to_layout_list: mystery comp") + | TNamed _ -> E.s (E.bug "type: convert_type_to_layout_list: named") + | TBuiltin_va_list _ -> + E.s (E.bug "type: convert_type_to_layout_list: va_list") + in + + (* strip leading padding; this is needed so that a struct that has + * no doubles can be a subtype of one that has them after the common + * prefix (test/small2/subtypebug2.c) *) + let rec strip_lead_pad (ll : layout list) : layout list = + match ll with + | Padding(i) :: tl -> (strip_lead_pad tl) + | _ -> ll + in + + (* peephole optimization for layout lists *) + let rec peephole ll = + match ll with + [] -> [] + | Scalar(i) :: Scalar(j) :: tl -> peephole (Scalar(i+j) :: tl) + | Padding(i) :: Padding(j) :: tl -> + (* sm: larger padding dominates (assuming all are powers of 2...) *) + (peephole ((Padding(max i j)) :: tl)) + | hd :: tl -> hd :: (peephole tl) + in + + (peephole (strip_lead_pad result)) + +(* Strips 'i' bits of scalars from the beginning of the layout list 'll'. + * This is a utility function called by equal_ll. + * Returns a boolean success code and new layout list representing the + * suffix or raises an exception on failure. *) +let rec strip_scalar_prefix (ll : layout list) i = + if i = 0 then + true, ll + else if i < 0 then + true, (Scalar(-i) :: ll) + else match ll with + [] -> false, [] + | Scalar(j) :: tl -> (strip_scalar_prefix tl (i - j)) + | Anything(j) :: tl -> + if (i >= j) then (* eat up the entire "Anything" *) + (strip_scalar_prefix tl (i - j)) + else + true, (Anything(j - i) :: tl) + | Padding(j) :: tl -> E.s (E.bug "strip_scalar_prefix applied to padding") + | Array(_,inner_ll,0) :: tl -> (strip_scalar_prefix tl i) + | Array(_,inner_ll,1) :: tl -> (strip_scalar_prefix (inner_ll @ tl) i) + | Array(tau,inner_ll,j) :: tl -> + let new_ll = inner_ll @ (Array(tau,inner_ll,j-1) :: tl) in + (strip_scalar_prefix new_ll i ) + | Pointer(_) :: tl + | Function(_) :: tl -> + let _, res = strip_scalar_prefix (Scalar(4*8) :: tl) i in + false, res + (* Consider the following code: + * void ( * fptr )() ; + * int *x; + * + * x = ( int * ) fptr; + * + * In this case, we will end up comparing a scalar with a function, + * so we will want to call strip_scalar_prefix on a function. It + * should return false. *) + +(* When we are computing "t1 < t2" or "t1 > t2", which one can be + * smaller? *) +type subtype_direction = LeftCanEndEarly | RightCanEndEarly | MustBeEqual + +let flip_subtyping st = match st with + LeftCanEndEarly -> RightCanEndEarly + | RightCanEndEarly -> LeftCanEndEarly + | MustBeEqual -> MustBeEqual + +(* for debugging output *) +let subtype_direction_name (st: subtype_direction) : string = match st with + LeftCanEndEarly -> "LeftCanEndEarly" + | RightCanEndEarly -> "RightCanEndEarly" + | MustBeEqual -> "MustBeEqual" + +(* + * Check to see if a type is made up entirely of scalars. + *) +let all_scalars + ?(replace=(fun a -> a, N.mkRIdent)) + t1 += + let t1,ex1 (* ex1: orig_t1 -> t1 *) = replace (unrollType t1) in + (* GN: another implementation, that seems to work in the presence of unions *) + not (existsType (function TPtr _ -> ExistsTrue | _ -> ExistsMaybe) t1) +(* + try + let ll = convert_type_to_layout_list t1 in + let rec all_scalars_ll ll = match ll with + | [] -> true + | [Scalar(_)] -> true + | Array(_,ll,_) :: tl -> (all_scalars_ll ll) && (all_scalars_ll tl) + | _ -> false + in + all_scalars_ll ll + with e -> begin + ignore (E.warn "all_scalars raises %s\n" (Printexc.to_string e)); + false + end +*) + +(* These memoization tables store results from previous calls to "compare" *) +let memoize_equal = Hashtbl.create 32767 +let memoize_subtype = Hashtbl.create 32767 + +(* This is the main (conceptual) entry point for this file. + * + * Use physical subtyping (a la Reps, etc.) to determine the relationship + * between t1 and t2. In general, this is similar to width subtyping (like + * in object oriented languages) with the following exceptions: + * + * (1) "void*" is treated as a type variable and special handling exists + * to replace a "void*" with its representative type. Any direct + * comparison with a representative-less "void*" type succeeds. + * (2) A special "compat" function is called on all pointers that must have + * the same physical representation and on all pointers that area + * compared against a representative-less "void*" type. + * (3) A special "failure" function is called on all internal pointers that + * "fail to match up correctly" and must thus have their types checked + * at run-time (e.g., by making them WILD in CCured). "compare" can + * return true even if some lower-level pointers fail to match up, + * provided that it calls "failure" on them. + * + * Because memoization is used to prevent this from taking too much time + * over the course of the analysis, "compat" and "failure" are only + * guaranteed to be called once per pair of types, even across many + * invocations of "compare". + *) +let rec compare + (compat: compatHandler) + (failure: failureHandler) + (why_t1_t2: N.chain) (* Goes t1 -> t2 *) + (t1: typ) + (t2: typ) + (mode: subtype_direction) : bool += + let t1r, why_t1_t1r = polymorphic_replace (unrollType t1) in + let t2r, why_t2_t2r = polymorphic_replace (unrollType t2) in + (* explanation: t1r -> t1 -> t2 -> t2r *) + let why_t1r_t2r = + N.mkRTrans (N.mkRSym why_t1_t1r) (N.mkRTrans why_t1_t2 why_t2_t2r) in + + if ok_to_call_compat t1r t2r then begin + if useCompatOnRepresentative then + compat why_t1r_t2r t1r t2r + else + compat why_t1_t2 t1 t2; + end ; + + if debugType then begin + ignore (E.log "compare: %a %a@!" d_type t1r d_type t2r) + end ; + + (* Can we short-circuit this calculation because one of them is a + * "void*", a type variable? *) + if isVoidPtrType t1r || isVoidPtrType t2r then + true + else + (* Can we short-circuit this calculation because we have considered these + * two types before, and they are thus in our memoization tables? *) + let already_seen, old_answer = + (* if they are equal, they are certainly sub-types *) + if Hashtbl.mem memoize_equal (t1r,t2r) then + true, Hashtbl.find memoize_equal (t1r,t2r) + else if Hashtbl.mem memoize_equal (t2r,t1r) then + true, Hashtbl.find memoize_equal (t2r,t1r) + (* they are not equal, but perhaps we have considered this + * subtyping comparison before *) + else match mode with + LeftCanEndEarly -> + if Hashtbl.mem memoize_subtype (t1r,t2r) then + true, Hashtbl.find memoize_subtype (t1r,t2r) + else + false, false + | RightCanEndEarly -> + if Hashtbl.mem memoize_subtype (t2r,t1r) then + true, Hashtbl.find memoize_subtype (t2r,t1r) + else + false, false + | MustBeEqual -> + false, false + in if already_seen then old_answer + else if + (* Can we short-circuit this calculation because the sizes are clearly + * wrong? *) + let s1 = try Some(bitsSizeOf t1r) with SizeOfError _ -> None in + let s2 = try Some(bitsSizeOf t2r) with SizeOfError _ -> None in + match mode,s1,s2 with + LeftCanEndEarly,Some(s1),Some(s2) -> s1 > s2 + | RightCanEndEarly,Some(s1),Some(s2) -> s1 < s2 + | MustBeEqual,Some(s1),Some(s2) -> s1 <> s2 + | _ -> false + then + false + else if (* Can we short-circuit this based on typesigs? *) + (typeSig t1r) = (typeSig t2r) then + true + else + (* Looks like we must actually do the calculation. *) + let l1 = convert_type_to_layout_list t1r in + let l2 = convert_type_to_layout_list t2r in + if debugType then begin + ignore (E.log "compare: %a = %a@!" d_type t1r d_layout_list l1) ; + ignore (E.log "compare: %a = %a@!" d_type t2r d_layout_list l2) ; + end ; + let answer = + (* Try one last time to short-circuit the long calculation based on a + * simple equality-check for layout lists *) + if ll_eq_simple l1 l2 then + true + else begin + (* In order to make this algorithm terminate, we cannot recursively + * consider this particular comparison. We know that (t1r,t2r) is + * not in the memoize_equal hash table at all at this point. *) + Hashtbl.replace memoize_equal (t1r,t2r) true ; + let result = equal_ll l1 l2 mode compat failure why_t1r_t2r in + Hashtbl.remove memoize_equal (t1r,t2r) ; + result + end + in + begin + (* update our memoization tables so that we never compute this + * answer again *) + match mode with + LeftCanEndEarly -> Hashtbl.add memoize_subtype (t1r,t2r) answer + | RightCanEndEarly -> Hashtbl.add memoize_subtype (t2r,t1r) answer + | MustBeEqual -> Hashtbl.add memoize_equal (t1r,t2r) answer + end ; + if debugType then begin + ignore (E.log "compare: %b %a %a@!" answer d_type t1r d_type t2r) + end ; + answer + +(* + * arguments: + * l1 l2 // check and see if these two layout lists are equal + * subtyping // which one of these lists can end early? + * compat // call this function on all lined-up pointers in l1, l2 + * failure // call on pointer types that fail to match up + * why_l1_l2 // why are we comparing l1 and l2? + *) +and equal_ll + (l1:layout list) + (l2: layout list) + (subtyping: subtype_direction) + (compat: compatHandler) + (failure: failureHandler) + (why_l1_l2: N.chain) += + if debugType then + ignore (E.log "equal_ll (%s):@!%a@!%a@!" + (subtype_direction_name subtyping) + d_layout_list l1 d_layout_list l2); + + (* pulled this out b/c ocaml won't let me combine two match clauses + * when they have 'when' limiters... *) + let padding_mismatch () : bool = + if logPaddingMismatches then + ignore (E.log "padding mismatch:@! %a@! %a@!" + d_layout_list l1 d_layout_list l2); + (* sm: Wes and I concluded that we do not need to check the tails, + * because by returning false here (and not simply calling 'failure'), + * we guarantee that all pointers in both structures will become wild *) + false + in + + let final_answer = + match l1, l2 with + [], [] -> (true) + | [], _ when subtyping = LeftCanEndEarly -> (true) + | _, [] when subtyping = RightCanEndEarly -> (true) + + | [], _ + | _, [] -> (false) + + (* sm: padding must match with padding *) + | (Padding(i) :: tl1), (Padding(j) :: tl2) -> + i = j && equal_ll tl1 tl2 subtyping compat failure why_l1_l2 + + (* padding mismatch. + * hack: If the other side is an Array, then we need to unroll it. + * So, the 'when' clause prevents this one from matching, so it + * will instead match the Array clauses below. I wanted to just move + * the array clauses to the top, but that causes a problem since + * the Scalar clause would be below the Array clause; see + * test/small2/subtypebug1.c. test/small2/getaddrinfo.c is a + * test that reveals the need for the 'when' in the first place. *) + | (Padding(_) :: _), (hd2 :: _) when (not (is_array hd2)) -> + padding_mismatch() + | (hd1 :: _), (Padding(_) :: _) when (not (is_array hd1)) -> + padding_mismatch() + + | (Scalar(i) :: tl), _ -> + let new_l1 = tl in + let worked, new_l2 = strip_scalar_prefix l2 i in + let answer = equal_ll new_l1 new_l2 subtyping compat failure why_l1_l2 in + (answer && worked) + + | (Anything(i) :: tl), _ -> + let new_l1 = tl in + let _, new_l2 = strip_scalar_prefix l2 i in + equal_ll new_l1 new_l2 subtyping compat failure why_l1_l2 + + (* array on left *) + | (Array(tau1,inner_ll1, i1) :: tl1) , _ -> + (* first, handle special case where we match up arrays *) + let same = ref false in + let remove_1 = ref None in + let remove_2 = ref None in + (match l2 with + Array(tau2,inner_ll2, i2) :: tl2 -> + Hashtbl.replace arraysThatHaveBeenComparedWithArrays + (tau1,tau2) why_l1_l2 ; + (* When we unpeel these guys, it will look like they are being + * compared against non-arrays when we compare them against + * their respective contents. So we remember now if they had + * a clean slate before and we'll reclean it later before + * we return. *) + if not (Hashtbl.mem arraysThatHaveBeenComparedWithNonArrays tau1) + then remove_1 := Some(tau1) ; + if not (Hashtbl.mem arraysThatHaveBeenComparedWithNonArrays tau2) + then remove_2 := Some(tau2) ; + if (i1 = i2 && ll_eq_simple inner_ll1 inner_ll2) then + same := true + | _ -> + Hashtbl.replace arraysThatHaveBeenComparedWithNonArrays + tau1 why_l1_l2 + ) ; + if !same then + true + else begin + let new_l1 = + if i1 = 0 then + tl1 + else if i1 = 1 then + inner_ll1 @ tl1 + else + inner_ll1 @ (Array(tau1,inner_ll1,i1-1) :: tl1) + in + let final_answer = equal_ll new_l1 l2 subtyping compat failure why_l1_l2 + in + (match !remove_1 with + Some(t) -> Hashtbl.remove arraysThatHaveBeenComparedWithNonArrays t + | _ -> () ) ; + (match !remove_2 with + Some(t) -> Hashtbl.remove arraysThatHaveBeenComparedWithNonArrays t + | _ -> () ) ; + final_answer + end + + (* array/anything on right *) + | _, (Array(_) :: _) + | _, (Anything(_) :: _) -> + (* flip things around, use the code above *) + equal_ll l2 l1 (flip_subtyping subtyping) compat failure + (N.mkRSym why_l1_l2) + + | (Pointer(tau1) :: tl1) , (Pointer(tau2) :: tl2) -> + (* already unrolled *) + let tau1r, why_tau1_tau1r = polymorphic_replace (unrollType tau1) in + let tau2r, why_tau2_tau2r = polymorphic_replace (unrollType tau2) in + if debugType then + ignore (E.log "Type.equal_ll for@! @[%a@]@!and @[%a@]@!@!" + d_type tau1r d_type tau2r); + (* explanation: tau1r -> tau1 -> tau2 -> tau2r *) + let why_tau1r_tau2r = + N.mkRTrans (N.mkRSym why_tau1_tau1r) + (N.mkRTrans why_l1_l2 why_tau2_tau2r) in + + (if useCompatOnRepresentative then + (if ok_to_call_compat tau1r tau2r then + compat why_tau1r_tau2r tau1r tau2r) + else + (if ok_to_call_compat tau1 tau2 then + compat why_l1_l2 tau1 tau2)); + + if isVoidPtrType tau1r || isVoidPtrType tau2r then + () (* no recursive calls *) + else begin + match tau1r, tau2r with + | TPtr(inner1,a1), TPtr(inner2,a2) -> begin (* two non-fun pointers *) + if debugType then + ignore (E.log "Type.equal_ll doing inner pointers@! @[%a@]@!and @[%a@]@!@!" + d_type inner1 d_type inner2); + let answer = + compare compat failure why_tau1r_tau2r inner1 inner2 MustBeEqual + in + if not answer then begin + (* Get the nodes involved *) + let n1 = + match N.nodeOfAttrlist a1 with + Some n1 -> n1 + | _ -> E.s (bug "Type.equal_ll: type %a does not have a node" + d_type tau1r) + in + let n2 = + match N.nodeOfAttrlist a2 with + Some n2 -> n2 + | _ -> E.s (bug "Type.equal_ll: type %a does not have a node" + d_type tau2r) + in + if debugType then + ignore (E.log "Call failure %d and %d (from Inner)\n" + n1.N.id n2.N.id); + failure n1 why_tau1r_tau2r n2; + end + end + + | TInt _, _ + | _ , TInt _ -> + (* We thought one of these was a pointer, but its rep was + * an integer. In this case we just put the pointer in the same + * EQ class as the void* and let our logic in the solver work + * it out. They are not compatible, and our check in the solver + * with the compatWithScalars flag should notice that and + * make them WILD. *) + if ok_to_call_compat tau1 tau2 then (* should always be true *) + compat why_l1_l2 tau1 tau2 + + | _, _ -> E.s (E.bug "type: unexpected mystery pointers %a and %a" + d_type tau1r d_type tau2r) + end ; + + (* Note that because we are assuming that "failure" makes its + * arguments WILD (or otherwise invisible to physical subtyping), we + * don't actually need to know whether the above check passed or + * failed at all. If it passed, the types are fine so far. If it + * failed, those two pointers will be made WILD, so they will be + * checked at run-time, so these two lists are still fine. *) + (* Now check the rest of the layout list! *) + equal_ll tl1 tl2 subtyping compat failure why_l1_l2 + + (* Compare two functions *) + | Function(TFun(rt1,vlo1,_,_) as t1) :: tl1, + Function(TFun(rt2,vlo2,_,_) as t2) :: tl2 -> + (* two fun ptrs *) + (* Check return types *) + let rt1r, why_rt1_rt1r = polymorphic_replace (unrollType rt1) in + let rt2r, why_rt2_rt2r = polymorphic_replace (unrollType rt2) in + (* explanation: rt1r -> rt1 -> rt2 -> rt2r *) + let why_rt1r_rt2r = N.mkRTrans (N.mkRSym why_rt1_rt1r) + (N.mkRTrans why_l1_l2 why_rt2_rt2r) in + (if useCompatOnRepresentative then + (if ok_to_call_compat rt1r rt2r then + compat why_rt1r_rt2r rt1r rt2r) + else + (if ok_to_call_compat rt1 rt2 then + compat why_l1_l2 rt1 rt2)); + let ret_ok = + compare compat failure why_rt1r_rt2r rt1r rt2r MustBeEqual in + if debugType then + ignore (E.log "Type.equal_ll preparing to do arguments of@! @[%a@]@!and @[%a@]@!@!" d_type t1 d_type t2); + (* Check the arguments *) + let al1 = argsToList vlo1 in + let al2 = argsToList vlo2 in + let args_ok = + if List.length al1 <> List.length al2 then begin + false + end else begin + (* check every argument *) + let answer = ref true in + let compareFormalNames = ref false in + List.iter2 (fun (_, arg1t, _) (_, arg2t, _) -> + let at1r, why_argt1_at1r = polymorphic_replace (unrollType arg1t) in + let at2r, why_argt2_at2r = polymorphic_replace (unrollType arg2t) in + (* explanation: at1r -> argt1 -> argt2 -> at2r *) + let why_at1r_at2r = + N.mkRTrans (N.mkRSym why_argt1_at1r) + (N.mkRTrans why_l1_l2 why_argt2_at2r) in + if debugType then + ignore (E.log "Type.equal_ll doing argument@! @[%a@]@!and @[%a@]@!@!" d_type at1r d_type at2r); + (if useCompatOnRepresentative then + (if ok_to_call_compat at1r at2r then + compat why_at1r_at2r at1r at2r) + else + (if ok_to_call_compat arg1t arg2t then + compat why_l1_l2 arg1t arg2t)); + let ans = + compare compat failure why_at1r_at2r at1r at2r MustBeEqual in + answer := ans && !answer ; + + (* matth: this doesn't belong here, but I don't know where to put + it. Make sure the formal types agree on __COUNT and __SIZE + attributes. This prevents casting away of these attributes with + function pointers. *) + let a1 = typeAttrs at1r in + let a2 = typeAttrs at2r in + let doCheck what = + let a1f = filterAttributes what a1 in + if a1f <> filterAttributes what a2 then begin + ignore (warn + "Mismatched \"%s\" attributes in@! @[%a@]@!and @[%a@]@!@!" + what d_type at1r d_type at2r); + answer := false + end; + if a1f <> [] then + compareFormalNames := true; + in + doCheck "size"; + doCheck "count"; + ) + al1 al2 ; + if !compareFormalNames then begin + (* If any formal has a SIZE or COUNT attribute, make sure that + all of the names of the formals match. See small2/size3.c + test funcptr_wrongorder. *) + List.iter2 + (fun (name1, arg1t, _) (name2, _, _) -> + let hasSizeOrCount t = + let a = typeAttrs t in + (hasAttribute "size" a) || (hasAttribute "count" a) + in + if name1 <> name2 + (* If this formal has a SIZE or COUNT annotation, + it's been renamed already. But no other formal can + depend on it, so it's okay to skip this case. *) + && (not (hasSizeOrCount arg1t)) then begin + ignore (warn + "The names of formals \"%s\" and \"%s\" must match when using SIZE/COUNT." + name1 name2); + answer := false + end) + al1 al2 + end; + !answer + end + in + (* now check the rest of the layout list! *) + let (restok) = equal_ll tl1 tl2 subtyping compat failure why_l1_l2 in + (* We have to return false if either the args of the returns are not Ok *) + (restok && args_ok && ret_ok) + + + (* This match case is used: in particular 'something' could be + * Scalar(i) *) + | (Pointer(p) :: tl1) , something when isVoidType p -> + (* special scalar node handling *) + E.s (E.bug "type: unify Ptr(%a) with the scalar node" d_type p) + + | (_ :: tl1), (_ :: tl2) -> (* NOT EQUAL *) + (* but check the rest anyway! *) + let _ = equal_ll tl1 tl2 subtyping compat failure why_l1_l2 in + false + in + (* ignore (E.warn "subtype: %b@!%a@!%a" + final_answer d_layout_list l1 d_layout_list l2) ;*) + (final_answer) + + +(* subtype and equal both just call "compare" *) +let subtype ~(compat:compatHandler) + ~(failure:failureHandler) + ~(why_small_big:Ptrnode.chain) + ~(small:Cil.typ) + ~(big:Cil.typ) : bool = + compare compat failure why_small_big small big LeftCanEndEarly + + +let equal ~(compat:compatHandler) + ~(failure:failureHandler) + ~(why_t1_t2:Ptrnode.chain) + ~(t1:Cil.typ) + ~(t2:Cil.typ) : bool = + compare compat failure why_t1_t2 t1 t2 MustBeEqual + +(* Ptrnode.ml needs to call subtype *) +let init () = + N.isSubtype := + fun big small -> + try + subtype + ~compat:(fun _ _ _ -> ()) + ~failure:(fun _ _ _ -> raise Not_found) + ~why_small_big:N.mkRIdent + ~small:small + ~big:big + with Not_found -> + false diff --git a/src/infer/type.mli b/src/infer/type.mli new file mode 100644 index 0000000..2e7feb1 --- /dev/null +++ b/src/infer/type.mli @@ -0,0 +1,110 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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. + * + *) + +(* + * C Structural Type Equality + *) +val debugType: bool + + +(* Initialize the type module *) +val init: unit -> unit + +(* A failure handler is called on two nodes whose base types fail to match + * up. This should make those nodes have WILD types (and thus force them to + * match up) *) +type failureHandler = Ptrnode.node -> Ptrnode.chain -> Ptrnode.node -> unit + +(* A compatHandler is called on two nodes that must have an equal + * representation. This should put an ECompat edge between those two nodes. + *) +type compatHandler = Ptrnode.chain -> Cil.typ -> Cil.typ -> unit + + +(** Use this function to replace a void-ptr with its representative. The + * resulting chain is always orig_type -> type. *) +val polymorphic_replace: Cil.typ -> Cil.typ * Ptrnode.chain + +(* This is the main (conceptual) entry point for this file. + * + * These remarks apply to "subtype" and "equal", both of which are + * implemented using an underlying function called "compare". + * + * Use physical subtyping (a la Reps, etc.) to determine the relationship + * between t1 and t2. In general, this is similar to width subtyping (like + * in object oriented languages) with the following exceptions: + * + * (1) "void*" is treated as a type variable and special handling exists + * to replace a "void*" with its representative type. Any direct + * comparison with a representative-less "void*" type succeeds. + * (2) A special "compat" function is called on all pointers that must have + * the same physical representation and on all pointers that area + * compared against a representative-less "void*" type. + * (3) A special "failure" function is called on all internal pointers that + * "fail to match up correctly" and must thus have their types checked + * at run-time (e.g., by making them WILD in CCured). "compare" can + * return true even if some lower-level pointers fail to match up, + * provided that it calls "failure" on them. + * + * Because memoization is used to prevent this from taking too much time + * over the course of the analysis, "compat" and "failure" are only + * guaranteed to be called once per pair of types, even across many + * invocations of "compare". + *) +val subtype: compat:compatHandler -> + (* Failure is invoked with the two types involved and the chain + * between them *) + failure:failureHandler -> + why_small_big: Ptrnode.chain -> (* Goes small -> big *) + small:Cil.typ -> + big:Cil.typ -> bool + + +val equal: compat:compatHandler -> + (* Failure is invoked with the two types involved and the chain + * between them *) + failure: failureHandler -> + why_t1_t2: Ptrnode.chain -> + t1:Cil.typ -> + t2:Cil.typ -> bool + +val all_scalars: ?replace: (Cil.typ -> Cil.typ * Ptrnode.chain) -> + Cil.typ -> bool + +val arraysThatHaveBeenComparedWithNonArrays: (Cil.typ, Ptrnode.chain) Hashtbl.t + +val arraysThatHaveBeenComparedWithArrays: (Cil.typ * Cil.typ, Ptrnode.chain) Hashtbl.t diff --git a/src/infer/unionfind.ml b/src/infer/unionfind.ml new file mode 100644 index 0000000..d94196a --- /dev/null +++ b/src/infer/unionfind.ml @@ -0,0 +1,172 @@ +(* + * + * Copyright (c) 2001-2006, + * George C. Necula + * Scott McPeak + * Wes Weimer + * 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. + * + *) + +(* + * Union-Find Functor (no side effects, purely applicative) + * + * (used by physical type equality to keep equivalence classes of types) + *) +module N = Ptrnode +module E = Errormsg + +module type UF = + sig + type t + + type elt + + val empty : t + + val check_equal : t -> elt -> elt -> bool + + (* The chain is directed elt1 -> elt2 *) + val make_equal : t -> elt -> elt -> N.chain -> t + + val eq_classes : t -> elt list list + + val class_of : t -> elt -> elt list + + (* Returns the chain why two elements are equal. Raises Failure if they + * are not actually equal *) + val why_equal : t -> elt -> elt -> N.chain + end + + +module Make(S : Set.S) = + struct + (* An equivalence class supports membership queries and can also explain + * why two elements are equal *) + type aclass = + { set: S.t; (* For the membership query *) + why: whyset } + and whyset = + WSSingle of S.elt (* A singleton *) + (* Was formed by unioning aclass1 (containing elt1) and aclass2 + * (containing elt2) with the given chain for elt1->elt2 *) + | WSUnion of aclass * S.elt * N.chain * S.elt * aclass + + type t = aclass list + + type elt = S.elt + + let empty = [] + + let check_equal uf e1 e2 = + List.fold_left + (fun acc cls -> acc || (S.mem e1 cls.set && S.mem e2 cls.set)) false uf + + exception AlreadyEqual + let make_equal (clss : aclass list) e1 e2 chain (* chain : e1->e2 *) = + (* Find the classes of e1 and e2 *) + let c1 : aclass ref = ref { set = S.singleton e1; why = WSSingle e1} in + let c2 : aclass ref = ref { set = S.singleton e2; why = WSSingle e2} in + (* Collect a list of the classes that do not contain e1 or e2 *) + try + let uninvolved : aclass list ref = ref [] in + List.iter (fun (cls : aclass) -> + if S.mem e1 cls.set then begin + if S.mem e2 cls.set then + raise AlreadyEqual + else + c1 := cls + end else if S.mem e2 cls.set then + c2 := cls + else + uninvolved := cls :: !uninvolved) + clss ; + let merged_set = + { set = S.union !c1.set !c2.set; + why = WSUnion (!c1, e1, chain, e2, !c2); } + in + let final_list_of_sets = merged_set :: !uninvolved in + (final_list_of_sets : aclass list) + with AlreadyEqual -> + clss + + let eq_classes clss = + List.map (fun eqclass -> S.elements eqclass.set) clss + + let class_of clss elt = + let rec search = function + [] -> [] + | cls :: tl -> + if S.mem elt cls.set then S.elements cls.set else search tl + in + search clss + + let why_equal (clss: aclass list) (e1: elt) (e2: elt) : N.chain = + (* Find the class of e1 *) + let cls = + try List.find (fun cls -> S.mem e1 cls.set) clss + with _ -> E.s (E.bug "why_equal: element not known") in + (* Check that e2 is in the same class *) + if not (S.mem e2 cls.set) then + E.s (E.bug "why_equal: not actually equal"); + (* Now traverse the history of unions in reverse order. The invariant + * is that both e1 and e2 are in the set. *) + let rec whyLoop (e1: elt) (e2: elt) (why: whyset) = + (* Maybe they are equal *) + if compare e1 e2 = 0 then N.mkRIdent else + match why with + WSSingle _ -> E.s (E.bug "why_equal: equal elements") + | WSUnion (c1, e1', r', e2', c2) -> + if S.mem e1 c1.set then + if S.mem e2 c1.set then + (* Both e1 and e2 belong to c1 *) + whyLoop e1 e2 c1.why + else + (* e1 in c1 and e2 in c2 *) + N.mkRTrans (whyLoop e1 e1' c1.why) + (N.mkRTrans r' + (whyLoop e2' e2 c2.why)) + else (* e1 in c2 *) + if S.mem e2 c2.set then + (* Both e1 and e2 in the c2 *) + whyLoop e1 e2 c2.why + else + (* e1 in c2 and e2 in c1 *) + N.mkRTrans (whyLoop e1 e2' c2.why) + (N.mkRTrans (N.mkRSym r') + (whyLoop e1' e2 c1.why)) + in + whyLoop e1 e2 cls.why + + end + + + + diff --git a/src/instrumenter/dinstrumenter.ml b/src/instrumenter/dinstrumenter.ml new file mode 100644 index 0000000..99d72dc --- /dev/null +++ b/src/instrumenter/dinstrumenter.ml @@ -0,0 +1,751 @@ +(* + * dinstrumenter.ml + * + * This module converts CIL to 3-address code, and then + * adds hooks for instrumentation. + * + * + *) + +open Cil +open Pretty +open Dcheckdef +open Dutil + +module E = Errormsg + +let fixBlock = Dcheck.fixBlock ~giveID:false + +let mkInstrFun (name : string) (n : int) : exp = + let args = Util.list_init n (fun _ -> uintType) in + mkFun name voidType args + +let instrAssign = mkInstrFun "DINSTR_Assign" 5 +let instrBop = mkInstrFun "DINSTR_Bop" 10 +let instrUop = mkInstrFun "DINSTR_Uop" 6 +let instrPushArg = mkInstrFun "DINSTR_PushArg" 4 +let instrPopArg = mkInstrFun "DINSTR_PopArg" 1 +let instrUnRegLocal = mkInstrFun "DINSTR_UnRegLocal" 3 +let instrFunStart = mkInstrFun "DINSTR_FunStart" 1 +let instrRegField = mkInstrFun "DINSTR_RegField" 3 +let instrRegArray = mkInstrFun "DINSTR_RegArray" 4 +let instrCast = mkInstrFun "DINSTR_Cast" 5 + +let instrRetBasic = mkInstrFun "DINSTR_RetBasic" 4 +let instrRetBop = mkInstrFun "DINSTR_RetBop" 9 +let instrRetUop = mkInstrFun "DINSTR_RetUop" 5 +let instrRetVoid = mkInstrFun "DINSTR_RetVoid" 0 +let instrPopRet = mkInstrFun "DINSTR_RetPop" 5 +let instrRetNoRet = mkInstrFun "DINSTR_RetNoRet" 1 + +let instrIfBasic = mkInstrFun "DINSTR_IfBasic" 6 +let instrIfBop = mkInstrFun "DINSTR_IfBop" 11 +let instrIfUop = mkInstrFun "DINSTR_IfUop" 7 + +let instrSwitchBasic = mkInstrFun "DINSTR_SwitchBasic" 5 +let instrSwitchBop = mkInstrFun "DINSTR_SwitchBop" 10 +let instrSwitchUop = mkInstrFun "DINSTR_SwitchUop" 6 + +let instrCNonNull = mkInstrFun "DINSTR_CNonNull" 4 +let instrCEq = mkInstrFun "DINSTR_CEq" 8 +let instrCMult = mkInstrFun "DINSTR_CMult" 8 +let instrCPtrArith = mkInstrFun "DINSTR_CPtrArith" 17 +let instrCPtrArithNT = mkInstrFun "DINSTR_CPtrArithNT" 17 +let instrCPtrArithAccess = mkInstrFun "DINSTR_CPtrArithAccess" 17 +let instrCLeqInt = mkInstrFun "DINSTR_CLeqInt" 8 +let instrCLeq = mkInstrFun "DINSTR_CLeq" 10 +let instrCLeqSum = mkInstrFun "DINSTR_CLeqSum" 14 +let instrCSumLeq = mkInstrFun "DINSTR_CSumLeq" 14 +let instrCLeqNT = mkInstrFun "DINSTR_CLeqNT" 9 +let instrCNullOrLeq = mkInstrFun "DINSTR_CNullOrLeq" 12 +let instrCNullOrLeqNT = mkInstrFun "DINSTR_CNullOrLeqNT" 13 +let instrCWriteNT = mkInstrFun "DINSTR_CWriteNT" 13 +let instrCNullUnionOrSelected = mkInstrFun "DINSTR_CNullUnionOrSelected" 8 +let instrCSelected = mkInstrFun "DINSTR_CSelected" 4 +let instrCNotSelected = mkInstrFun "DINSTR_CNotSelected" 4 + +let instrInit = mkInstrFun "DINSTR_init" 0 +let instrEnd = mkInstrFun "DINSTR_end" 0 +let instrNop = mkInstrFun "DINSTR_nop" 0 + +let instrTaint = mkInstrFun "DINSTR_taint" 5 +let instrCTaint = mkInstrFun "DINSTR_ctaint" 8 +let instrArgv = mkInstrFun "DINSTR_Argv" 4 + +let fileToken : exp = Lval(var (makeGlobalVar "__FILE__" charPtrType)) +let lineToken : exp = Lval(var (makeGlobalVar "__LINE__" uintType)) + +let isInstrFun (i : instr) : bool = + match i with + | Call(_,Lval(Var vi, NoOffset),_,_) -> + (String.length vi.vname >= String.length "DINSTR_" && + String.compare (String.sub vi.vname 0 7) "DINSTR_" = 0) || + vi.vname = "caml_startup" + | _ -> false + +let isPtrCastableType (t : typ) : bool = + match unrollType t with + | TInt(_,_) | TPtr(_,_) | TArray(_,_,_) | TEnum(_,_) -> true + | _ -> false + + +let constBop = + function + | PlusA -> integer 0 + | PlusPI -> integer 1 + | IndexPI -> integer 2 + | MinusA -> integer 3 + | MinusPI -> integer 4 + | MinusPP -> integer 5 + | Mult -> integer 6 + | Div -> integer 7 + | Mod -> integer 8 + | Shiftlt -> integer 9 + | Shiftrt -> integer 10 + | Lt -> integer 11 + | Gt -> integer 12 + | Le -> integer 13 + | Ge -> integer 14 + | Eq -> integer 15 + | Ne -> integer 16 + | BAnd -> integer 17 + | BXor -> integer 18 + | BOr -> integer 19 + | LAnd -> integer 20 + | LOr -> integer 21 +let constUop = + function + | Neg -> integer 0 + | BNot -> integer 1 + | LNot -> integer 2 + +let makeInstr (call : exp) (args : exp list) : instr = + if List.exists (fun e -> not(isPtrCastableType(typeOf e))) args then + Call(None,instrNop,[],locUnknown) + else + let args = List.map (fun e -> mkCast e uintType) args in + Call(None,call,args,locUnknown) + +let isSignedType (t : typ) : bool = + match unrollType t with + | TInt(ik,_) -> isSigned ik + | TEnum _ -> true + | _ -> false + +let baseType (t : typ) : typ option = + match unrollType t with + | TPtr(bt, _) + | TArray(bt,_,_) -> Some bt + | TInt _ -> Some voidType + | _ -> None + +let baseSize (t : typ) : int = + try + match baseType t with + | None -> 0 + | Some t -> bitsSizeOf t / 8 + with _ -> 0 + +let integerSym = zero +let pointerSym = one +(* Takes a basic expression and returns the symbolic expression + * and a constant telling us to treat the symbolic expression as + * a constant or as the id of a symbolic variable *) +let rec opToTypeAndSym (op : exp) : (exp * exp * exp) = + match op with + | Const _ -> + let size_exp = + if isSignedType (typeOf op) then + integer (-(bitsSizeOf(typeOf op))) + else + integer (bitsSizeOf (typeOf op)) + in + (integerSym,size_exp,zero) + | AddrOf(_,_) | StartOf(_,_) -> + (pointerSym, integer (baseSize (typeOf op)), zero) + | Lval(Mem e, NoOffset) -> + (pointerSym, integer (baseSize (typeOf e)), e) + | Lval lv -> + if isPtrOrArray (typeOf op) then + (pointerSym, integer (baseSize (typeOf op)), AddrOf lv) + else if isSignedType (typeOf op) then + (integerSym, integer(-(bitsSizeOf(typeOf op))), AddrOf lv) + else + (integerSym, integer(bitsSizeOf(typeOf op)), AddrOf lv) + | CastE(t, op) -> + let (sym, sz, sop) = opToTypeAndSym op in + if isPtrOrArray t then + (pointerSym, integer (baseSize t), sop) + else if isSignedType t then + (integerSym, integer(-(bitsSizeOf t)), sop) + else + (integerSym, integer(bitsSizeOf t), sop) + | _ -> E.s(bug "opToTypeAndSym: exp not basic: %a\n" d_plainexp op) + + +let makeCheckInstr (c : check) : instr list = + let split3 l = + let rec helper l acc1 acc2 acc3 = + match l with + | [] -> (List.rev acc1, List.rev acc2, List.rev acc3) + | (a,b,c)::rst -> + helper rst (a::acc1) (b::acc2) (c::acc3) + in + helper l [] [] [] + in + let merge4 l1 l2 l3 l4 = + let rec helper l1 l2 l3 l4 acc = + match l1,l2,l3,l4 with + | [], [], [], [] -> List.rev acc + | x1::rst1, x2::rst2, x3::rst3, x4::rst4 -> + helper rst1 rst2 rst3 rst4 (x4::x3::x2::x1::acc) + | _, _, _, _ -> raise(Invalid_argument "merge4: different lengths") + in + helper l1 l2 l3 l4 [] + in + let opsToArgList (ops : exp list) : exp list = + let typ ,sz, sops = split3 (List.map opToTypeAndSym ops) in + merge4 ops sops typ sz + in + match c with + | CNonNull op -> begin + match op with + | Lval(Var vi, off) -> + let (typ,sz,sop) = opToTypeAndSym op in + [makeInstr instrCNonNull [op;sop;typ;sz]] + | _ -> E.s(bug "makeCheckInstr: CNonNull of constant remains\n") + end + | CEq(op1,op2,s,dl) -> + [makeInstr instrCEq (opsToArgList [op1;op2])] + | CMult(op1,op2) -> + [makeInstr instrCMult (opsToArgList [op1;op2])] + | CPtrArith(op1,op2,op3,op4,sz) -> + let args_low = opsToArgList [op1;op3;op4] in + let args_up = opsToArgList [op3;op4;op2] in + [makeInstr instrCLeqSum (args_low@[fileToken;lineToken]); + makeInstr instrCSumLeq (args_up@[fileToken;lineToken])] + | CPtrArithNT(op1,op2,op3,op4,sz) -> + let args = (integer sz)::(opsToArgList [op1;op2;op3;op4]) in + [makeInstr instrCPtrArithNT args] + | CPtrArithAccess(op1,op2,op3,op4,sz) -> + let args = (integer sz)::(opsToArgList [op1;op2;op3;op4]) in + [makeInstr instrCPtrArithAccess args] + | CLeqInt(op1,op2,s) -> + [makeInstr instrCLeqInt (opsToArgList [op1;op2])] + | CLeq(op1,op2,s) -> + [makeInstr instrCLeq ((opsToArgList [op1;op2])@[fileToken;lineToken])] + | CLeqNT(op1,op2,sz,s) -> + let args = (integer sz)::(opsToArgList [op1;op2]) in + [makeInstr instrCLeqNT args] + | CNullOrLeq(op1,op2,op3,s) -> + [makeInstr instrCNullOrLeq (opsToArgList [op1;op2;op3])] + | CNullOrLeqNT(op1,op2,op3,sz,s) -> + let args = (integer sz)::(opsToArgList [op1;op2;op3]) in + [makeInstr instrCNullOrLeqNT args] + | CWriteNT(op1,op2,op3,sz) -> + let args = (integer sz)::(opsToArgList [op1;op2;op3]) in + [makeInstr instrCWriteNT args] + | CNullUnionOrSelected(lv,e) -> + [makeInstr instrCNullUnionOrSelected (opsToArgList [Lval lv;e])] + | CSelected e -> + [makeInstr instrCSelected (opsToArgList [e])] + | CNotSelected e -> + [makeInstr instrCNotSelected (opsToArgList [e])] + + +let paramTrans (ap : attrparam) + (args : exp list) + (ro : lval option) : exp option = + match ap with + | AStar(ACons(is,[])) -> + if String.sub is 0 1 = "$" then begin + let nstr = String.sub is 1 ((String.length is) - 1) in + let i = int_of_string nstr in + if i = 0 then match ro with + | Some r -> Some(Lval(Mem (Lval r),NoOffset)) + | None -> None + else Some(Lval(Mem(List.nth args (i-1)),NoOffset)) + end else None + | ACons(is,[]) -> + if String.sub is 0 1 = "$" then begin + let nstr = String.sub is 1 ((String.length is) - 1) in + let i = int_of_string nstr in + if i = 0 then match ro with + | None -> None + | Some r -> Some(Lval r) + else Some(List.nth args (i-1)) + end else None + | AInt i -> Some(integer i) + | _ -> None + + +let rec drop (l : 'a list) (n : int) : 'a list = + if n = 0 then l else + match l with [] -> [] + | x :: rst -> drop rst (n-1) + + +let taintVarArg (start : int) (el : exp list) : instr list = + let el = drop el start in + List.map (fun e -> + makeInstr instrTaint [e;integer(baseSize(typeOf e)); + one;fileToken;lineToken]) el + + +let taintFlowCall (i : instr) : instr list = + match i with + | Call(None,Lval(Var fvi,NoOffset),el,_) -> begin + List.fold_left (fun il (Attr(an, apl)) -> + if an = "Taint" then begin + match apl with + | [ap;sz;num] -> begin + match paramTrans ap el None, + paramTrans sz el None, + paramTrans num el None with + | None, _, _ -> il + | _, None, _ -> il + | _, _, None -> il + | Some e, Some s, Some n -> + let (_,_,sop) = opToTypeAndSym e in + (makeInstr instrTaint [sop;s;n; + fileToken;lineToken])::il + end + | _ -> E.s(bug "taintFlowCall: bad attribute\n") + end else if an = "CTaint" then begin + match apl with + | [iap; oap] -> begin + match paramTrans iap el None, + paramTrans oap el None with + | _, None | None, _ -> il + | Some ie, Some oe -> + let (_,_,isop) = opToTypeAndSym ie in + let (otyp,osz,osop) = opToTypeAndSym oe in + let fe = AddrOf(Var fvi, NoOffset) in + (makeInstr instrCTaint [isop;osop;fe;oe;otyp;osz; + fileToken;lineToken])::il + end + | _ -> E.s(bug "taintFlowCall: bad attribute\n") + end else if an = "ScanTaint" then begin + match apl with + | [AInt start] -> begin + taintVarArg start el + end + | _ -> E.s(bug "taintFlowCall: bad attribute\n") + end else il) [] fvi.vattr + end + | Call(Some dlv,Lval(Var fvi,NoOffset),el,_) -> begin + List.fold_left (fun il (Attr(an,apl)) -> + if an = "Taint" then begin + match apl with + | [ap;sz;num] -> begin + match paramTrans ap el (Some dlv), + paramTrans sz el (Some dlv), + paramTrans num el (Some dlv) with + | None, _, _ -> il + | _, None, _ -> il + | _, _, None -> il + | Some e, Some s, Some n -> + let (_,_,sop) = opToTypeAndSym e in + (makeInstr instrTaint [sop;s;n; + fileToken;lineToken])::il + end + | _ -> E.s(bug "taintFlowCall: bad Attribute\n") + end else if an = "CTaint" then begin + match apl with + | [iap; oap] -> begin + match paramTrans iap el (Some dlv), + paramTrans oap el (Some dlv) with + | None, _ | _, None -> il + | Some ine, Some oute -> + let (_,_,isop) = opToTypeAndSym ine in + let (otyp,osz,osop) = opToTypeAndSym oute in + let fe = AddrOf(Var fvi, NoOffset) in + (makeInstr instrCTaint [isop;osop;fe;oute;otyp;osz; + fileToken;lineToken])::il + end + | _ -> E.s(bug "taintFlowCall: bad attribute\n") + end else if an = "ScanTaint" then begin + match apl with + | [AInt start] -> begin + taintVarArg start el + end + | _ -> E.s(bug "taintFlowCall: bad attribute\n") + end else il) [] fvi.vattr + end + | _ -> [] + + +let instrumentInstr (i : instr) : stmtkind = + if isInstrFun i then Instr [i] else + let (preinstri,postinstri) = + match i with + | Set(lv, e,_) -> begin + let destaddr = + match lv with + | (Mem destaddr, NoOffset) -> destaddr + | (Var vi, off) -> AddrOf lv + | _ -> E.s(bug "instrumentInstr: lval not basic\n") + in + match e with + | Const _ | AddrOf(_,_) | StartOf(_,_) -> + let (typ,sz,sop) = opToTypeAndSym e in + ([makeInstr instrAssign [destaddr;e;sop;typ;sz]],[]) + | Lval(Var vi, off) -> + let (typ,sz,sop) = opToTypeAndSym e in + ([makeInstr instrAssign + [destaddr;e;sop;typ;sz]], + []) + | Lval(Mem srcaddr, NoOffset) -> + let (typ,sz,sop) = opToTypeAndSym e in + ([makeInstr instrAssign [destaddr;e;srcaddr;typ;sz]],[]) + | BinOp(bop, op1, op2,_) -> + let (t1, sz1, sop1) = opToTypeAndSym op1 in + let (t2, sz2, sop2) = opToTypeAndSym op2 in + ([makeInstr instrBop + [destaddr;constBop bop;op1;sop1;t1;sz1;op2;sop2;t2;sz2]], + []) + | UnOp(uop, op,_) -> + let (t, sz, sop) = opToTypeAndSym op in + ([makeInstr instrUop [destaddr;constUop uop;op;sop;t;sz]],[]) + | CastE(t,bexp) -> + let (typ, sz, sop) = opToTypeAndSym e in + ([makeInstr instrAssign [destaddr;e;sop;typ;sz]],[]) + | _ -> E.s(bug "instrumentInstr: exp not 3-address\n") + end + | Call(None, fe, bel, loc) -> begin + match instrToCheck i with + | Some c -> begin + (makeCheckInstr c, []) + end + | None -> + (* XXX: check for libc calls here *) + let pushList = List.map (fun e -> + let (typ, sz, sop) = opToTypeAndSym e in + makeInstr instrPushArg [e;sop;typ;sz]) + bel + in + let taintInstrs = taintFlowCall i in + (pushList,taintInstrs@[makeInstr instrRetNoRet [integer(List.length bel)]]) + end + | Call(Some dlv, fe, bel, loc) -> + let makeRetPop lv = + match lv with + | (Mem bexp, NoOffset) -> + let (typ,sz,sop) = opToTypeAndSym (Lval lv) in + makeInstr instrPopRet [Lval lv;bexp;typ;sz;integer(List.length bel)] + | (Var vi, off) -> + let (typ,sz,sop) = opToTypeAndSym (Lval lv) in + makeInstr instrPopRet [Lval lv;AddrOf lv;typ;sz;integer(List.length bel)] + | _ -> E.s(bug "instrumentInstr: lval not basic\n") + in + let pushList = List.map (fun e -> + let (typ, sz, sop) = opToTypeAndSym e in + makeInstr instrPushArg [e;sop;typ;sz]) + bel + in + let taintInstrs = taintFlowCall i in + let retInstrs = + match taintInstrs with + | [] -> [makeRetPop dlv] + | _ -> [] + in + (pushList,taintInstrs@retInstrs) + | Asm(_,_,_,_,_,_) -> + (* XXX: do something reasonable *) + ([],[]) + in + Instr(preinstri@[i]@postinstri) + +let instrUnRegLocals (sid : int) (fd : fundec) : instr list = + List.fold_left (fun ls vi -> + match unrollType vi.vtype with + | TArray (_,_,_) | TComp(_,_) -> ls + | _ -> + if not(Dtaint.viTainted sid vi) then ls else + let (typ,sz,sop) = opToTypeAndSym (Lval(Var vi, NoOffset)) in + (makeInstr instrUnRegLocal [sop;typ;sz])::ls) + [] (fd.slocals@fd.sformals) + +let instrumentReturn (sid : int) + (fd : fundec) + (inMain : bool) + ((eo : exp option), (loc : location)) + : stmtkind + = + let i e = + match e with + | Const _ | AddrOf(_,_) | StartOf(_,_) -> + let (typ, sz, sop) = opToTypeAndSym e in + makeInstr instrRetBasic [e;sop;typ;sz] + | Lval(Var vi, off) -> + let (typ, sz, sop) = opToTypeAndSym e in + makeInstr instrRetBasic [e;sop;typ;sz] + | Lval(Mem srcaddr, NoOffset) -> + let (typ,sz,sop) = opToTypeAndSym e in + makeInstr instrRetBasic [e;srcaddr;typ;sz] + | BinOp(bop, op1, op2,_) -> + let (t1, sz1, sop1) = opToTypeAndSym op1 in + let (t2, sz2, sop2) = opToTypeAndSym op2 in + makeInstr instrRetBop [constBop bop;op1;sop1;sz1;t1;op2;sop2;t2;sz2] + | UnOp(uop,op,_) -> + let (t, sz, sop) = opToTypeAndSym op in + makeInstr instrRetUop [constUop uop;op;sop;t;sz] + | CastE(t,bexp) -> + let (typ, sz, sop) = opToTypeAndSym e in + makeInstr instrRetBasic [e;sop;typ;sz] + | _ -> E.s(bug "instrumentInstr: exp not 3-address\n") + in + let mainRet = if inMain then [makeInstr instrEnd []] else [] in + let unregs = instrUnRegLocals sid fd in + match eo with + | None -> + let ri = makeInstr instrRetVoid [] in + Block(mkBlock [mkStmt (Instr(ri::(unregs@mainRet))); mkStmt (Return(eo,loc))]) + | Some e -> + Block(mkBlock [mkStmt (Instr([i e]@unregs@mainRet)); mkStmt (Return(eo,loc))]) + +let instrumentIf ((ce : exp), (tb : block), (fb : block), (loc : location)) : stmtkind = + let i = + match ce with + | Const _ | AddrOf(_,_) | StartOf(_,_) -> + let (typ,sz,sop) = opToTypeAndSym ce in + makeInstr instrIfBasic [ce;sop;typ;sz;fileToken;lineToken] + | Lval(Var vi, off) -> + let (typ,sz,sop) = opToTypeAndSym ce in + makeInstr instrIfBasic [ce;sop;typ;sz;fileToken;lineToken] + | Lval(Mem srcaddr, NoOffset) -> + let (typ,sz,sop) = opToTypeAndSym ce in + makeInstr instrIfBasic [ce;srcaddr;typ;sz;fileToken;lineToken] + | BinOp(bop, op1, op2, _) -> + let (t1,sz1,sop1) = opToTypeAndSym op1 in + let (t2,sz2,sop2) = opToTypeAndSym op2 in + makeInstr instrIfBop [constBop bop;op1;sop1;t1;sz1;op2;sop2;t2;sz2; + fileToken;lineToken] + | UnOp(uop, op, _) -> + let (t, sz, sop) = opToTypeAndSym op in + makeInstr instrIfUop [constUop uop;op;sop;t;sz;fileToken;lineToken] + | CastE(t, op) -> + let (typ, sz, sop) = opToTypeAndSym ce in + makeInstr instrIfBasic [op;sop;typ;sz;fileToken;lineToken] + | _ -> E.s(bug "instrumentIf: exp not 3-address\n") + in + Block(mkBlock [mkStmt (Instr [i]); mkStmt (If(ce,tb,fb,loc))]) + +let getCase x = + let c = + List.filter + (function Case(_,_) -> true | _ -> false) + x.labels + in + match c with + | [Case(e,l)] -> Some e + | _ -> None + +let rec getCases stmts acc = + match stmts with + | [] -> acc + | x :: rst -> begin + match getCase x with + | None -> getCases rst acc + | Some e -> getCases rst (e::acc) + end + +let makeBasicSwitchInstrs (e : exp) (sl : stmt list) : instr list = + let (t, sz, sop) = opToTypeAndSym e in + List.map (fun conste -> + makeInstr instrSwitchBasic [conste;e;sop;t;sz]) + (getCases sl []) + +let makeBopSwitchInstrs ((bop:binop),(op1:exp),(op2:exp)) (sl:stmt list) : instr list = + let (t1, sz1, sop1) = opToTypeAndSym op1 in + let (t2, sz2, sop2) = opToTypeAndSym op2 in + List.map (fun conste -> + makeInstr instrSwitchBop [conste;constBop bop;op1;sop1;t1;sz1;op2;sop2;t2;sz2]) + (getCases sl []) + +let makeUopSwitchInstrs ((uop:unop),(op:exp)) (sl:stmt list) : instr list = + let (t, sz, sop) = opToTypeAndSym op in + List.map (fun conste -> + makeInstr instrSwitchUop [conste;constUop uop;op;sop;t;sz]) + (getCases sl []) + +let instrumentSwitch ((e:exp), (b:block), (sl:stmt list), (loc:location)) : stmtkind = + let il = + match e with + | Const _ | AddrOf(_,_) | StartOf(_,_) + | Lval(Var _, _) + | Lval(Mem _, NoOffset) -> + makeBasicSwitchInstrs e sl + | BinOp(bop, op1, op2, _) -> + makeBopSwitchInstrs (bop,op1,op2) sl + | UnOp(uop, op, _) -> + makeUopSwitchInstrs (uop,op) sl + | CastE(_, _) -> + makeBasicSwitchInstrs e sl + | _ -> E.s(bug "instrumentSwitch: exp not 3-address\n") + in + Block(mkBlock [mkStmt (Instr il); mkStmt (Switch(e,b,sl,loc))]) + +let rec instrumentStmt (fd : fundec) (inMain : bool) (s : stmt) : unit = + match s.skind with + | Instr il -> begin + match il with + | [] -> () + | [i] -> if Dtaint.instrContainsTaint s.sid i then + s.skind <- instrumentInstr i + | _ -> E.s(bug "instrumentStmt: Instr with more than one instr\n") + end + | Return(eo, loc) -> + s.skind <- instrumentReturn s.sid fd inMain (eo,loc) + | Goto(_,_) -> () + | Break _ -> () + | Continue _ -> () + | If(ce,tb,fb,loc) -> begin + instrumentBlock fd inMain tb; + instrumentBlock fd inMain fb; + if Dtaint.expContainsTaint s.sid ce then + s.skind <- instrumentIf (ce,tb,fb,loc) + end + | Switch(e,b,sl,loc) -> begin + instrumentBlock fd inMain b; + s.skind <- instrumentSwitch (e,b,sl,loc) + end + | Loop(b,_,_,_) -> instrumentBlock fd inMain b + | Block b -> instrumentBlock fd inMain b + | TryFinally(b1,b2,_) -> begin + instrumentBlock fd inMain b1; + instrumentBlock fd inMain b2 + end + | TryExcept(b1,_,b2,_) -> begin + instrumentBlock fd inMain b1; + instrumentBlock fd inMain b2 + end + +and instrumentBlock (fd : fundec) (inMain : bool) (b : block) : unit = + List.iter (instrumentStmt fd inMain) b.bstmts + +let fixMain (fd : fundec) : unit = + (*let arg = + if List.exists (fun vi -> vi.vname = "argv") fd.sformals then + Lval(Var(List.find (fun vi -> vi.vname = "argv") fd.sformals),NoOffset) + else CastE(voidPtrType,zero) + in*) + let dinstr_init = makeInstr instrInit [] in + let argv_init = makeInstr instrArgv + ((List.map (fun vi -> Lval(Var vi, NoOffset)) fd.sformals)@ + [fileToken;lineToken]) + in + fd.svar.vname <- "cMain"; + fd.sbody.bstmts <- + (mkStmt(Instr [dinstr_init;argv_init]))::fd.sbody.bstmts +(* +type rfContext = +{ + rfHash : (string, fundec) Hashtbl.t; (* reg funs already built *) + mutable rfTyps : typ list (* types already seen in a traversal *) + mutable rfAttrCtxt : context (* attribute context *) +} + +(* returns an expression for the start of an array, and the size in context c *) +let getCount (t : typ) (e : exp) (c : context) : exp * exp = + if isNullterm t then (e, integer (-1)) + let rec getBounds (a : attributes) : exp * exp option = + match a with + | Attr ("bounds", [lo; hi]) :: _ -> + let _, lo' = compileAttribute ctx lo in + let _, hi' = compileAttribute ctx hi in + Some(lo', hi') + | Attr ("fancybounds", [AInt lo; AInt hi]) :: _ -> + Some(getBoundsExp lo, getBoundsExp hi) + | Attr _ :: rest -> getBounds rest + | _ -> None + in + match getBounds (typeAttrs t) with + | None -> (e, one) + | Some(lo, hi) -> (lo, BinOp(MinusPP, hi, lo, t)) + + +let isStructType (t : typ) : bool = + match unrollType t with + | TComp(ci,_) when ci.cstruct -> true + | _ -> false + +let getRegFunForStructType (ctx : rfContext) + (f : file) + (baseTyp : typ) + : exp + = + match baseTyp with + + +(* Make a call to register an argument. Build the registration function and add + it to rfHash if necessary. Do this recursively for structure fields. Punt on + recursive and abstract types. *) +let getRegFunForFormal (ctx : rfContext) (* already built reg funs. ptr types already chased *) + (vi : varinfo) (* exp we're building for *) + : instr (* call to the reg fun for e *) + = + let typ = vi.vtype in + let e = Lval(Var vi, NoOffset) in + if isPtrOrArray typ then (* potential aggregate *) + if isAbstractPtr typ then (* can't look in, so register as a scalar *) + let (typ,sz,sop) = opToTypeAndSym e + makeInstr instrRegField [e;sop;typ;sz] + else if isStructType (baseType typ) then + let regFun = getRegFunForCompTyp ctx f (baseType typ) in + let (base,cnt) = getCount typ e ctx.context in + let sz = integer (baseSize typ) in + makeInstr instrRegArray [base;sz;cnt;regFun] + else (* yay it's just a scalar! Return call to RegisterField*) + let (typ,sz,sop) = opToTypeAndSym e in + makeInstr instrRegField [e;sop;typ;sz] +*) + + +let addPrologue (inMain : bool) (fd : fundec) : unit = + let pinstrs = + List.map (fun vi -> + makeInstr instrPopArg [AddrOf(Var vi, NoOffset)]) + (List.rev fd.sformals) + in + (*let locinstrs = instrRegLocals fd in + let pinstrs = locinstrs @ pinstrs in*) + let pinstrs = (makeInstr instrFunStart [integer(List.length pinstrs)])::pinstrs in + if pinstrs <> [] && not(inMain) then + fd.sbody.bstmts <- (mkStmt(Instr pinstrs))::fd.sbody.bstmts; + if inMain then + fixMain fd + +let stripRegister (fd : fundec) : unit = + let f vi = + match vi.vstorage with + | Register -> vi.vstorage <- NoStorage + | _ -> () + in + List.iter f fd.slocals + +let instrumentFun (fd : fundec) : unit = + let inMain = (fd.svar.vname = "main") in + stripRegister fd; + fixBlock fd.sbody; + Dtaint.computeTaint fd; + instrumentBlock fd inMain fd.sbody; + addPrologue inMain fd + +let mergeTaintAnnots (f : file) : unit = + try + let fn = "itaint.patch.h" in + let fh = open_in fn in + close_in fh; + Dpatch.applyPatch f fn + with Sys_error _ -> ignore(E.log "mergeTaintAnnots: failed\n") + +let instrumentFile (f : file) : unit = + Simplify.splitStructs := false; + Simplify.simpleMem := false; + Simplify.simplAddrOf := false; + mergeTaintAnnots f; + iterGlobals f Simplify.doGlobal; + iterGlobals f (function GFun(fd,_) -> instrumentFun fd | _ -> ()); + iterGlobals f (function GFun(fd,_) -> Oneret.oneret fd | _ -> ()); + f.globals <- (GText("#include "))::f.globals diff --git a/src/instrumenter/dtaint.ml b/src/instrumenter/dtaint.ml new file mode 100644 index 0000000..bdba877 --- /dev/null +++ b/src/instrumenter/dtaint.ml @@ -0,0 +1,531 @@ +(* + * dtaint.ml + * + * A taint analysis for tracking program inputs. + * + * + *) + +open Cil +open Expcompare +open Pretty +open Dattrs +open Dcheckdef +open Dutil + +module H = Hashtbl +module IH = Inthash +module E = Errormsg +module DF = Dataflow +module P = Ptranal +module F = Frontc + +let debug = ref true + +let staint_fname = "staint.patch.h" + +module LEH = + H.Make(struct + type t = lval + let equal lv1 lv2 = compareLval lv1 lv2 + let hash = H.hash + end) + +let leh_tryfind leh k = + try Some(LEH.find leh k) + with Not_found -> None + +module VS = Usedef.VS + +module VEH = + H.Make(struct + type t = varinfo + let equal vi1 vi2 = vi1.vid = vi2.vid + let hash = H.hash + end) + +let tryfind veh k = + try Some(H.find veh k) + with Not_found -> None + +let readPatchAnnots () : (string,varinfo) H.t = try + let dummy = open_in staint_fname in + close_in dummy; + let veh = H.create 16 in + let pfile = F.parse staint_fname () in + List.iter (fun g -> match g with + | GVarDecl(fdv, _) -> begin + if not(H.mem builtinFunctions fdv.vname) then begin + ignore(E.log "readPatchAnnots: %a\n" dp_global (GVarDecl(fdv,locUnknown))); + H.replace veh fdv.vname fdv + end + end + | GVar(fdv,_,_) -> begin + if not(H.mem builtinFunctions fdv.vname) then begin + ignore(E.log "readPatchAnnots: %a\n" dp_global (GVarDecl(fdv,locUnknown))); + H.replace veh fdv.vname fdv + end + end + | _ -> ()) pfile.globals; + veh + with Sys_error _ -> H.create 16 + +let writePatchAnnots (ta : (string,varinfo) H.t) : unit = + let outpf = open_out staint_fname in + H.iter (fun _ vi -> + if not(H.mem builtinFunctions vi.vname) then begin + ignore(E.log "writePatchAnnot: %a\n" dp_global (GVarDecl(vi,locUnknown))); + let d = dprintf "%a\n" dp_global (GVarDecl(vi,locUnknown)) in + fprint outpf ~width:200 d + end) + ta; + close_out outpf + +type tData = { + leh : lval LEH.t; + vis : VS.t; + ann : (string,varinfo) H.t; +} + +let logArgAnnots (vi : varinfo) : unit = + match unrollType vi.vtype with + | TFun(_,al,_,_) -> begin + List.iter (fun (_,_,an) -> + List.iter (fun (Attr(a,_)) -> + ignore(E.log "found arg attr = %s\n" a)) + an) + (argsToList al) + end + | _ -> () + +let addPatchAnnots (td : tData) (vi : varinfo) : unit = + ignore(E.log "Dtaint: adding patch: %a\n" dp_global (GVarDecl(vi,locUnknown))); + logArgAnnots vi; + H.replace td.ann vi.vname vi + +let leh_pretty () leh = + LEH.fold (fun lv _ d -> d ++ text " " ++ (d_lval () lv)) leh nil +let leh_contains leh1 leh2 = + LEH.fold (fun lv _ b -> b && LEH.mem leh1 lv) leh2 true +let leh_equals leh1 leh2 = + (leh_contains leh1 leh2) && (leh_contains leh2 leh1) +let leh_union leh1 leh2 = + let nleh = LEH.copy leh1 in + LEH.iter (fun lv _ -> LEH.replace nleh lv lv) leh2; + nleh + +let h_union veh1 veh2 = + let nveh = H.copy veh1 in + H.iter (fun n vi -> H.replace nveh n vi) veh2; + nveh + +class taintFinderClass tD br = object(self) + inherit nopCilVisitor + + method vlval (lv : lval) = + if LEH.mem tD.leh lv then begin + br := true; + SkipChildren + end else DoChildren + + method vvrbl (vi : varinfo) = + if H.mem tD.ann vi.vname || vi.vname = "argv" then begin + br := true; + SkipChildren + end else DoChildren +end + +let isTainted tD (e : exp) : bool = + let br = ref false in + let vis = new taintFinderClass tD br in + ignore(visitCilExpr vis e); + !br + +class viFinderClass vi br = object(self) + inherit nopCilVisitor + + method vvrbl vi' = + if vi.vid = vi'.vid + then (br := true; SkipChildren) + else DoChildren + +end + +let lval_has_vi vi lv = + let br = ref false in + let vis = new viFinderClass vi br in + ignore(visitCilLval vis lv); + !br + +let viTainted tD (vi : varinfo) : bool = + LEH.fold (fun lv _ b -> b || lval_has_vi vi lv) tD.leh false + +let taintArgs tD (el : exp list) : unit = + List.iter (fun e -> match e with + | Lval lv + | AddrOf lv + | StartOf lv -> begin + ignore(E.log "taintArgs: %a\n" d_exp e); + LEH.replace tD.leh lv lv + end + | _ -> ()) el + +let take (l : 'a list) (n : int) : 'a list = + let rec h l n acc = + if n = 0 then List.rev acc else + match l with [] -> List.rev acc + | x :: rst -> h rst (n-1) (x :: acc) + in + h l n [] + +let taintSomeArgs tD stal (args : exp list) : unit = + let args = take args (List.length stal) in + List.iter2 (fun (s,t,al) a -> + if List.exists (fun (Attr(an,_)) -> an = "tainted") al then + taintArgs tD [a]) stal args + +let paramTrans (ap : attrparam) + (args : exp list) + (ro : lval option) : exp option = + match ap with + | AStar(ACons(is,[])) -> + if String.sub is 0 1 = "$" then begin + let nstr = String.sub is 1 ((String.length is) - 1) in + let i = int_of_string nstr in + if i = 0 then match ro with + | Some r -> Some(Lval(Mem (Lval r),NoOffset)) + | None -> None + else Some(Lval(Mem(List.nth args (i-1)),NoOffset)) + end else None + | ACons(is,[]) -> + if String.sub is 0 1 = "$" then begin + let nstr = String.sub is 1 ((String.length is) - 1) in + let i = int_of_string nstr in + if i = 0 then match ro with + | None -> None + | Some r -> Some(Lval r) + else Some(List.nth args (i-1)) + end else None + | AInt i -> Some(integer i) + | _ -> None + +let rec drop (l : 'a list) (n : int) : 'a list = + if n = 0 then l else + match l with [] -> [] + | x :: rst -> drop rst (n-1) + +let taintVarArg tD (start : int) (args : exp list) : unit = + let args = drop args start in + List.iter (fun e -> taintArgs tD [e]) args + +let taintCall tD (fvi : varinfo) (args : exp list) (lvo : lval option) : unit = + let fvi = match tryfind tD.ann fvi.vname with None -> fvi | Some vi -> vi in + ignore(E.log "taintCall: %s\n" fvi.vname); + List.iter (fun (Attr(an, apl)) -> + if an = "Taint" then begin + match apl with + | [ap;sz;num] -> begin + match paramTrans ap args lvo with + | None -> () + | Some a -> taintArgs tD [a] + end + | _ -> E.s(bug "taintCall: bad attribute\n") + end else if an = "CTaint" then begin + ignore(E.log "Found CTaint function: %s\n" fvi.vname); + match apl with + | [iap; oap] -> begin + match paramTrans iap args lvo, + paramTrans oap args lvo with + | None, _ | _, None -> () + | Some ie, Some oe -> + if isTainted tD ie then taintArgs tD [oe] + else () + end + | _ -> E.s(bug "taintCall: bad attribute\n") + end else if an = "ScanTaint" then begin + ignore(E.log "taintCall: found ScanTaint: %s\n" fvi.vname); + match apl with + | [AInt start] -> begin + taintVarArg tD start args + end + | _ -> E.s(bug "taintCall: bad attribute\n") + end else if an = "tainted" then begin + (* the return value becomes tainted *) + match lvo with + | None -> () + | Some lv -> begin + ignore(E.log "taintCall: adding %a\n" d_exp (Lval lv)); + taintArgs tD [Lval lv] + end + end else ()) fvi.vattr + +let addTaintAnnots tD (fvi : varinfo) (el : exp list) : unit = + let fvi = match tryfind tD.ann fvi.vname with None -> fvi | Some vi -> vi in + match unrollType fvi.vtype with + | TFun(r,al,b,l) -> begin + let el = take el (List.length (argsToList al)) in + let modified = ref false in + let nal = List.map2 (fun (s,t,an) a -> + if isTainted tD a then begin + ignore(E.log "addTaintAnnots: %a is tainted\n" d_exp a); + modified := true; + (s,t,addAttribute (Attr("tainted",[])) an) + end else begin + ignore(E.log "addTaintAnnots: %a is not tainted\n" d_exp a); + (s,t,an) + end) + (argsToList al) el + in + if !modified then begin + (match al with None -> () | Some _ -> fvi.vtype <- TFun(r,Some nal,b,l)); + addPatchAnnots tD fvi + end + end + | _ -> E.s(bug "non-fun in addTaintAnnots\n") + +class globFinderClass (vilr : VS.t ref) = object(self) + inherit nopCilVisitor + + method vvrbl (vi : varinfo) = + if vi.vglob then begin + vilr := VS.add vi (!vilr); + DoChildren + end else DoChildren + +end + +let globals_from_lv (lv : lval) : VS.t = + let vilr = ref VS.empty in + let vis = new globFinderClass vilr in + ignore(visitCilLval vis lv); + !vilr + +let addTaintGlobs tD = + LEH.iter (fun lv _ -> + VS.iter (fun gvi -> + gvi.vattr <- addAttribute (Attr("tainted",[])) gvi.vattr; + addPatchAnnots tD gvi) + (globals_from_lv lv)) + tD.leh + +let addTaintFormals tD fd = + let fvi = match tryfind tD.ann fd.svar.vname with None -> fd.svar | Some vi -> vi in + match unrollType fvi.vtype with + | TFun(r,al,b,l) -> begin + let modified = ref false in + let nal = List.map2 (fun (s,t,an) vi -> + if viTainted tD vi then begin + modified := true; + (s,t,addAttribute (Attr("tainted",[])) an) + end else (s,t,an)) + (argsToList al) fd.sformals + in + if !modified then begin + (match al with None -> () | Some _ -> fvi.vtype <- TFun(r,Some nal,b,l)); + addPatchAnnots tD fvi + end + end + | _ -> E.s(bug "non-fun in addTaintFormals\n") + +let isLibCCall (fvi : varinfo) : bool = + match fvi.vname with + | "memcpy" | "memmove" | "strncpy" | "__builtin_strncpy" | "strlcpy" + | "bzero" | "strdup" | "__strdup" -> true + | _ -> false + +let handleLibCCall (i : instr) (tD : tData) : unit = + match i with + | Call(lvo,Lval(Var fvi,NoOffset),[d;s;_],_) + when fvi.vname = "memcpy" || fvi.vname = "memmove" || + fvi.vname = "strncpy" || fvi.vname = "__builtin_strncpy" || + fvi.vname = "strlcpy" -> + if isTainted tD s then taintArgs tD [d] + | Call(lvo,Lval(Var fvi,NoOffset),args,_) when fvi.vname = "bzero" -> + () + | Call(Some lv,Lval(Var fvi,NoOffset),[s],_) + when fvi.vname = "strdup" || fvi.vname = "__strdup" -> + if isTainted tD s then LEH.replace tD.leh lv lv + | _ -> () + + +(* All of the intelligence goes here *) +let handleInstr i tD = + ignore(E.log "handleInstr: looking at: %a\n" d_instr i); + if is_check_instr i then tD else + match i with + | Set(lv,e,_) -> begin + if isTainted tD e then LEH.replace tD.leh lv lv; + tD + end + | Call(_,Lval(Var fvi,NoOffset),_,_) when isLibCCall fvi -> begin + handleLibCCall i tD; + tD + end + | Call(Some lv,Lval(Var fvi,NoOffset),args,_) -> begin + addTaintAnnots tD fvi args; + taintCall tD fvi args (Some lv); + match unrollType fvi.vtype with + | TFun(_,al,_,_) -> begin + taintSomeArgs tD (argsToList al) args; + tD + end + | _ -> E.s(bug "non-fun in handleInstr\n") + end + | Call(None,Lval(Var fvi,NoOffset),args,_) -> begin + addTaintAnnots tD fvi args; + taintCall tD fvi args None; + match unrollType fvi.vtype with + | TFun(_,al,_,_) -> begin + taintSomeArgs tD (argsToList al) args; + tD + end + | _ -> E.s(bug "non-fun in handleInstr\n") + end + | Call(Some lv,fe,args,_) -> begin + LEH.replace tD.leh lv lv; + taintArgs tD args; + tD + end + | Call(None,fe,args,_) -> begin + taintArgs tD args; + tD + end + | Asm(_,_,_,_,_,_) -> tD + +module TaintFlow = struct + + let name = "Taint Flow" + let debug = debug + type t = tData + let copy tD = {leh = LEH.copy tD.leh; vis = tD.vis; ann = H.copy tD.ann} + + let stmtStartData = IH.create 64 + + let pretty () tD = leh_pretty () tD.leh + + let computeFirstPredecessor stm tD = tD + + let combinePredecessors (stm:stmt) ~(old:t) (tD:t) = + if leh_equals old.leh tD.leh then None else + Some({leh=leh_union old.leh tD.leh;vis=old.vis;ann=h_union old.ann tD.ann}) + + let doInstr i tD = + let action = handleInstr i in + DF.Post(action) + + let doStmt s tD = DF.SDefault + + let doGuard c leh = DF.GDefault + + let filterStmt stm = true + +end + +module TF = DF.ForwardsDataFlow(TaintFlow) + +let recomputeCfg (fd:fundec) : unit = + Cfg.clearCFGinfo fd; + ignore (Cfg.cfgFun fd) + +let computeTaint (fd : fundec) = + ignore(E.log "computeTaint: %s\n" fd.svar.vname); + recomputeCfg fd; + try let slst = fd.sbody.bstmts in + let first_stm = List.hd slst in + (*let fset = List.fold_left (fun s vi -> VS.add vi s) VS.empty fd.sformals in*) + let fset = VS.empty in + let fdat = {leh = LEH.create 4;vis = fset;ann=readPatchAnnots()} in + IH.clear TaintFlow.stmtStartData; + IH.add TaintFlow.stmtStartData first_stm.sid fdat; + TF.compute [first_stm] + with Failure "hd" -> () + | Not_found -> () + + +let getRetTD (fd : fundec) : tData option = + let rec h sl = + match sl with + | [] -> None + | s :: rst -> begin + match s.skind with + | Return _ -> IH.tryfind TaintFlow.stmtStartData s.sid + | _ -> h rst + end + in + h fd.sallstmts + +let addTaintReturn (tD : tData) (fd : fundec) : unit = + let fvi = match tryfind tD.ann fd.svar.vname with None -> fd.svar | Some vi -> vi in + let rec h sl = + match sl with + | [] -> () + | s :: rst -> begin + match s.skind with + | Return(Some re,_) -> + if isTainted tD re then begin + fvi.vattr <- addAttribute (Attr("tainted",[])) fvi.vattr; + addPatchAnnots tD fvi + end + | _ -> h rst + end + in + h fd.sallstmts + +let updateAnnotations (fd : fundec) = + match getRetTD fd with + | None -> None + | Some returnTD -> begin + addTaintGlobs returnTD; + addTaintFormals returnTD fd; + addTaintReturn returnTD fd; + (Some returnTD) + end + +let instrContainsTaint (sid : int) (i : instr) : bool = + match IH.tryfind TaintFlow.stmtStartData sid with + | None -> false + | Some tD -> begin + let tDp = handleInstr i tD in + let br = ref false in + let vis = new taintFinderClass tD br in + let visp = new taintFinderClass tDp br in + ignore(visitCilInstr vis i); + ignore(visitCilInstr visp i); + !br + end + +let expContainsTaint (sid : int) (e : exp) : bool = + match IH.tryfind TaintFlow.stmtStartData sid with + | None -> false + | Some tD -> isTainted tD e + + +let viTainted (sid: int) (vi : varinfo) : bool = + match IH.tryfind TaintFlow.stmtStartData sid with + | None -> false + | Some tD -> + LEH.fold (fun lv _ b -> b || lval_has_vi vi lv) tD.leh false + +let mergeTaintAnnots (f : file) : unit = + try + let fn = "itaint.patch.h" in + let fh = open_in fn in + close_in fh; + Dpatch.applyPatch f fn + with Sys_error _ -> ignore(E.log "mergeTaintAnnots: failed\n") + +let calcTaintFile (f : file) : unit = + mergeTaintAnnots f; + List.iter (fun g -> + match g with + | GFun(fd,l) -> begin + Oneret.oneret fd; + computeTaint fd; + match updateAnnotations fd with + | None -> () + | Some tD -> writePatchAnnots tD.ann + end + | _ -> ()) + f.globals + + diff --git a/src/main.ml b/src/main.ml new file mode 100644 index 0000000..c7d9d49 --- /dev/null +++ b/src/main.ml @@ -0,0 +1,321 @@ +(* + * + * Copyright (c) 2006, + * Jeremy Condit + * George C. Necula + * 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 F = Frontc +module C = Cil +module E = Errormsg + +let outChannel: out_channel option ref = ref None + +exception Done_Processing + +let printFile ~(extraPrinting:(out_channel->unit) option) + ~(globinit:C.fundec option) + (f: C.file) (name: string) : unit + = + if name <> "" then begin + try + let channel = open_out name in + let printer = (Dattrs.deputyFilePrinter :> C.cilPrinter) in + C.dumpFile printer channel name f; + (match globinit with + Some g -> C.dumpGlobal printer channel (C.GFun(g, C.locUnknown)) + | None -> ()); + (match extraPrinting with + Some doit -> doit channel + | None -> ()); + close_out channel + with Sys_error _ -> + E.s (E.error "Error dumping inference results to %s\n" name) + end + +let parseOneFile (fname: string) : Cabs.file * C.file = + let cabs, cil = F.parse_with_cabs fname () in + Rmtmps.removeUnusedTemps ~isRoot:(Dattrs.treatAsRoot cil) cil; + cabs, cil + +let rec processOneFile ((cabs: Cabs.file), (cil: C.file)) = + try + printFile ~extraPrinting:None ~globinit:None cil !Doptions.parseFile; + Dinfer.preProcessFile cil; + + (* "marked" is the original file plus NODE() annotations. *) + let marked = + if !Doptions.inferKinds then + Stats.time "Interprocedural inference" Inferkinds.inferKinds cil + else + cil + in + if !Doptions.inferBlocking <> "" then begin + Controlflow.blockingAnalysis marked; + raise F.CabsOnly; (* matth: don't run the rest of Deputy. *) + end; + + Dinfer.preProcessFileAfterMarking marked; + (* Now insert the function with the global initializers. Does not insert + * it in the file. *) + let globinit = Dglobinit.prepareGlobalInitializers marked in + + let extraprint = + if !Doptions.inferKinds && !Doptions.emitGraphDetailLevel >= 0 then + Some Ptrnode.printInferGraph + else + None + in + printFile ~extraPrinting:extraprint + ~globinit:(Some globinit) marked !Doptions.inferFile; + + (* See if we should make use of Preconditions annotations *) + let fdat : Dprecfinder.functionData = + if !Doptions.propPreconditions then begin + ignore(E.log "Extracting preconditions from annotations\n"); + let fdat = Dprecfinder.mkFDat() in + Dprecfinder.extractPrecsFromAnnots fdat marked; + Dmodref.extractModAnnotations fdat marked; + fdat + end else Dprecfinder.mkFDat() (* empty *) + in + + (* alias analysis *) + if !Doptions.doPtrAnalysis then begin + Ptranal.callHasNoSideEffects := Dcheckdef.lvNoSideEffects; + Stats.time "Pointer analysis" Ptranal.analyze_file marked; + Stats.time "Pointer analysis" Ptranal.compute_results false + end; + + (* Initialize the octagon analysis. Revert to level 3 if + * it's broken. *) + if !Doptions.optLevel = 4 then + if not(Doctanalysis.init()) then + Doptions.optLevel := 3; + + if !Doptions.findPreconditions then begin + Cfg.clearFileCFG marked; + Cfg.computeFileCFG marked; + ignore(Dprecfinder.applyPrecPatch marked); (* for deputy added funs *) + Dmodref.extractModAnnotations fdat marked; + Dmodref.registerIgnoreInst Dcheckdef.is_check_instr; + Dmodref.registerIgnoreCall Dcheckdef.is_deputy_instr; + Dmodref.registerIgnoreCall Dcheckdef.isLibcNoSideEffects; + Dmodref.addAllModifications fdat marked; + Cfg.clearFileCFG marked + end; + + Dcheck.checkFile marked globinit fdat; + + (* Now do the global initializer *) + let residualChecks: bool = + Dglobinit.checkGlobinit marked globinit + (fun gi -> Dcheck.checkFundec gi) + (fun gi l -> + Doptimmain.optimFunction gi l fdat; + ignore (C.visitCilBlock Dinfer.postPassVisitor gi.C.sbody)) in + + if residualChecks then + marked.C.globals <- marked.C.globals @ [C.GFun (globinit, C.locUnknown)]; + + Dinfer.postProcessFile marked; + + (*let ogchecks, hgchecks = Doptimmain.numGlobalChecks marked in + E.log("GlobalChecks: %d %d\n") ogchecks hgchecks;*) + + if !Doptions.findNonNull then begin + Cfg.clearFileCFG marked; + Cfg.computeFileCFG marked; + Dnonnullfinder.addNonNullAnnotations fdat marked; + Dprecfinder.addAnnotsToPatch fdat "nonnull.patch.h"; + Cil.visitCilFile Dinfer.postPassVisitor marked + end; + + if !Doptions.findPreconditions then begin + Cfg.clearFileCFG marked; + Cfg.computeFileCFG marked; + Dprecfinder.extractPrecsFromAnnots fdat marked; + Dprecfinder.addAllPreconditions fdat marked; + let pfn = (Filename.chop_extension marked.Cil.fileName)^".patch.h" in + Dprecfinder.addAnnotsToPatch fdat pfn; + Cil.visitCilFile Dinfer.postPassVisitor marked + end; + + if !Doptions.htmlOutDir <> "" then begin + Dfdatbrowser.genPageForFile marked fdat + end; + + if !Doptions.instrument then begin + Dinstrumenter.instrumentFile marked; + Cil.visitCilFile Dinfer.postPassVisitor marked + end; + + if !Doptions.taintflow then begin + Dtaint.calcTaintFile marked; + Cil.visitCilFile Dinfer.postPassVisitor marked + end; + + begin + match !outChannel with + | None -> () + | Some c -> + (* Tell CIL to put comments around the bounds attributes. *) + C.print_CIL_Input := false; + Stats.time "printCIL" + (C.dumpFile (!C.printerForMaincil) c !Doptions.outFile) marked + end; + if !Doptions.countTrustedLines && not !E.hadErrors then + Dutil.reportTrustedLines (); + let optTime = Stats.lookupTime "optimizations" in + if optTime >= 20.0 && !Doptions.optLevel > 1 then + E.log("\nNote: Optimizations took %.1f s. For faster (but less precise)" + ^^" analysis, you can use a lower optimization level.\n\n") + optTime; + + if !Doptions.checkCilInvariants && not !E.hadErrors then begin + let ignoreInstr i = + Dcheckdef.is_deputy_instr i || + (match i with + C.Call (_,f,_,_) when Dattrs.isSpecialFunction (C.typeOf f) -> true + | _ -> false) || + Dinstrumenter.isInstrFun i + in + if not(Check.checkFile + [Check.IgnoreInstructions ignoreInstr] marked) then + E.s (Dutil.bug "Check.checkFile failed after optimizations\n"); + end; + + if !E.hadErrors then + raise E.Error + with Done_Processing -> () + +let main () = + let usageMsg = "Usage: deputy [options] source-files" 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; + + (* Turn off the implicit casts *) + C.insertImplicitCasts := false; + + (* Turn off line wrapping. *) + C.lineLength := 100000; + + (* Suppress truncate warnings. *) + C.warnTruncate := false; + + (* Make TRUSTED an attribute of types, not names. + * (This is just for the sake of uniformity) *) + Hashtbl.add C.attributeHash "trusted" C.AttrType; + + (* Tell cabs2cil to strip dependent attributes from the types of + * temporaries that it creates and casts that it inserts. Also tell + * it to alpha-rename Deputy attributes when merging function types. *) + Cabs2cil.typeForTypeof := Dutil.stripDepsFromType; + Cabs2cil.typeForInsertedVar := Dutil.stripDepsFromType; + Cabs2cil.typeForInsertedCast := Dutil.stripDepsFromType; + Cabs2cil.typeForCombinedArg := Dpatch.patchAttrParamsInType; + Cabs2cil.attrsForCombinedArg := Dpatch.patchAttrParamsInAttrs; + + (* Don't make the cast between a function call and its destination + explicit. We need to set this so that polymorphic functions + are handled correctly. *) + Cabs2cil.doCollapseCallCast := true; + + Arg.parse (Doptions.align Doptions.options) Ciloptions.recordFile usageMsg; + + if !Doptions.stats then + Stats.reset Stats.SoftwareTimer; (* no performance counters *) + (* else leave Stats disabled *) + + + if !Doptions.outFile <> "" then begin + try + outChannel := Some (open_out !Doptions.outFile) + with _ -> + E.s (E.error "Couldn't open file %s\n" !Doptions.outFile) + end; + + Cil.initCIL (); + Ciloptions.fileNames := List.rev !Ciloptions.fileNames; + + let fileName = + match !Ciloptions.fileNames with + | [name] -> name + | [] -> E.s (E.error "No file names provided\n") + | _ -> E.s (E.error "Too many file names provided (%a)\n" + (Pretty.docList Pretty.text) !Ciloptions.fileNames) + in + + let cabs, file = parseOneFile fileName in + + List.iter (Dpatch.applyPatch file) !Doptions.patches; + + (* If there is no precondition patch file, then make one *) + if !Doptions.propPreconditions && + not(Dprecfinder.applyPrecPatch file) then begin + Doptions.findPreconditions := true; + Doptions.propPreconditions := false + end; + + if !E.hadErrors then + E.s (E.error "Cabs2cil had some errors"); + + processOneFile (cabs, file) +;; + +let failed = ref false + +let cleanup () = + Dutil.outputAll (); + if !E.verboseFlag || !Doptions.stats then + Stats.print !E.logChannel "Timings:\n"; + if !E.logChannel != stderr then + close_out (! E.logChannel); + match !outChannel with + | Some c -> close_out c + | _ -> () +;; + +begin + try + main () + with + | F.CabsOnly -> (* this is OK *) () + | E.Error -> failed := true +end; +cleanup (); +exit (if !failed then 1 else 0) diff --git a/src/optimizer/dcanonexp.ml b/src/optimizer/dcanonexp.ml new file mode 100644 index 0000000..a416fe4 --- /dev/null +++ b/src/optimizer/dcanonexp.ml @@ -0,0 +1,422 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * + * dcanonexp.ml + * + * Canonicalizer for Cil expressions. + * + *) + +open Cil +open Expcompare +open Pretty +open Doptions +open Dutil +(*open Doptimutil*) +open Dattrs + +module E = Errormsg + +let rec canTypeOf (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) -> charPtrType + + | Const(CWStr s) -> TPtr(!wcharType,[]) + + | Const(CReal (_, fk, _)) -> TFloat(fk, []) + + | Const(CEnum(_, _, ei)) -> TEnum(ei, []) + + | Lval(lv) -> canTypeOfLval lv + | SizeOf _ | SizeOfE _ | SizeOfStr _ -> !typeOfSizeOf + | AlignOf _ | AlignOfE _ -> !typeOfSizeOf + | UnOp (_, _, t) -> t + | BinOp (_, _, _, t) -> t + | CastE (t, _) -> t + | AddrOf (lv) -> TPtr(canTypeOfLval lv, []) + | StartOf (lv) -> begin + match unrollType (canTypeOfLval lv) with + TArray (t,_, a) -> TPtr(t, a) + | _ -> E.s (E.bug "canTypeOf: StartOf on a non-array") + end + +and canTypeOfInit (i: init) : typ = + match i with + SingleInit e -> canTypeOf e + | CompoundInit (t, _) -> t + +and canTypeOfLval = function + Var vi, off -> canTypeOffset vi.vtype off + | Mem addr, off -> begin + match unrollType (canTypeOf addr) with + TPtr (t, _) + | TArray(t,_,_) -> canTypeOffset t off + | _ -> E.s (bug "canTypeOfLval: Mem on a non-pointer (%a):%a" d_exp addr d_type (canTypeOf addr)) + end + +and canTypeOffset 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 = canTypeOffset t o in + blendAttributes baseAttrs elementType + | t -> E.s (E.bug "canTypeOffset: Index on a non-array") + end + | Field (fi, o) -> + match unrollType basetyp with + TComp (_, baseAttrs) -> + let fieldType = canTypeOffset fi.ftype o in + blendAttributes baseAttrs fieldType + | _ -> E.s (bug "canTypeOffset: Field on a non-compound") + +(** Keep expressions to be compared in a canonical form: a constant + sum of + * weighted expressions, where the latter are not something that can be + * broken in a canonical expression themselves. These atomic expressions will + * be compared for equality. *) +module Can = struct + type t = + { ct: int64; + cf: (int64 * exp) list; + ck: ikind; + } + let mkInt n ik = { ct = n; cf = []; ck = ik} + let atomic (f: int64) (e: exp) (ik : ikind) = + if f = Int64.zero then { ct = Int64.zero; cf = []; ck = ik } else + { ct = Int64.zero; cf = [(f, e)]; ck = ik} + + let zero ik = mkInt Int64.zero ik + let weightedAdd (w1: int64) (c1: t) (cacc: t) (rkind : ikind) = + let truncate i = fst(truncateInteger64 rkind i) in + let rec insert (w: int64) (e: exp) = function + [] -> if w = Int64.zero then [] else [ (w, e) ] + | (w', e') :: rest -> + if deputyCompareExp e e' then + let w'' = truncate (Int64.add w w') in + if w'' = Int64.zero then + rest + else + (w'', e') :: rest + else begin + (*log "weightedAdd: %a != %a\n" d_plainexp e d_plainexp e';*) + (w', e') :: insert w e rest + end + in + { ct = truncate(Int64.add (Int64.mul w1 c1.ct) cacc.ct); + cf = List.fold_left (fun acc (w,e) -> insert (truncate (Int64.mul w1 w)) e acc) + cacc.cf c1.cf; + ck = rkind; + } + + let add c1 c2 ik = weightedAdd Int64.one c1 c2 ik + let sub c1 c2 ik = weightedAdd Int64.minus_one c2 c1 ik + let mult c n ik = weightedAdd n c (zero c.ck) ik + + (* do not use *) + let addConst cnst ik c = + let ct,cnst,rkind = convertInts c.ct c.ck cnst ik in + { c with ct = fst(truncateInteger64 rkind (Int64.add cnst c.ct))} + + let d_t () c = + if c.cf = [] then + num64 c.ct + else begin + dprintf "%a%a" + insert + (if c.ct = Int64.zero then nil else (d_int64 c.ct)) + (docList ~sep:nil + (fun (w, e) -> + dprintf "%a%a" + insert + (if w = Int64.one then chr '+' + else if w = Int64.minus_one then chr '-' + else + (if w > Int64.zero then chr '+' else nil) ++ + dprintf "%s*" (Int64.to_string w)) + d_exp e)) + c.cf + end + + type sign = Pos | Neg | Zero | DontKnow + + (* t -> sign *) + let getSign c = + let getTermSign (f, e) = + if f > Int64.zero && not(isSignedType(canTypeOf e)) + then Pos + else DontKnow + in + let cfs = List.map getTermSign c.cf in + try + let s = List.fold_left (fun s s' -> + match s, s' with + | Pos, Pos -> Pos + | Neg, Neg -> Neg + | _, _ -> DontKnow) (List.hd cfs) cfs + in + if s = Pos && c.ct >= Int64.zero then + Pos + else if s = Neg && c.ct <= Int64.zero then + Neg + else + DontKnow + with Failure "hd" -> + if c.ct > Int64.zero then + Pos + else if c.ct < Int64.zero then + Neg + else + Zero + +end + +(** The arithmetic factor for a base type *) +let arithFactor (t: typ) : int64 = + match unrollType t with + | TPtr (bt, _) -> Int64.of_int(bitsSizeOf bt / 8) + | _ -> Int64.one + + + +(* Convert lh[x] to *(lh + x) + * Convert &lh[x] to (lh + x) + *) +let rec canonMemAccess (e : exp) : exp = + let canonLh (lh : lhost) : lhost = + match lh with + | Mem e -> Mem(canonMemAccess e) + | _ -> lh + in + let rec canonOff (off : offset) : offset = + match off with + | Index(e, off) -> Index(canonMemAccess e, canonOff off) + | Field(fi, off) -> Field(fi, canonOff off) + | NoOffset -> NoOffset + in + match e with + | Lval(lh,Index(e,off)) + | StartOf(lh,Index(e,off)) -> + let base = StartOf(lh,NoOffset) in + canonMemAccess (Lval(Mem(BinOp(PlusPI,base,e,canTypeOf base)), off)) + | Lval(lh,off) -> Lval(canonLh lh, canonOff off) + | StartOf(lh,off) -> StartOf(canonLh lh, canonOff off) + (* &A[x] -> (A + x) *) + | AddrOf(lh, off) -> begin + let rec splitOffset off = + match off with + | NoOffset -> NoOffset, NoOffset + | Field(fi, off') -> + let flds, idx = splitOffset off' in + Field(fi, flds), idx + | Index(e, NoOffset) -> + NoOffset, Index(e, NoOffset) + | Index(e, off') -> + let flds, idx = splitOffset off' in + Index(e,flds), idx + in + let (flds, indx) = splitOffset off in + match indx with + | Index(e, NoOffset) -> begin + let base = StartOf(lh, flds) in + canonMemAccess (BinOp(PlusPI, base, e, canTypeOf base)) + end + | _ -> AddrOf(canonLh lh, canonOff off) + end + | UnOp(uop,e,t) -> UnOp(uop,canonMemAccess e,t) + | BinOp(bop,e1,e2,t) -> + BinOp(bop,canonMemAccess e1,canonMemAccess e2,t) + | CastE(t,e) -> CastE(t,canonMemAccess e) + | _ -> e + +let findIkindSz (unsigned : bool) (sz : int) : ikind = + (* Test the most common sizes first *) + if sz = bytesSizeOfInt IInt then + if unsigned then IUInt else IInt + else if sz = bytesSizeOfInt ILong then + if unsigned then IULong else ILong + else if sz = 1 then + if unsigned then IUChar else IChar + else if sz = bytesSizeOfInt IShort then + if unsigned then IUShort else IShort + else if sz = bytesSizeOfInt ILongLong then + if unsigned then IULongLong else ILongLong + else if unsigned then IULong else ILong + +(* I need my own versions of isSignedType and typeOf because I need to use them + after canonMemAccess, wchih breaks some invarients *) + +let rec isSignedType (t:typ) : bool = + match unrollType t with + | TInt(ik,_) -> isSigned ik + | TEnum _ -> true + | TPtr _ -> false + | TArray _ -> false + | _ -> false + + + +(** Convert an expression into a canonical expression *) +let rec canonExp (fact: int64) (e: exp) : Can.t = + match e with + | Const (CInt64 (i, ik, _)) -> Can.mkInt (Int64.mul fact i) ik + | BinOp ((PlusA|PlusPI|IndexPI), e1, e2, t) -> + begin + try + let facte2 : int64 = Int64.mul fact (arithFactor t) in + let ik = findIkindSz (not(isSignedType t)) ((bitsSizeOf t)/8) in + Can.add (canonExp fact e1) (canonExp facte2 e2) ik + with SizeOfError _ -> + (*log "canonExp: isSignedType Plus (%a)" d_type t;*) + let ik = findIkindSz (not(isSignedType t)) ((bitsSizeOf t)/8) in + Can.atomic fact e ik + end + + | BinOp ((MinusA|MinusPI|MinusPP), e1, e2, t) -> + begin + try + let facte2 : int64 = Int64.mul fact (arithFactor t) in + let ik = findIkindSz (not(isSignedType t)) ((bitsSizeOf t)/8) in + Can.add (canonExp fact e1) (canonExp (Int64.neg facte2) e2) ik + with SizeOfError _ -> + (*log "canonExp: isSignedType Minus (%a)" d_type t;*) + let ik = findIkindSz (not(isSignedType t)) ((bitsSizeOf t)/8) in + Can.atomic fact e ik + end + + | BinOp (Div, BinOp(Mult, e1, e2, tm), e3, td) -> + if deputyCompareExp e2 e3 then + canonExp fact e1 + else begin + (*log "canonExp: isSignedType DivMult (%a)" d_type td;*) + let ik = findIkindSz (not(isSignedType td)) ((bitsSizeOf td)/8) in + Can.atomic fact e ik + end + + | CastE _ -> begin + let ep = stripNopCasts e in + if not(Util.equals e ep) then begin + let ce = canonExp fact ep in + (*ignore(E.log "canonExp: stripped casts: %a -> %a\n" + d_plainexp e Can.d_t ce);*) + ce + end else begin + (*log "canonExp: isSignedType CastE (%a)" d_type (canTypeOf ep);*) + let ik = findIkindSz (not(isSignedType(canTypeOf ep))) ((bitsSizeOf(canTypeOf ep))/8) in + let ce = Can.atomic fact ep ik in + (*ignore(E.log "canonExp: cast left: %a\n" + d_plainexp e);*) + ce + end + end + + (* Let's not distinguish between A[x] and *(A + x) *) +(* + | Lval(lh, Index(e, off)) + | StartOf(lh, Index(e, off)) -> begin + let base = StartOf(lh, NoOffset) in + Can.atomic fact (Lval(Mem(BinOp(PlusPI, base, e, typeOf base)), off)) + end +*) + (* &A[x] -> (A + x) *) +(* + | AddrOf(lh, off) -> begin + let rec splitOffset off = + match off with + | NoOffset -> NoOffset, NoOffset + | Field(fi, off') -> + let flds, idx = splitOffset off' in + Field(fi, flds), idx + | Index(e, NoOffset) -> + NoOffset, Index(e, NoOffset) + | Index(e, off') -> + let flds, idx = splitOffset off' in + Index(e,flds), idx + in + let (flds, indx) = splitOffset off in + match indx with + | Index(e, NoOffset) -> begin + let base = StartOf(lh, flds) in + canonExp fact (BinOp(PlusPI, base, e, typeOf base)) + end + | _ -> Can.atomic fact e + end +*) + | _ -> + (*log "canonExp: %a isSignedType _ (%a)" d_exp e d_type (canTypeOf e);*) + Can.atomic fact e (findIkindSz (not(isSignedType(canTypeOf e))) + ((bitsSizeOf(canTypeOf e))/8)) + + +let canonExp (fact: int64) (e: exp) : Can.t = + let e = constFold true e in (* Apply constant folding first *) + let e = canonMemAccess e in (* Canonicalize memory access *) + if false then begin + ignore (log "canonicalizing %a\n" d_exp e); + let res = canonExp fact e in + ignore (log "canonExp(%a) = %a\n" d_exp e Can.d_t res); + res + end else + canonExp fact e + +let canonCompareExp (e1 : exp) (e2 : exp) : bool = + let dce1 = canonExp Int64.one e1 in + let dce2 = canonExp Int64.one e2 in + let diff = Can.sub dce1 dce2 ILong in + diff.Can.ct = Int64.zero && diff.Can.cf = [] + +let canonCompareLval (lv1 : lval) (lv2 : lval) : bool = + let dce1 = canonExp Int64.one (Lval lv1) in + let dce2 = canonExp Int64.one (Lval lv2) in + let diff = Can.sub dce1 dce2 ILong in + diff.Can.ct = Int64.zero && diff.Can.cf = [] diff --git a/src/optimizer/dcheckhoister.ml b/src/optimizer/dcheckhoister.ml new file mode 100644 index 0000000..7de0165 --- /dev/null +++ b/src/optimizer/dcheckhoister.ml @@ -0,0 +1,400 @@ +(* + * Calculate "very busy" checks, and hoist them into + * dominators. + * + * + * + *) + +open Cil +open Pretty +open Dutil +open Dcheckdef +open Doptimutil +open Doptions + +module DF = Dataflow +module IH = Inthash +module UD = Usedef +module AELV = Availexpslv +module E = Errormsg +module DOM = Dominators +module S = Stats +module P = Dptranal + +module DPF = Dprecfinder + +let debug = ref false +let doTiming = ref true + +let time s f x = + if !doTiming then S.time s f x else f x + + +(* + * When ignore_inst returns true, then + * the instruction in question has no + * effects on the abstract state. + * When ignore_call returns true, then + * the instruction only has side-effects + * from the assignment if there is one. + *) +let ignore_inst = ref (fun i -> false) +let ignore_call = ref (fun i -> false) + +let registerIgnoreInst (f : instr -> bool) : unit = + let f' = !ignore_inst in + ignore_inst := (fun i -> (f i) || (f' i)) + +let registerIgnoreCall (f : instr -> bool) : unit = + let f' = !ignore_call in + ignore_call := (fun i -> (f i) || (f' i)) + + +(* do two lists contain the same checks *) +let il_equals il1 il2 = + if not(List.length il1 = List.length il2) + then false + else List.fold_left (fun b i1 -> + b && List.exists (fun i2 -> + deputyCallsEqual i1 i2) + il2) + true il1 + +(* return the intersection of two lists + * of checks *) +let il_combine il1 il2 = + List.filter (fun i1 -> + List.exists (fun i2 -> + deputyCallsEqual i1 i2) il2) il1 + +(* add new checks from chks to cl *) +(* instr list -> instr list -> instr list *) +let il_add il newil = + List.fold_left (fun il' i -> + if not(List.exists (fun i' -> + deputyCallsEqual i i') il') + then begin + if !debug then ignore(E.log "VBC: adding %a\n" d_instr i); + i::il' + end else il') + il newil + +let il_pretty () il = + line ++ seq line (fun i -> + (d_instr () i)) il + +(* see if f returns true on an + * expression in the list *) +let expListTest f el = + List.fold_left (fun b e -> + b || (f e)) + false el + +(* if f is true on an instruction + * then filter it out of the list *) +let ilKiller f il = + List.filter (fun i -> + match instrToCheck i with + Some c -> begin + if not(test_check f c) then true else begin + if !debug then + ignore(E.log "VBCFlow: killing %a\n" d_instr i); + false + end + end + | None -> match i with + Call(_,_,el,_) -> + not(expListTest f el) + | _ -> true) + il + +(* filter out checks having memory reads *) +let il_kill_mem il eo = + if !debug then ignore(E.log "VBCFlow: Killing memory reads\n"); + if !doPtrAnalysis then + match eo with + | Some ee -> + ilKiller (P.exp_has_alias_read ee) il + | None -> + ilKiller AELV.exp_has_mem_read il + else + ilKiller AELV.exp_has_mem_read il + +(* filter out checks refering to vi *) +let il_kill_vi il vi = + ilKiller (AELV.exp_has_vi vi) il + +(* filter out checks refering to lv *) +let il_kill_lval il lv = + ilKiller (AELV.exp_has_lval lv) il + +let int_list_union l1 l2 = + List.fold_left (fun l x -> + if List.mem x l then l else x :: l) l1 l2 + +let vi_list_union l1 l2 = + List.fold_left (fun l x -> + if List.exists (fun vi -> vi.vid = x.vid) l then l else x :: l) + l1 l2 + +let handleCall (*(fdato : DPF.functionData option) + (fe : exp) + (args : exp list) + (il : instr list) : + instr list*) + = P.handleCall il_kill_mem +(* + match fdato with + | None -> il_kill_mem il None + | Some fdat -> begin + (* find what fe can point to *) + let fns : varinfo list = + if !doPtrAnalysis then + match try_resolve_funptr fe with + | None -> begin + match fe with + | Lval(Var vf, NoOffset) -> [vf] + | _ -> [] + end + | Some [] -> begin + match fe with + | Lval(Var vf, NoOffset) -> [vf] + | _ -> [] + end + | Some fds -> List.map (fun fd -> fd.svar) fds + else match fe with + | Lval(Var vf, NoOffset) -> [vf] + | _ -> [] + in + (* if the function couldn't be identified then kill everything *) + if fns = [] then il_kill_mem il None else + (* glob vis and arg nums that fns might modify, an option in case + nothing is known *) + let modsopt : (varinfo list * int list) option = + List.fold_left + (fun modsopt fvi -> + match modsopt with None -> None + | Some(gmds, amds) -> begin + match IH.tryfind fdat.DPF.fdModHash fvi.vid with + | None -> None + | Some(ngmds, namds) -> + Some(vi_list_union ngmds gmds, + int_list_union namds amds) + end) + (Some([],[])) + fns + in + match modsopt with + | None -> il_kill_mem il None + | Some(gmds, amds) -> begin + (* kill lvals refering to globals in gmds *) + let il = List.fold_left (fun a gvi -> + il_kill_mem il (Some(AddrOf(Var gvi, NoOffset)))) + il gmds + in + (* kill lvals that have reads of things aliasing things in amds *) + List.fold_left (fun a anum -> + il_kill_mem il (Some(List.nth args anum))) + il amds + end + end +*) + +(* fdato is set in hoistChecks. + Easier for it to be a global b/c of dataflow functor *) +let fdato : DPF.functionData option ref = ref None +let il_handle_inst i il = + if is_check_instr i then il else + match i with + Set((Mem ee, _),_,_) -> + il_kill_mem il (Some ee) + | Set((Var vi, _),e,_) -> + il_kill_vi il vi + | Call(Some(Var vi, NoOffset),f,args,_) -> + let il' = il_kill_vi il vi in + if is_deputy_instr i || (!ignore_call) i + then il' + else handleCall (!fdato) f args il' + | Call(Some(Mem ee, _) ,f,args,_) -> + let il' = il_kill_mem il (Some ee) in + if (!ignore_call) i then il' else + handleCall (!fdato) f args il' + | Call(_,f,args,_) -> + if (!ignore_call) i then il else + handleCall (!fdato) f args il + | Asm(_,_,_,_,_,_) -> + let _, d = UD.computeUseDefInstr i in + UD.VS.fold (fun vi il' -> + il_kill_vi il' vi) d il + +module VBCheckFlow = struct + + let name = "Very Busy Checks" + + let debug = debug + + type t = instr list + + let stmtStartData = IH.create 64 + + let funcExitData = [] + + let pretty = il_pretty + + let combineStmtStartData (stm:stmt) ~(old:t) (now:t) = + if il_equals old now then None else + Some(il_add old now) + + let combineSuccessors = il_combine + + let doStmt s = + if !debug then + ignore(E.log "VBCFlow: looking at %a\n" d_stmt s); + DF.Default + + let doInstr i il = + if !debug then ignore(E.log "VBCFlow: handling %a\n" d_instr i); + let transform il' = + match instrToCheck i with + | Some _ -> il_add il [i] + | None -> + if is_check_instr i + then il_add il [i] + else il_handle_inst i il + in + DF.Post transform + + let filterStmt stm1 stm2 = true + +end + +module VBC = DF.BackwardsDataFlow(VBCheckFlow) + +let all_stmts = ref [] +class stmtInitializeClass = object(self) + inherit nopCilVisitor + + method vstmt s = + all_stmts := s :: (!all_stmts); + IH.add VBCheckFlow.stmtStartData s.sid []; + DoChildren + +end + +let getStmtList fd = + ignore(visitCilFunction (new stmtInitializeClass) fd); + !all_stmts + +let computeVBC fd = + IH.clear VBCheckFlow.stmtStartData; + all_stmts := []; + let sl = getStmtList fd in + try + VBC.compute sl + with E.Error -> begin + ignore(E.log "VBC failed on function:\n%s\n" fd.svar.vname); + E.s "Bug in VBC" + end + +let getVBList sid = + try Some(IH.find VBCheckFlow.stmtStartData sid) + with Not_found -> None + +(* when i is a deputy call, returns true if + * i is in statement s *) +let inIL s i = + match s.skind with + | Instr il -> + (List.exists (deputyCallsEqual i) il) + | _ -> false + + +let hoister (m: instr list IH.t) (t: DOM.tree) (s: stmt) : unit = + let childHasCheck s i = + match IH.tryfind m s.sid with + | None -> inIL s i + | Some il -> + (List.exists (deputyCallsEqual i) il) || + (inIL s i) + in + let addCheck s i = + match IH.tryfind m s.sid with + | None -> IH.add m s.sid [i] + | Some il -> + (*if not(List.exists (deputyCallsEqual i) il) then*) + IH.replace m s.sid (i::il) + in + let removeCheck s i = + match IH.tryfind m s.sid with + | None -> () + | Some il -> + let newil = List.filter + (fun i' -> not(deputyCallsEqual i i')) il + in + IH.replace m s.sid newil + in + match getVBList s.sid with + | None -> () + | Some il -> begin + let children = DOM.children t s in + List.iter (fun i -> + List.iter (fun c -> + if childHasCheck c i + then begin + removeCheck c i; + addCheck s i + end) + children) + il + end + +class checkAdderClass m = object(self) + inherit nopCilVisitor + + method vblock b = + let rec processStmtLst sl seen = + match sl with + | [] -> List.rev seen + | s :: rst -> begin + match IH.tryfind m s.sid with + | None -> processStmtLst rst (s::seen) + | Some il -> begin + let s' = mkStmt(Instr il) in + processStmtLst rst (s::s'::seen) + end + end + in + b.bstmts <- processStmtLst b.bstmts []; + DoChildren + + method vstmt s = + match s.skind with + | Switch(e, b, _, _) -> SkipChildren + | _ -> DoChildren + +end + + +class stmtFinderClass slr = object(self) + inherit nopCilVisitor + method vstmt s = + slr := s :: (!slr); + DoChildren +end + +let stmtFinder fd = + let slr = ref [] in + ignore(visitCilFunction (new stmtFinderClass slr) fd); + !slr + +let hoistChecks (fd : fundec) (fdat : DPF.functionData) : unit = + if !debug then ignore(E.log "VBC: hoistChecks\n"); + fdato := (Some fdat); + time "vbc" computeVBC fd; + fd.sallstmts <- time "find-stmts" stmtFinder fd; + let idoms, tree = time "compute-idom" (DOM.computeDomTree ~doCFG:false) fd in + let m = IH.create 100 in + time "hoister" (DOM.domTreeIter (hoister m tree) DOM.PostOrder) tree; + ignore(time "adderClass" (visitCilFunction (new checkAdderClass m)) fd) + diff --git a/src/optimizer/dcheckstrengthen.ml b/src/optimizer/dcheckstrengthen.ml new file mode 100644 index 0000000..72d1dda --- /dev/null +++ b/src/optimizer/dcheckstrengthen.ml @@ -0,0 +1,171 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * + * dcheckstrengthen.ml + * + * This module looks at groups of checks and replaces them + * with a smaller number of equivalent checks. + * + *) + +open Cil +open Expcompare +open Pretty +open Dutil +open Dcheckdef +open Doptimutil + +module E = Errormsg +module DCE = Dcanonexp + +(****************** + * + * Replace: + * CPtrArith(e1,e2,e3,e4,s); + * CLeq(e3+e4+1,e2); + * + * With: + * CPtrArithAccess(e1,e2,e3,e4,s); + * + * Replace: + * CNullOrLeq(e1,e2,e3) + * CNonNull(e1) + * + * With: + * CLeq(e2,e3) + * CNonNull(e1) + * + ******************) +class checkStrengthenClass = object(self) + inherit nopCilVisitor + + method private increaseStrength c1 c2 = + match c1, c2 with + | CPtrArith(e1,e2,e3,e4,e5), CLeq(e6,e7,_) -> begin + match deputyStripCastsForPtrArith e6 with + | BinOp((PlusA|PlusPI|IndexPI), + BinOp((PlusA|PlusPI|IndexPI),e3',e4',_),ce,t) -> + if (DCE.canonCompareExp e3 e3' && + DCE.canonCompareExp e4 e4' && + DCE.canonCompareExp e2 e7 || + DCE.canonCompareExp e4 e3' && + DCE.canonCompareExp e3 e4' && + DCE.canonCompareExp e2 e7) && + DCE.canonCompareExp ce one + then + [CPtrArithAccess(e1,e2,e3,e4,e5)] + else + [c1;c2] + | _ -> [c1;c2] + end + | CNullOrLeq(e1,e2,e3,r), CNonNull e4 -> + if DCE.canonCompareExp e1 e4 then + [c2;CLeq(e2,e3,r)] + else [c1;c2] + | _, _-> [c1;c2] + + method private processInstrs il = + let rec helper il seen = match il with + | [] -> List.rev seen + | [x] -> List.rev (x::seen) + | i1::i2::rest -> begin + match instrToCheck i1, instrToCheck i2 with + | Some c1, Some c2 -> begin + (* Set location so that it is properly recorded by checkToInstr. *) + currentLoc := get_instrLoc i1; + let cl = self#increaseStrength c1 c2 in + if cl = [] then helper rest seen else + let cl = List.map checkToInstr cl in + let c1 = List.hd cl in + helper ((List.tl cl)@rest) (c1::seen) + end + | _, _ -> helper (i2::rest) (i1::seen) + end + in + helper il [] + + method private procStmt s = + match s.skind with + | Instr il -> begin + s.skind <- Instr(self#processInstrs il); + s + end + | _ -> s + + method private processStmts sl = + let rec helper sl seen = match sl with + | [] -> List.rev seen + | [x] -> List.rev ((self#procStmt x)::seen) + | s1::s2::rest -> begin + match s1.skind, s2.skind with + | Instr il1, Instr il2 when s1.labels = [] && s2.labels = [] -> begin + s1.skind <- Instr(il1 @ il2); + helper (s1 :: rest) seen + end + | Instr il1, Instr il2 when il1 <> [] && il2 <> [] -> begin + (* get the last form il1 and the first from il2 *) + let i1 = List.hd (List.rev il1) in + let il1' = List.tl (List.rev il1) in + let i2 = List.hd il2 in + let il2' = List.tl il2 in + match self#processInstrs [i1;i2] with + | [] -> E.s "CheckStrengthen: processInstrs returned empty\n" + | [i] -> begin + s1.skind <- Instr(List.rev(i::il1')); + s2.skind <- Instr il2'; + helper (s2::rest) ((self#procStmt s1)::seen) + end + | [i1;i2] -> begin + s1.skind <- Instr(List.rev(i1::il1')); + s2.skind <- Instr(i2::il2'); + helper (s2::rest) ((self#procStmt s1)::seen) + end + | _ -> E.s "CheckStrengthen: processInstrs returned more than one\n" + end + | _, _ -> helper (s2::rest) ((self#procStmt s1)::seen) + end + in + helper sl [] + + method vblock b = + b.bstmts <- self#processStmts b.bstmts; + DoChildren + +end + +let checkStrengthener = new checkStrengthenClass diff --git a/src/optimizer/ddupcelim.ml b/src/optimizer/ddupcelim.ml new file mode 100644 index 0000000..0218149 --- /dev/null +++ b/src/optimizer/ddupcelim.ml @@ -0,0 +1,337 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * + * ddupcelim.ml + * + * A flow sensitive analysis that removes duplicate checks. + * + * XXX: This pass might be obviated by other passes. + * + *) + +open Cil +open Pretty +open Dutil +open Dcheckdef +open Doptimutil +open Doptions + +module E = Errormsg +module IH = Inthash +module UD = Usedef +module AELV = Availexpslv +module DF = Dataflow +module S = Stats + +module P = Dptranal +module DPF = Dprecfinder + +(* For turning on debugging in just this file *) +(*let debug = ref true*) + +(********************************** + * Flow-sensitive optimizer for + * removing duplicate checks across + * multiple statements + **********************************) + +(* do two lists contain the same checks *) +let il_equals il1 il2 = + if not(List.length il1 = List.length il2) + then false + else List.fold_left (fun b i1 -> + b && List.exists (fun i2 -> + deputyCallsEqual i1 i2) + il2) + true il1 + +(* return the intersection of two lists + * of checks *) +let il_combine il1 il2 = + List.filter (fun i1 -> + List.exists (fun i2 -> + deputyCallsEqual i1 i2) il2) il1 + +(* add new checks from chks to cl *) +(* instr list -> instr list -> instr list *) +let il_add il newil = + List.fold_left (fun il' i -> + if not(List.exists (fun i' -> + deputyCallsEqual i i') il') + then i::il' else il') + il newil + +let il_pretty () il = + line ++ seq line (fun i -> + (d_instr () i)) il + +(* see if f returns true on an + * expression in the list *) +let expListTest f el = + List.fold_left (fun b e -> + b || (f e)) + false el + +(* if f is true on an instruction + * then filter it out of the list *) +let ilKiller f il = + List.filter (fun i -> + match instrToCheck i with + Some c -> + not(test_check f c) + | None -> match i with + Call(_,_,el,_) -> + not(expListTest f el) + | _ -> true) + il + +(* filter out checks having memory reads *) +let il_kill_mem il eo = + if !debug then ignore(E.log "VBCFlow: Killing memory reads\n"); + if !doPtrAnalysis then + match eo with + | Some ee -> + ilKiller (P.exp_has_alias_read ee) il + | None -> + ilKiller AELV.exp_has_mem_read il + else + ilKiller AELV.exp_has_mem_read il + +(* filter out checks refering to vi *) +let il_kill_vi il vi = + ilKiller (AELV.exp_has_vi vi) il + +(* filter out checks refering to lv *) +let il_kill_lval il lv = + ilKiller (AELV.exp_has_lval lv) il + +let il_handle_inst i il = + if is_check_instr i then il else + match i with + Set((Mem ee, _),_,_) -> + il_kill_mem il (Some ee) + | Set((Var vi, NoOffset),e,_) -> + (match e with + Lval(Var vi', NoOffset) -> + if vi'.vid = vi.vid then il else + il_kill_vi il vi + | _ -> il_kill_vi il vi) + | Set(lv,_,_) -> il_kill_lval il lv + | Call(Some(Var vi, NoOffset),_,_,_) -> + let il' = il_kill_vi il vi in + if is_deputy_instr i then il' else + il_kill_mem il' None + | Call(_,_,_,_) -> + il_kill_mem il None + | Asm(_,_,_,_,_,_) -> + let _, d = UD.computeUseDefInstr i in + UD.VS.fold (fun vi il' -> + il_kill_vi il' vi) d il + +module AvailChecks = + struct + + let name = "Available Checks" + + let debug = debug + + (* list of checks that are available *) + type t = instr list + + let copy il = il + + let stmtStartData = IH.create 64 + + let pretty = il_pretty + + let computeFirstPredecessor stm il = il + + let combinePredecessors (stm:stmt) ~(old:t) (il:t) = + if il_equals old il then None else + Some(il_combine old il) + + let doInstr i il = + let action il = + match instrToCheck i with + | Some _ -> il_add il [i] + | None -> + if is_deputy_instr i + then il_add il [i] + else il_handle_inst i il + in + DF.Post action + + let doStmt stm il = + (*if !debug then ignore(E.log "AvailChecks: looking at stmt %d %a\n" + stm.sid d_stmt stm);*) + DF.SDefault + + let doGuard c il = DF.GDefault + + let filterStmt stm = true + + end + +module AC = DF.ForwardsDataFlow(AvailChecks) + +let computeACs fd (fdat : DPF.functionData) = + try let slst = fd.sbody.bstmts in + let first_stm = List.hd slst in + let precs = + match IH.tryfind fdat.DPF.fdPCHash fd.svar.vid with + | None -> [] + | Some cl -> begin + if !debug then + ignore(E.log "computeACs: precs for %s: %a\n" fd.svar.vname + d_stmt (mkStmt (Instr cl))); + cl + end + in + IH.clear AvailChecks.stmtStartData; + IH.add AvailChecks.stmtStartData first_stm.sid precs; + AC.compute [first_stm] + with Failure "hd" -> () + | Not_found -> () + +let getACs sid = + try Some(IH.find AvailChecks.stmtStartData sid) + with Not_found -> None + +(* Visitor that eliminates a check at a statement where it is available *) +class dupCheckElimClass = object(self) + inherit nopCilVisitor + + method private filter_dups ail il = + (* make in instr that sets the lhs of i + * to the lhs of ai *) + let makeSet i ai = + match i, ai with + Call(Some lv1,_,_,l),Call(Some lv2,_,_,_) -> + Set(lv1,Lval lv2, l) + | _ -> E.s "dupCheckElim: bad deputy instrs in list\n" + in + let rec filter_dups' ail il ril = + match il with [] -> List.rev ril + | i::rest -> match instrToCheck i with + | Some _ -> + if List.exists (deputyCallsEqual i) ail + then (if !debug then ignore(E.log "dupCheckElim: Removing: %a\n" + d_instr i); + filter_dups' ail rest ril) + else let ail' = il_add ail [i] in + (if !debug then ignore(E.log "dupCheckElim: Not Removing: %a\n" + d_instr i); + filter_dups' ail' rest (i::ril)) + | None -> + if is_deputy_instr i then + if List.exists (deputyCallsEqual i) ail + then let ai = List.find (deputyCallsEqual i) ail in + let newi = makeSet i ai in + (if !debug then ignore(E.log "dupCheckElim: Removing: %a\n" + d_instr i); + filter_dups' ail rest (newi::ril)) + else let ail' = il_add ail [i] in + (if !debug then ignore(E.log "dupCheckElim: Not Removing: %a\n" + d_instr i); + filter_dups' ail' rest (i::ril)) + else let ail' = il_handle_inst i ail in + filter_dups' ail' rest (i::ril) + in + filter_dups' ail il [] + + method vstmt s = + match getACs s.sid with + | None -> SkipChildren + | Some acs -> + match s.skind with + Instr il -> begin + (*if !debug then ignore(E.log "Filtering dups from stmt %d with data %a\n" + s.sid il_pretty acs);*) + let il' = self#filter_dups acs il in + s.skind <- Instr il'; + SkipChildren + end + | _ -> DoChildren + +end + +let dupCheckElimer = new dupCheckElimClass + +let elim_dup_checks fd (fdat : DPF.functionData) = + computeACs fd fdat; + ignore(visitCilFunction dupCheckElimer fd) + + +(* See what checks are available at every return *) +class postConditionFinderClass postcsr = object(self) + inherit nopCilVisitor + + method vstmt s = + match s.skind with + | Return(_,_) -> begin + match getACs s.sid with + | None -> DoChildren + | Some acs -> begin + postcsr := il_combine acs (!postcsr); + DoChildren + end + end + | _ -> DoChildren + +end + +class allChecksBuilderClass clr = object(self) + inherit nopCilVisitor + + method vinst i = + match instrToCheck i with + | None -> DoChildren + | Some c -> begin + if not(List.exists (deputyCallsEqual i) (!clr)) then + clr := i :: (!clr); + DoChildren + end +end + +(* fundec -> instr list *) +let findFnPostConditions (fd : fundec) (fdat : DPF.functionData) = + let clr = ref [] in + computeACs fd fdat; + ignore(visitCilFunction (new allChecksBuilderClass clr) fd); + ignore(visitCilFunction (new postConditionFinderClass clr) fd); + !clr diff --git a/src/optimizer/dfailfinder.ml b/src/optimizer/dfailfinder.ml new file mode 100644 index 0000000..fc8304a --- /dev/null +++ b/src/optimizer/dfailfinder.ml @@ -0,0 +1,146 @@ +(* + * dfailfinder.ml + * + * This module tries to find feasible models of parameters and globals + * under which Deputy checks will fail. + * + * The entry point is: + * + * failcheck: Cil.exp list -> DCE.Can.t -> (Cil.exp * int) list + * + * When given a list of constraints and a canon exp, it will try to find a model + * of the constraints under which the canon exp is < 0. + *) + +open Cil +open Pretty +open Dattrs +open Dutil +open Dcheckdef +open Doptimutil + +module IH = Inthash +module E = Errormsg +module S = Stats +module SI = SolverInterface +module DSF = Dsolverfront +module DCE = Dcanonexp +module AELV = Availexpslv (* for AELV.exp_has_lval *) + +let debug = ref true + +(* If there isn't some fact about each lval in the ce, + * then return false o/w true *) +let checkFacts (cl : exp list) + (ce : DCE.Can.t) + : bool * exp list + = + (* filter facts in cl that don't mention lvals in ce *) + let fcl = + List.filter (fun c -> + List.exists (fun (_, (e : exp)) -> + match e with + | Lval lv | StartOf lv -> AELV.exp_has_lval lv c + | _ -> false) + ce.DCE.Can.cf) + cl + in + let b = + not(List.exists (fun (_, (e : exp)) -> + match e with + | Lval lv + | StartOf lv -> not(List.exists (AELV.exp_has_lval lv) fcl) + | _ -> true) ce.DCE.Can.cf) + in + (b, fcl) + +class lvalCollectorClass (lvalHash : (string, lval) Hashtbl.t) = object(self) + inherit nopCilVisitor + method vlval (lv : lval) = + Hashtbl.add lvalHash (sprint 80 (d_lval () lv)) lv; + DoChildren +end + +(* create a mapping from the string of an lval to the lval *) +let makeLvalHash (cl : exp list) + : (string, lval) Hashtbl.t + = + let lvalHash = Hashtbl.create 100 in + List.iter (fun e -> + ignore(visitCilExpr (new lvalCollectorClass lvalHash) e)) + cl; + lvalHash + + +let failCheck (cl : exp list) (ce : DCE.Can.t) : (exp * int) list = + try + (* will raise SI.NYI if there is no solver *) + if !debug then ignore(E.log "failCheck: getting translator\n"); + let translator = SI.getTranslator 0 in + + (* see if there are a quarum of facts + * TODO: remove facts that can't be translated *) + if !debug then ignore(E.log "failCheck: checking facts\n"); + let enoughFacts, factList = checkFacts cl ce in + if not enoughFacts then [] else begin + + (* translate the canon exp *) + if !debug then ignore(E.log "failCheck: translating check exp\n"); + let (tce,_) = DSF.transCan translator ce in + (* ce >= 0 *) + if !debug then ignore(E.log "failCheck: build 0 <= ce\n"); + let tce = translator.DSF.mkLe (translator.DSF.mkConst 0) tce in + + (* translate the constraints *) + if !debug then ignore(E.log "failCheck: translate constraints\n"); + let tcl = List.map (DSF.transCilExp translator) factList in + + (* make a conjuction of the constraints *) + (* + ignore(E.log "failCheck: build conjunction of constraints\n"); + let conj = List.fold_left (fun conj te -> + translator.DSF.mkAnd te conj) (translator.DSF.mkTrue()) tcl + in + *) + + (* make conj => tce *) + (* + ignore(E.log "failCheck: build implication\n"); + let impl = translator.DSF.mkImp conj tce in + *) + + (* if it's invalid, then ask for a counterexample, if it's + valid, then return [(Cil.one, 1)] *) + if !debug then ignore(E.log "failCheck: check validity\n"); + let valid, counterEx = translator.DSF.isValidWithAssumptions tcl tce in + if valid then [(one, 1)] else begin + + (* a list of translated equalities *) + if !debug then ignore(E.log "failCheck: make lvhash\n"); + let lvalHash = makeLvalHash cl in + + (* convert strings to Cil expressions and return the list *) + if !debug then ignore(E.log "failCheck: replace strings with lvals\n"); + let res = List.map (fun (str, i) -> + try + (Lval(Hashtbl.find lvalHash str), i) + with Not_found -> (integer 0, i)) counterEx + in + if !debug then ignore(E.log "failCheck: done! returning...\n"); + res + end + end + with + | SI.NYI _ -> begin + if !debug then ignore(E.log "Translation failed\n"); + [] + end + | DSF.NYI -> begin + if !debug then ignore(E.log "Translation failed\n"); + [] + end + | ex -> begin + ignore(E.log "failCheck: %s was raised during failCheck\n" + (Printexc.to_string ex)); + raise ex + end diff --git a/src/optimizer/dfdatbrowser.ml b/src/optimizer/dfdatbrowser.ml new file mode 100644 index 0000000..322a5bb --- /dev/null +++ b/src/optimizer/dfdatbrowser.ml @@ -0,0 +1,254 @@ +(* + * dfdatbrowser.ml + * + * This module generates an html file for a source file. + * The html file has links to an html file for each function mentioned in + * the functionData structure that is also defined in the source file. + * + *) + + +open Cil +open Pretty +open Doptions +open Dattrs +open Dcheckdef + +module E = Errormsg +module IH = Inthash + +module DPF = Dprecfinder +module DCE = Dcanonexp + +module X = XHTML.M + + +let tmToStr (t : Unix.tm) : string = + (string_of_int (t.Unix.tm_hour))^":"^ + (string_of_int (t.Unix.tm_min))^" GMT "^ + (string_of_int (t.Unix.tm_mon+1))^"/"^ + (string_of_int (t.Unix.tm_mday))^"/"^ + (string_of_int (t.Unix.tm_year + 1900)) + +let href url elts = + X.a ~a:[X.a_href url] elts + + +let rec gcd a b = if b = Int64.zero then a else gcd b (Int64.rem a b) + +let ceGCD (ce : DCE.Can.t) : int64 = + List.fold_left (fun g (f, _) -> + if f = Int64.zero then g else + if g = Int64.zero then (Int64.abs f) + else gcd g (Int64.abs f)) Int64.zero ce.DCE.Can.cf + +let divByGCD (ce : DCE.Can.t) : DCE.Can.t = + let g = ceGCD ce in + let newcf = List.map (fun (f, e) -> (Int64.div f g, e)) ce.DCE.Can.cf in + {DCE.Can.ct = Int64.div ce.DCE.Can.ct g; + DCE.Can.cf = newcf; + DCE.Can.ck = ce.DCE.Can.ck} + +let partConExp (ce : DCE.Can.t) : DCE.Can.t * DCE.Can.t = + let ce = divByGCD ce in + let pos, neg = List.partition (fun (c, _) -> c > Int64.zero) ce.DCE.Can.cf in + let neg = List.map (fun (c, e) -> (Int64.neg c, e)) neg in + if ce.DCE.Can.ct > Int64.zero then + {DCE.Can.ct = ce.DCE.Can.ct; DCE.Can.cf = pos;DCE.Can.ck=ce.DCE.Can.ck}, + {DCE.Can.ct = Int64.zero; DCE.Can.cf = neg;DCE.Can.ck=ce.DCE.Can.ck} + else if ce.DCE.Can.ct < Int64.zero then + {DCE.Can.ct = Int64.zero; DCE.Can.cf = pos;DCE.Can.ck=ce.DCE.Can.ck}, + {DCE.Can.ct = Int64.neg ce.DCE.Can.ct; DCE.Can.cf = neg;DCE.Can.ck=ce.DCE.Can.ck} + else + {DCE.Can.ct = Int64.zero; DCE.Can.cf = pos;DCE.Can.ck=ce.DCE.Can.ck}, + {DCE.Can.ct = Int64.zero; DCE.Can.cf = neg;DCE.Can.ck=ce.DCE.Can.ck} + +let printConLeq (e1 : exp) (e2 : exp) : doc = + let ce1 = DCE.canonExp Int64.one e1 in + let ce2 = DCE.canonExp Int64.one e2 in + let cdiff = DCE.Can.sub ce2 ce1 ILong in + let greater, lesser = partConExp cdiff in + (DCE.Can.d_t () lesser) ++ text " <= " ++ + (DCE.Can.d_t () greater) + +let d_checkinstr () (i : instr) : doc = + match instrToCheck i with + | None -> nil + | Some c -> begin + match c with + | CNonNull e -> + dprintf "%a != NULL" dc_exp e + | CEq(e1, e2, _, _) -> + dprintf "%a == %a" dc_exp e1 dc_exp e2 + | CMult(e1,e2) -> + dprintf "%a %% %a == 0" dc_exp e2 dc_exp e1 + | CPtrArithAccess(lo,hi,p,e,_) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + let e'' = BinOp(PlusPI,p,BinOp(PlusA,e,one,typeOf e),typeOf p) in + (printConLeq lo e') ++ text " /\\ " ++ + (printConLeq e'' hi) + | CPtrArith(lo,hi,p,e,_) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + (printConLeq lo e') ++ text " /\\ " ++ + (printConLeq e' hi) + | CPtrArithNT(lo,hi,p,e,_) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + (printConLeq lo e') ++ text " /\\ " ++ + (dprintf "%a <= %a + len(%a)" + dc_exp e' dc_exp hi dc_exp hi) + | CLeqInt(e1,e2,_) -> + printConLeq e1 e2 + | CLeq(e1, e2, _) -> + printConLeq e1 e2 + | CLeqNT(e1,e2,_,_) -> + dprintf "%a <= %a + len(%a)" dc_exp e1 dc_exp e2 dc_exp e2 + | CNullOrLeq(e1,e2,e3,_) -> + (dprintf "%a == NULL \\/ " dc_exp e1) ++ + (printConLeq e2 e3) + | CNullOrLeqNT(e1,e2,e3,_,_) -> + (dprintf "%a == NULL \\/ %a <= %a + len(%a)" + dc_exp e1 dc_exp e2 dc_exp e3 dc_exp e3) + | CWriteNT(p,hi,what,sz) -> + (dprintf "%a != %a \\/ *(%a) != 0 \\/ %a == 0" + dc_exp p dc_exp hi dc_exp p dc_exp what) + | CNullUnionOrSelected(lv, sfs) -> + (dprintf "%a || iszero(%a)" dc_exp sfs dx_lval lv) + | CSelected e -> + (dprintf "%a" dc_exp e) + | CNotSelected e -> + (dprintf "! %a" dc_exp e) + end + + +(* TODO : 1. clean up and canonicalize the checks. + 2. refer to globals as filename:varname. *) +let genPrecsForHtml (il : instr list) = + List.fold_left + (fun el i -> + (*let d = sprint ~width:80 (d_instr () i) in*) + let p = sprint ~width:80 (d_checkinstr () i) in + (*(X.p [X.pcdata d]) ::*) + (X.p [X.pcdata p]) :: el) + [] + il + +let declToHtml (vi : varinfo) = + let p = sprint ~width:80 (d_global () (GVarDecl(vi, locUnknown))) in + (X.p [X.pcdata p]) + +(* Take the fundec, the list of preconditions and a base name, and write + the prototype and preconditions to an html file with base name name *) +let genPageForFunction (fd : fundec) (il : instr list) (name : string) : unit = + let precs = genPrecsForHtml il in + if precs = [] then () else + let time = Unix.gmtime (Unix.time()) in + let locstr = sprint ~width:80 (d_loc () fd.svar.vdecl) in + let titlestr = locstr^" - "^fd.svar.vname in + let html = X.html (*~a:[X.a_xmlns X.W3_org_1999_xhtml; X.a_xml_lang "en"]*) + (X.head + (X.title (X.pcdata titlestr)) + [X.style ~contenttype:"text/css" [X.pcdata "H1 {color: back}"]]) + (X.body + ([X.h1 [X.pcdata titlestr]; + X.hr()] @ + [X.h2 [X.pcdata "Function Prototype"]; + declToHtml fd.svar; + X.h2 [X.pcdata "Preconditions"]] @ + precs @ + [X.hr(); + X.p [X.pcdata ("Last update - "^(tmToStr time))]])) + in try + let outf = open_out (!htmlOutDir^"/"^name^".html") in + X.pretty_print ~width:80 (output_string outf) html; + close_out outf + with Sys_error msg -> begin + ignore(E.log "Dfdatbrowser: error writing file: %s" msg) + end + + +(* Take in a file and the function data and generate the files + for functions, and a list of links to those files *) +let genLinksForFile (f : file) (fdat : DPF.functionData) = + (* For each function defined in the file: + 1. If it's mentioned in fdat, write to file.html. + 2. Call genPageForFunction on the function. *) + foldGlobals f + (fun l g -> match g with + | GFun(fd, loc) -> begin + match IH.tryfind fdat.DPF.fdPCHash fd.svar.vid with + | (Some il) when il <> [] -> begin + let name = fd.svar.vname in + genPageForFunction fd il name; + (X.p [href (name^".html") [X.pcdata name]]) :: + l + end + | _ -> l + end + | _ -> l) [] + +let genSourceFileLinks () = + try + let dirhand = Unix.opendir (!htmlOutDir) in + let rec loop acc = + try + let fname = Unix.readdir dirhand in + if Filename.check_suffix fname "i.html" then + loop ((X.p [href fname [X.pcdata fname]]) :: acc) + else loop acc + with End_of_file -> acc + in + loop [] + with Sys_error msg -> begin + ignore(E.log "Dfdatbrowser: error writing index: %s" msg); + [] + end + +let rewriteIndex () : unit = + let links = genSourceFileLinks () in + if links = [] then () else + let time = Unix.gmtime (Unix.time()) in + let html = X.html (*~a:[X.a_xmlns X.W3_org_1999_xhtml; X.a_xml_lang "en"]*) + (X.head + (X.title (X.pcdata "File Information")) + [X.style ~contenttype:"text/css" [X.pcdata "H1 {color: back}"]]) + (X.body + ([X.h1 [X.pcdata "File Information"]; + X.hr()] @ + links @ + [X.hr(); + X.p [X.pcdata ("Last update - "^(tmToStr time))]])) + in try + let outf = open_out (!htmlOutDir^"/index.html") in + X.pretty_print ~width:80 (output_string outf) html; + close_out outf + with Sys_error msg -> begin + ignore(E.log "Dfdatbrowser: error writing file: %s" msg) + end + +(* Take in a file and the function data and generate the html file + for it *) +(* TODO: This should be made more robust. I.e. if htmlOutDir doesn't exist, + then create it. Also, if htmlOutDir/index.html doesn't exist, then create it. + If it does exist then concat the link to this file. *) +let genPageForFile (f : file) (fdat : DPF.functionData) = + let links = genLinksForFile f fdat in + if links = [] then () else + let time = Unix.gmtime (Unix.time()) in + let html = X.html (*~a:[X.a_xmlns X.W3_org_1999_xhtml; X.a_xml_lang "en"]*) + (X.head + (X.title (X.pcdata f.fileName)) + [X.style ~contenttype:"text/css" [X.pcdata "H1 {color: back}"]]) + (X.body + ([X.h1 [X.pcdata f.fileName]; + X.hr()] @ + links @ + [X.hr(); + X.p [X.pcdata ("Last update - "^(tmToStr time))]])) + in try + let outf = open_out (!htmlOutDir^"/"^f.fileName^".html") in + X.pretty_print ~width:80 (output_string outf) html; + close_out outf; + rewriteIndex () + with Sys_error msg -> begin + ignore(E.log "Dfdatbrowser: error writing file: %s" msg) + end diff --git a/src/optimizer/dflowinsens.ml b/src/optimizer/dflowinsens.ml new file mode 100644 index 0000000..3374115 --- /dev/null +++ b/src/optimizer/dflowinsens.ml @@ -0,0 +1,384 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * dflowinsens.ml + * + * A flow insensitive pass that looks for + * easy-to-reason-about checks. + * + * + *) + +open Cil +open Expcompare +open Pretty +open Dutil +open Dattrs +open Dcheckdef +open Doptimutil + +module DO = Doptions +module E = Errormsg +module S = Stats +module DCE = Dcanonexp +module Z = Zrapp + +(* Called when a compile-time assertion failure is detected. This + * function should mirror deputy_fail in the runtime library in terms + * of output formatting. *) +let deputyFail (c: check) : unit = + let why = checkWhy c in + let docs = checkText c in + error "Assertion will always fail in %s:\n %a" + why (docList ~sep:(text "\n ") (insert ())) docs + +let deputyFailLe (e1: exp) (e2: exp) (why: string) : unit = + deputyFail (CLeq (e1, e2, why)) + +(** Split an expression e into e',i', such that e=e'+i' (pointer arithmetic) *) +let rec getBaseOffset (e: exp) : exp * int = + match e with + | BinOp ((PlusPI | IndexPI | MinusPI) as op, e', off, t) -> + let intFold e = isInteger (constFold true e) in + begin + match getBaseOffset e', intFold off, op with + | (b, n1), Some n2, (PlusPI | IndexPI) -> + b, n1 + (to_signedint n2) + | (b, n1), Some n2, MinusPI -> + b, n1 - (to_signedint n2) + | _, _, _ -> + e, 0 + end + | CastE (t, e') -> + let strip t = typeRemoveAttributes ["bounds"; "size"; "nullterm"] t in + let b, n = getBaseOffset e' in + if compareTypes (strip (typeOf e')) (strip t) then begin + b, n + end else begin + match sizeOfBaseType (typeOf e'), sizeOfBaseType t with + | Some sz1, Some sz2 when sz1 = sz2 -> b, n + | Some sz1, Some sz2 when sz1 mod sz2 = 0 -> + mkCast b t, n * (sz1 / sz2) + | _ -> e, 0 + end + | AddrOf (base, off) -> begin (* Look for when off ends in Index *) + match removeOffset off with + off', Index(idx, NoOffset) -> begin + match isInteger (constFold true idx) with + Some n -> mkAddrOrStartOf (base, off'), (to_signedint n) + | _ -> e, 0 + end + | _ -> e, 0 + end + + | _ -> + e, 0 + +let proveLeWithBounds (e1: exp) (e2: exp) : bool = + let ctx = allContext () in + let rec getExpBounds (e:exp) : exp option * exp option = + match e with + (* TODO: structs, memory *) + | Lval (Var vi, NoOffset) when isPointerType vi.vtype && + hasAttribute "bounds" (typeAttrs vi.vtype) -> + let ctx = addThisBinding ctx vi.vtype e in + let lo, hi = boundsOfAttrs ctx (typeAttrs vi.vtype) in +(* log " %a has bounds %a and %a.\n" dx_exp e *) +(* dx_exp lo dx_exp hi; *) + Some lo, Some hi + | CastE (t, e') when (bitsSizeOf t) = (bitsSizeOf voidPtrType) -> + getExpBounds e' + | _ -> None, None + in + let lo1, hi1 = getExpBounds e1 in + let lo2, hi2 = getExpBounds e2 in + (* we know e1 <= hi1 and lo2 <= e2 *) + match hi1, lo2 with + Some hi1, Some lo2 -> + (DCE.canonCompareExp hi1 lo2) + || (DCE.canonCompareExp hi1 e2) + || (DCE.canonCompareExp e1 lo2) + | Some hi1, None -> + (DCE.canonCompareExp hi1 e2) + | None, Some lo2 -> + (DCE.canonCompareExp e1 lo2) + | None, None -> + false + +let newProveLe ?(allowGt: bool = false) (e1: exp) (e2: exp) : int option = + let e1c = DCE.canonExp Int64.one e1 in + let e2c = DCE.canonExp Int64.one e2 in + let e1res = DCE.Can.sub e2c e1c ILong in + (*log "le(%a, %a) = %a" d_exp e1 d_exp e2 DCE.Can.d_t e1res;*) + match DCE.Can.getSign e1res with + | DCE.Can.Zero + | DCE.Can.Pos -> begin + (*log "newProveLe : Yes %a" DCE.Can.d_t e1res;*) + Some 1 + end + | DCE.Can.Neg -> begin + (*log "newProveLe : No %a" DCE.Can.d_t e1res;*) + Some (-1) + end + | DCE.Can.DontKnow -> begin + (* special cases. *) + match e1res.DCE.Can.cf with + | [(f, e)] -> begin + (* look for C + f * (e & D) >= 0, with f * D >= -C *) + match e with + | BinOp(BAnd, e1, e2, _) -> begin + match isInteger e2 with + | None -> begin + (*log "newProveLe: mask not const %a" d_plainexp e;*) + None + end + | Some d -> + let c = Int64.neg e1res.DCE.Can.ct in + if Int64.mul f d >= c + then begin + (*log "newProveLe: Yes %a" DCE.Can.d_t e1res;*) + Some (1) + end else begin + (*log "newProveLe: couldn't prove %a" DCE.Can.d_t e1res;*) + None + end + end + | _ -> begin + (*log "newProveLe: not BAnd: %a" d_plainexp e;*) + None + end + end + | _ -> begin + (*log "newProveLe: Too Many: %a" DCE.Can.d_t e1res;*) + None + end + end + + +type rel = Greater | LessEqual | DontKnow +(** Return true if e1 <= e2 (statically). Reports an error if we can prove + * statically e1 > e2, unless allowGt = true *) +let proveLe ?(allowGt: bool = false) (e1: exp) (e2: exp) (why: string) : rel = + match newProveLe e1 e2 with + | Some i when i > 0 -> LessEqual + | Some i -> begin + if not allowGt then + deputyFailLe e1 e2 why; + Greater + end + | None -> begin + let b1, off1 = getBaseOffset (stripNopCasts e1) in + let b2, off2 = getBaseOffset (stripNopCasts e2) in + if false then begin + log " proveLeq: Comparing:\n"; + log " %a = (%a) + %d.\n" dx_exp e1 d_plainexp b1 off1; + log " %a = (%a) + %d.\n" dx_exp e2 d_plainexp b2 off2; + end; + if DCE.canonCompareExp b1 b2 then begin + let doCompare n1 n2 = + if n1 > n2 then begin + if not allowGt then + deputyFailLe e1 e2 why; + Greater + end else begin + LessEqual + end + in + let t1 = typeOf b1 in + let t2 = typeOf b2 in + match sizeOfBaseType t1, sizeOfBaseType t2 with + | Some n1, Some n2 -> doCompare (off1 * n1) (off2 * n2) + | _ when compareTypes t1 t2 -> doCompare off1 off2 + | _ -> DontKnow + end else begin + if (proveLeWithBounds b1 b2 && off1 = 0 && off2 = 0) then + LessEqual + else + DontKnow + end + end + + +(** Optimize an individual check *) +let rec optimizeCheck ?(supErr: bool = false) (c: check) : check list = + if false then + ignore (log "optimizing %a\n" + d_instr (checkToInstr c)); + match c with + | CNullOrLeq (z, _, _, _) when isZero z -> [] + + | CNullOrLeq (e, e1, e2, why) -> begin + (* There are some user defined reallocaters in bc, for example, + * that need this to be okay, so errors need to be suppressed until + * after symbolic evaluation - zra *) + match proveLe ~allowGt:true e1 e2 why with + | LessEqual -> [] + | Greater -> begin + if isNonnullType (typeOf e) then begin + deputyFail c; + [c] + end else + optimizeCheck ~supErr:supErr (CEq (e, zero, why, checkText c)) + end + | DontKnow -> [c] + end + + | CLeq (e1, e2, why) -> begin + match proveLe ~allowGt:supErr e1 e2 why with + | LessEqual -> [] + | _ -> [c] + end + + | CNullOrLeqNT (z, _, _, _, _) when isZero z -> [] + + | CNullOrLeqNT (_, e1, e2, _, why) + | CLeqNT (e1, e2, _, why) -> begin + match proveLe ~allowGt:true e1 e2 why with + | LessEqual -> [] + | _ -> [c] + end + + | CEq (e1, e2, why, _) -> begin + + if DCE.canonCompareExp e1 e2 then [] + else begin + match proveLe ~allowGt:true e1 e2 why, + proveLe ~allowGt:true e2 e1 why with + | LessEqual, LessEqual -> [] + | _, _ -> [c] + end + + end + + | CLeqInt (e1, e2, why) -> begin + match proveLe ~allowGt:supErr e1 e2 why with + | LessEqual -> [] + | _ -> [c] + end + + | CPtrArith (lo, hi, p, e, sz) -> begin + let ep = BinOp(PlusPI,p,e,typeOf p) in + match proveLe ~allowGt:supErr lo ep "lower bound check", + proveLe ~allowGt:supErr ep hi "upper bound check" with + | LessEqual, LessEqual -> [] + | _, _ -> [c] + end + + | CPtrArithNT (lo, hi, p, e, sz) -> begin + let ep = BinOp(PlusPI,p,e,typeOf p) in + match proveLe ~allowGt:supErr lo ep "lower bound check", + proveLe ~allowGt:true ep hi "nullterm upper bound check" with + | LessEqual, LessEqual -> [] + | _ -> [c] + end + + | CPtrArithAccess(lo, hi, p, e, sz) -> begin + let ep = BinOp(PlusPI,p,e,typeOf p) in + let epo = (BinOp(PlusPI,p,BinOp(PlusA,e,one,typeOf e),typeOf p)) in + match proveLe ~allowGt:supErr lo ep "lower bound check", + proveLe ~allowGt:supErr epo hi "upper bound check" with + | LessEqual, LessEqual -> [] + | _, _-> [c] + end + + | CWriteNT (_, _, z, _) when isZero z -> [] + + | CWriteNT (p, hi, what, sz) -> begin + let t = typeOf p in + assert (sz == (baseSize t)); + let p_plus_one = BinOp(PlusPI, p, one, t) in + match proveLe ~allowGt:true p_plus_one hi "nullterm write check" with + | LessEqual -> [] + | _ -> [c] + end + | CSelected e when isZero e -> begin + deputyFail c; + [] + end + | _ -> [c] + +let opt_deputy_instr i = + match i with + | Call(Some(lv), Lval(Var vf,NoOffset), el, l) -> begin + if not(vf.vname = "deputy_max") then [i] else + match el with + | [e1;e2] -> begin + if DCE.canonCompareExp e1 e2 + then [Set(lv,e1,l)] + else begin + match proveLe ~allowGt:true e1 e2 "deputy_max", + proveLe ~allowGt:true e2 e1 "deputy_max" with + | LessEqual, _ -> [Set(lv,e2,l)] + | _, LessEqual -> [Set(lv,e1,l)] + | _, _ -> begin + if !debug then + ignore(E.log "opt_deputy_instr: must keep %a\n" d_instr i); + [i] + end + end + end + | _ -> begin + if !debug then + ignore(E.log "opt_deputy_instr: not right form %a\n" d_instr i); + [i] + end + end + | _ -> begin + if !debug then + ignore(E.log "opt_deputy_instr: not deputy_max: %a\n" d_instr i); + [i] + end + +let optimizeVisitor ?(supErr : bool = false) () = object (self) + inherit nopCilVisitor + + method vinst i = + match instrToCheck i with + | Some c -> ChangeTo (List.map checkToInstr (optimizeCheck ~supErr:supErr c)) + | None -> if is_deputy_instr i + then ChangeTo(opt_deputy_instr i) + else DoChildren + + method vfunc fd = + curFunc := fd; + let cleanup x = + curFunc := dummyFunDec; + x + in + ChangeDoChildrenPost (fd, cleanup) + +end diff --git a/src/optimizer/dflowsens.ml b/src/optimizer/dflowsens.ml new file mode 100644 index 0000000..cf68ba8 --- /dev/null +++ b/src/optimizer/dflowsens.ml @@ -0,0 +1,1801 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * + * dflowsens.ml + * + * A flow-sensitive optimizer for nonnull, strlen, and inequalities + * + * + *) + +open Cil +open Expcompare +open Pretty +open Dattrs +open Dutil +open Dcheckdef +open Doptimutil +open Doptions + +open Dflowinsens + +module E = Errormsg +module IH = Inthash +module DF = Dataflow +module S = Stats +module P = Dptranal +module DCE = Dcanonexp +module DPF = Dprecfinder +module AELV = Availexpslv + +(*let debug = ref true*) + +(* + * When ignore_inst returns true, then + * the instruction in question has no + * effects on the abstract state. + * When ignore_call returns true, then + * the instruction only has side-effects + * from the assignment if there is one. + *) +let ignore_inst = ref (fun i -> false) +let ignore_call = ref (fun i -> false) + +let registerIgnoreInst (f : instr -> bool) : unit = + let f' = !ignore_inst in + ignore_inst := (fun i -> (f i) || (f' i)) + +let registerIgnoreCall (f : instr -> bool) : unit = + let f' = !ignore_call in + ignore_call := (fun i -> (f i) || (f' i)) + +type kind = + | VCV (* var1 + const <= var2 *) + | VVC (* var1 + var2 <= const *) + +type absState = { + nonNullLvals: (lval * referenced) list; (*varinfo list;*) + + strlenVars: (varinfo * (exp * referenced)) list; + (** (v, e, mem, vars) means that v holds the the length of string e. + For convenience, we also remember whether e involves a memory reference + and what local vars e contains. *) + + ineqs: (lval * int64 * lval * referenced * kind) list; + (** (x, c, y, vars, VCV) means that x + c <= y. + (x, c, y, vars, VVC) means that x + y <= c. + Also, if x is a pointer and VCV, then x+c < 2^32, so x+c doesn't overflow. + (We usually get this fact just by knowing that any ptr arith that appears + in a program has first been checked for overflow with CPtrArith) + '+' is done on integers, not pointers. + We also remember the memory/variables that either expression depend on. *) + + preds: (exp * int64 * referenced) list list; + (** list of true disjunctions. i.e. [[(e,5);(e,8)];[(f,10)]] means + ((e==5)\/(e==8))/\(f==10) *) + + canIncrement: (lval * exp * referenced) list; + (** (x, e) means that x is an NT pointer that can safely be incremented + by e. *) +} + + +let top = { nonNullLvals = []; + strlenVars = []; + ineqs = []; + preds = []; + canIncrement = []; + } + +let printIneq (lv1,i,lv2,_,k): doc = + match k with + | VCV -> + dprintf "%a + %Ld <= %a" dx_lval lv1 i dx_lval lv2 + | VVC -> + dprintf "%a + %a <= %Ld" dx_lval lv1 dx_lval lv2 i + +let d_state () a: doc = + if a.strlenVars == [] then + dprintf + "@[Nonnull lvals:@[%a@]\nInEqs:@[%a@]\nPreds:@[%a@]\nCanIncr:@[%a@]@]" + (docList (fun (lv,_) -> dx_lval () lv)) a.nonNullLvals + (docList ~sep:Pretty.line printIneq) a.ineqs + (docList ~sep:Pretty.line (fun dl -> dprintf "%a" + (docList (fun (e,i,_) -> dprintf "%a = %Ld" dx_exp e i)) dl)) a.preds + (docList ~sep:Pretty.line (fun (x,e,_) -> dprintf "%a by %a" + dx_lval x dx_exp e)) a.canIncrement + else + dprintf + "@[Nonnull lvals:@[%a@]\nStrlenVars:@[%a@]\nInEqs:@[%a@]\nPreds:@[%a@]\nCanIncr:@[%a@]@]" + (docList (fun (lv,_) -> dx_lval () lv)) a.nonNullLvals + (docList (fun (vi,(e,_)) -> + text(vi.vname^" for ") ++ dx_exp () e)) a.strlenVars + (docList ~sep:Pretty.line printIneq) a.ineqs + (docList ~sep:Pretty.line (fun dl -> dprintf "%a" + (docList (fun (e,i,_) -> dprintf "%a = %Ld" dx_exp e i)) dl)) a.preds + (docList ~sep:Pretty.line (fun (x,e,_) -> dprintf "%a by %a" + dx_lval x dx_exp e)) a.canIncrement + + +(* This fake variable is used to represent 0. It should never appear in + output code *) +let zeroLv : lval = + let v = makeVarinfo false "_ZERO_" longType in + var v + +let isNonNull' (a: absState) (lv: lval) : bool = + List.exists (fun (lv',_) -> DCE.canonCompareLval lv lv') + a.nonNullLvals + +let addNonNull (a:absState) (lv: lval) : absState = + if isNonNull' a lv then a + else begin + let kill : referenced = Dutil.varsOfExp (Lval lv) in + { a with nonNullLvals = (lv,kill)::a.nonNullLvals } + end + +let addStringlen (a:absState) (vi:varinfo) (str:exp) : absState = + try + let other,_ = List.assq vi a.strlenVars in + if DCE.canonCompareExp(*compareExpStripCasts*) other str then + a + else + E.s (unimp "%s is the length of two different strings: %a and %a\n" + vi.vname dx_exp other dx_exp str) + with Not_found -> + let kill : referenced = Dutil.varsOfExp str in + { a with strlenVars = (vi,(str,kill))::a.strlenVars } + +(* Do we know the length of this string? *) +let hasStringlen (a:absState) (str:exp) : exp option = + let rec loop = + function (vi, (e, _))::rest -> + if DCE.canonCompareExp(*compareExpStripCasts*) e str then + Some (Lval (var vi)) + else loop rest + | [] -> None + in + loop a.strlenVars + +let addLessEq (a:absState) (lv1: lval) (i:int64) (lv2:lval) (k:kind) : absState = + let alreadyExists: bool = + (* unlike ineqHolds, we look for this exact statement rather than a + stronger one. *) + List.exists + (fun (lv1', i', lv2', _,k') -> + (DCE.canonCompareLval lv1 lv1') && (DCE.canonCompareLval lv2 lv2') && + i' = i && k = k') + a.ineqs + in + if alreadyExists then a + else begin + (* make a fake binop so we can get the combined deps of e1 and e2*) + let e' = BinOp(PlusA, Lval lv1, Lval lv2, intType) in + let fact = (lv1, i, lv2, Dutil.varsOfExp e', k) in + let a' = { a with ineqs = fact::a.ineqs } in + if !debug then log "New State = %a\n" d_state a'; + a' + end + +(* is there some i for which lv1 + i <= lv2 *) +(*let getLessEq (a:absState) (lv1 : lval) (lv2 : lval) : int64 option =*) + +(* If k is VCV, Is it true that (lv1 + i <= lv2)? + * To answer this, we look for (lv1, i', lv2) in the state, where i' >= i. + * If k is VVC, Is it true that (lv1 + lv2 <= i)? + * To answer this, we look for (lv1, i', lv2) in the state, where i' <= i. *) +let ineqHolds (a:absState) (lv1: lval) (i:int64) (lv2:lval) (k:kind) : bool = + let findIneq lv1 i lv2: bool = + (* Search the state for lv1 + i <= lv2, or a stronger statement. *) + match k with + | VCV -> + List.exists + (fun (lv1', i', lv2', _, k') -> + (DCE.canonCompareLval lv1 lv1') && (DCE.canonCompareLval lv2 lv2') && + i' >= i && k=k') + a.ineqs + | VVC -> + List.exists + (fun (lv1', i', lv2', _, k') -> + (DCE.canonCompareLval lv1 lv1') && (DCE.canonCompareLval lv2 lv2') && + i' <= i && k = k') + a.ineqs + in +(* log "Checking inequality %a + %Ld <= %a\n in %a" *) +(* dx_lval lv1 i dx_lval lv2 d_state a; *) + if k = VCV && DCE.canonCompareLval lv1 lv2 then + (i <=% 0L) + else if findIneq lv1 i lv2 then + true + else if lv1 != zeroLv && lv2 != zeroLv && k = VCV then begin + (* One last shot: If there exists k such that lv1 <= k && k + i <= lv2, + then the inequality holds. *) + List.exists + (fun (lv1', negk, z, _, k') -> + z == zeroLv && k' = VCV && (DCE.canonCompareLval lv1 lv1') + (* so far, lv + negk <= 0 (i.e. lv <= -negk) + Now check k + i <= lv2. *) + && findIneq zeroLv (i -% negk) lv2) + a.ineqs + end else + false + +let isLvalZero (a : absState) (lv : lval) : bool = + ineqHolds a zeroLv Int64.zero lv VCV && + ineqHolds a lv Int64.zero zeroLv VCV + +(* Is there an integer upper bound for lv1 + lv2 ? *) +let findUpperBoundSum (a:absState) (lv1 : lval) (lv2 : lval) : int64 option = + let rec helper ineql io : int64 option = + match ineql with + | [] -> io + | (lv1p, i, lv2p, _, VVC) :: rst -> begin + if DCE.canonCompareLval lv1 lv1p && + DCE.canonCompareLval lv2 lv2p then begin + match io with + | None -> helper rst (Some i) + | Some ip -> + if i < ip + then helper rst (Some i) + else helper rst io + end else helper rst io + end + | _ -> io + in + helper a.ineqs None + +let findUpperBound (a : absState) (lv : lval) : int64 option = + let rec helper ineql io : int64 option = + match ineql with + | [] -> io + | (lv1p, i, lv2p, _, VCV) :: rst when lv2p == zeroLv -> begin + if DCE.canonCompareLval lv lv1p then begin + match io with + | None -> helper rst (Some (Int64.neg i)) + | Some ip -> + if i > ip + then helper rst (Some i) + else helper rst io + end else helper rst io + end + | _ -> io + in + helper a.ineqs None + +let addPred (a : absState) (djs : (exp * int64) list) : absState = + let djs = List.map (fun (e,i) -> (e,i,Dutil.varsOfExp e)) djs in + let djeq dj = + List.filter (fun (e,i,_) -> + not(List.exists (fun (e',i',_) -> + DCE.canonCompareExp e e' && i = i') + djs)) + dj = [] && + List.filter (fun (e,i,_) -> + not(List.exists (fun (e',i',_) -> + DCE.canonCompareExp e e' && i = i') + dj)) + djs = [] + in + if List.exists djeq a.preds then a else + let preds = (* if a term has a disjunct that disagrees with + all disjuncts of djs, then filter out the whole term *) + List.filter (fun dj -> + not(List.exists (fun (e,i,_) -> + not(List.exists (fun (e',i',_) -> + not(DCE.canonCompareExp e e') || i = i') + djs)) + dj)) + a.preds + in + let preds = List.filter (fun dj -> dj <> []) preds in + { a with preds = djs :: preds } + +let hasPred (a : absState) (p : (exp * int64) list) : bool = + List.exists (fun dl -> dl <> [] && List.fold_left + (fun b (e,i,_) -> b && + List.exists (fun (e',i') -> + i = i' && DCE.canonCompareExp e e') + p) + true dl) + a.preds + +let addCanIncrement (a:absState) (p:lval) (howmuch:exp) : absState = + (* make a fake binop so we can get the combined deps of p and howmuch *) + let e' = BinOp(PlusA, Lval p, howmuch, intType) in + let fact = (p, howmuch, Dutil.varsOfExp e') in + if List.mem fact a.canIncrement then a + else + { a with canIncrement = fact::a.canIncrement } + +let canIncrement (a:absState) (p:lval) (howmuch:exp) : bool = + (* TODO: is it worthwhile to use inequality information here? *) + (List.exists + (fun (p', e', _) -> + (DCE.canonCompareLval p p') && (DCE.canonCompareExp howmuch e') ) + a.canIncrement) + || + (* Is howmuch == strlen(p)? *) + ((hasStringlen a (Lval p)) = (Some howmuch)) + +(* Remove certain entries from a list, without preserving order *) +let removeAll (f: 'a -> bool) (l: 'a list): 'a list = + if List.exists f l then + List.fold_left + (fun acc x -> if f x then acc else x::acc) + [] + l + else + l + +let updateNonnull (a:absState) nonnull' : absState = + (*if nonnull' == a.nonNullVars then a + else*) + { a with nonNullLvals = nonnull' } + +let updateStrlen (a:absState) strlens' : absState = + if strlens' == a.strlenVars then a + else + { a with strlenVars = strlens' } +let updateIneqs (a:absState) ineqs' : absState = + if ineqs' == a.ineqs then a + else + { a with ineqs = ineqs' } + +let updatePreds (a : absState) preds : absState = + if preds == a.preds then a + else { a with preds = preds } + +let updateCanIncr (a:absState) ci' : absState = + if ci' == a.canIncrement then a + else + { a with canIncrement = ci' } + +let scrambleVar (a:absState) (v: varinfo) : absState = + let a = + let refersToV (_, kill) = (List.memq v kill.varsRead) in + let nonnull' = removeAll refersToV a.nonNullLvals in + updateNonnull a nonnull' + in + let a = + let refersToV (v',(_,kill)) = (v==v') || (List.memq v kill.varsRead) in + let strlen' = removeAll refersToV a.strlenVars in + updateStrlen a strlen' + in + let a = + let refersToV (_,_,_,kill,_) = (List.memq v kill.varsRead) in + let ineqs' = removeAll refersToV a.ineqs in + updateIneqs a ineqs' + in + let a = + let reversToV dl = List.exists + (fun (_,_,kill) -> List.memq v kill.varsRead) dl + in + let preds' = removeAll reversToV a.preds in + updatePreds a preds' + in + let a = + let refersToV (_,_,kill) = (List.memq v kill.varsRead) in + let ci' = removeAll refersToV a.canIncrement in + updateCanIncr a ci' + in + a + +(* After a write to memory, scramble all vars whose addresses have been + taken.*) +let scrambleMem ?(globalsToo=false) (a:absState) (eo : exp option) : absState = + let scrambled: varinfo -> bool = + fun vi -> vi.vaddrof || (vi.vglob && globalsToo) + in + let a = + if !doPtrAnalysis then + match eo with + | Some ee -> + let nonnull = + List.filter (fun lvr -> not(P.lval_has_alias_read ee (fst lvr))) + a.nonNullLvals + in + updateNonnull a nonnull + | None -> + let refersToMem (_, kill) = + kill.memRead || (List.exists scrambled kill.varsRead) in + let nonnull' = removeAll refersToMem a.nonNullLvals in + updateNonnull a nonnull' + else + let refersToMem (_, kill) = + kill.memRead || (List.exists scrambled kill.varsRead) in + let nonnull' = removeAll refersToMem a.nonNullLvals in + updateNonnull a nonnull' + in + let a = + if !doPtrAnalysis then + match eo with + | Some ee -> + let strlen = + List.filter (fun vir -> + not(P.lval_has_alias_read ee (Var (fst vir),NoOffset))) + a.strlenVars + in + updateStrlen a strlen + | None -> + let refersToMem (v',(_,kill)) = + kill.memRead || (scrambled v') || (List.exists scrambled kill.varsRead) in + let strlen' = removeAll refersToMem a.strlenVars in + updateStrlen a strlen' + else + let refersToMem (v',(_,kill)) = + kill.memRead || (scrambled v') || (List.exists scrambled kill.varsRead) in + let strlen' = removeAll refersToMem a.strlenVars in + updateStrlen a strlen' + in + let a = + if !doPtrAnalysis then + match eo with + | Some ee -> + let ineqs = + List.filter (fun (lv1,_,lv2,_,_) -> + not(P.lval_has_alias_read ee lv1) && + not(P.lval_has_alias_read ee lv2)) + a.ineqs + in + updateIneqs a ineqs + | None -> + let refersToMem (_,_,_,kill,_) = + kill.memRead || (List.exists scrambled kill.varsRead) in + let ineqs' = removeAll refersToMem a.ineqs in + updateIneqs a ineqs' + else + let refersToMem (_,_,_,kill,_) = + kill.memRead || (List.exists scrambled kill.varsRead) in + let ineqs' = removeAll refersToMem a.ineqs in + updateIneqs a ineqs' + in + let a = + if !doPtrAnalysis then + match eo with + | Some ee -> + let preds = + List.filter (fun dl -> not(List.exists + (fun (e,_,_) -> P.exp_has_alias_read ee e) dl)) + a.preds + in + updatePreds a preds + | None -> + let refersToMem dl = List.exists + (fun (_,_,kill) -> + kill.memRead || (List.exists scrambled kill.varsRead)) + dl + in + let preds = removeAll refersToMem a.preds in + updatePreds a preds + else + let refersToMem dl = List.exists + (fun (_,_,kill) -> + kill.memRead || (List.exists scrambled kill.varsRead)) + dl + in + let preds = removeAll refersToMem a.preds in + updatePreds a preds + in + let a = + if !doPtrAnalysis then + match eo with + | Some ee -> + let ci = + List.filter (fun (lv,e,_) -> + not(P.lval_has_alias_read ee lv) && + not(P.exp_has_alias_read ee e)) + a.canIncrement + in + updateCanIncr a ci + | None -> + let refersToMem (_,_,kill) = + kill.memRead || (List.exists scrambled kill.varsRead) in + let ci' = removeAll refersToMem a.canIncrement in + updateCanIncr a ci' + else + let refersToMem (_,_,kill) = + kill.memRead || (List.exists scrambled kill.varsRead) in + let ci' = removeAll refersToMem a.canIncrement in + updateCanIncr a ci' + in + a + +let stateMap : absState IH.t = IH.create 50 + +let isNonNull state e: bool = +(* log "isNonNull? on %a.\n" d_plainexp e; *) + (isNonnullType (typeOf e)) || + (match stripNopCasts e with + Lval lv -> + isNonNull' state lv + | BinOp((PlusPI|IndexPI|MinusPI), e1, e2, _) -> + (* We've disallowed ptr arith if e1 is null. *) + let t1 = typeOf e1 in + isPointerType t1 && not (isSentinelType t1) + | AddrOf lv + | StartOf lv -> true + | Const(CStr _) -> true + | _ -> false) + +let isFalse state e = + match e with + UnOp(LNot, e', _) -> isNonNull state e' + | _ -> isZero e + + +exception CantDecompose + +(* Take this sum expression and return p, [off1; off2; ...], c + where e = p + (off1 + off2 + ... + c), p is a pointer or zeroLv, + and the first + is ptr arith (unless p is zeroLv). *) +let rec expToSum (e: exp) : lval * (lval list) * int64 = + let e' = constFold true (stripCastsForPtrArith e) in + match e' with + Lval lv + | StartOf lv -> (* Treat array references as lvals. *) + (* we get the type of e, not e', because we want to consider casts + when deciding whether to classify this as a pointer or an int. *) + if isPointerType (typeOf e) then + lv, [], 0L + else if isArrayType (typeOf e) then + raise CantDecompose + (*E.s (bug "expToSum on %a" dx_exp e)*) + else + zeroLv, [lv], 0L + | Const _ when isIntegralType (typeOf e) -> + let c = match isInteger e' with + Some i64 -> i64 + | None -> E.s (bug "expected a constant here.") + in + zeroLv, [], c + | BinOp((PlusPI|IndexPI), e1, e2, t) -> + let lvp1, offs1, c1 = expToSum e1 in + let lvp2, offs2, c2 = expToSum e2 in + if lvp2 != zeroLv then + E.s (bug ("expToSum on \"%a\" returned a pointer, but there should be" + ^^" no pointer on the right operand of PlusPI") dx_exp e); + if lvp1 == zeroLv then + E.s (unimp "expToSum returned NULL for the left operand of PlusPI"); + lvp1, offs1@offs2, (c1+%c2) + | BinOp(PlusA, e1, e2, t) when isIntegralType t -> + let lvp1, offs1, c1 = expToSum e1 in + let lvp2, offs2, c2 = expToSum e2 in + if lvp1 != zeroLv || lvp2 != zeroLv then + E.s (bug ("expToSum on \"%a\" returned a pointer, but there should be" + ^^" no pointer with PlusA") dx_exp e); + zeroLv, offs1@offs2, (c1+%c2) + | _ -> + (*if !debug then + log "Can't decompose %a into a sum." dx_exp e;*) + raise CantDecompose + +(* Given a list of lvals, return an lval representing the sum of the list + elements, or raise CantDecompose if there are two or more lvals in the list*) +let getOneLval (l:lval list) : lval = + match l with + [] -> zeroLv + | [lv] -> lv + | _ -> raise CantDecompose + + +(* Decompose the expression into lv+c (integer arithmetic, not pointer), + or raise an exception if this isn't possible *) +let rec expToIntSum (e:exp) : lval * int64 = + match expToSum e with + lv, [], c when lv != zeroLv -> begin + (* FIXME: I'm trusting here that there's no overflow, since + that should already be taken care of. Is there a better way to reason + about overlfow? *) + (* This is lv+c. Do the multiplication now, to handle ptr arith. *) + let bs = try bitsSizeOf (baseType "(sizeof base type)" (typeOfLval lv)) / 8 + with _ -> raise CantDecompose + in + if c <> 0L then + lv, (c *% (Int64.of_int bs)) + else + (* if c = 0, don't compute the baseSize, since we don't need to + (and it could be a pointer to an abstract type.) *) + lv, 0L + end + | z, offs, c when z == zeroLv -> + (* offs + c, no pointers involved. *) + getOneLval offs, c + | _ -> + raise CantDecompose + +(* Try to find an upper bound for the canon exp ce *) +(* TODO: handle more things than just c + f1*lv1 + f2*lv2 *) +let upperBoundCESum (state : absState) (ce : DCE.Can.t) : DCE.Can.t = + if !debug then + log "upperBoundCE: finding ubound for: %a" DCE.Can.d_t ce; + match ce.DCE.Can.cf with + | [(f1,e1) ; (f2,e2)] -> begin + match e1, e2 with + | (StartOf lv1 | Lval lv1), (StartOf lv2 | Lval lv2) -> begin + if f1 >=Int64.zero && f1 = f2 then begin + match findUpperBoundSum state lv1 lv2 with + | Some c64 -> + let c = fst(truncateInteger64 ce.DCE.Can.ck (Int64.add c64 ce.DCE.Can.ct)) in + {DCE.Can.ct = c; DCE.Can.cf = []; DCE.Can.ck = ce.DCE.Can.ck} + | None -> begin + if !debug then + log "upperBoundCE: no ubound in state %a" DCE.Can.d_t ce; + ce + end + end else begin + if !debug then + log "upperBoundCE: bad coefs %a" DCE.Can.d_t ce; + ce + end + end + | _ -> begin + if !debug then + log "upperBoundCE: bad form %a" DCE.Can.d_t ce; + ce + end + end + | _ -> begin + if !debug then + log "upperBoundCE: too many %a" DCE.Can.d_t ce; + ce + end + + +(* TODO: overflow? *) +let upperBoundCEAtom (state : absState) (ce : DCE.Can.t) : DCE.Can.t = + let rec ubExp (e : exp) : int64 option = + match e with + | Const(CInt64(i,_,_)) -> Some i + | Lval lv | StartOf lv -> findUpperBound state lv + | BinOp(Mult,e1,e2,t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> Some(Int64.mul i1 i2) + | _ -> None + end + | BinOp(Div,e1,e2,t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> Some(Int64.div i1 i2) + | _ -> None + end + | BinOp(Shiftlt,e1,e2,t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> Some(Int64.shift_left i1 (Int64.to_int i2)) + | _ -> None + end + | BinOp(Shiftrt,e1,(Const _ as e2),t) when not(isSignedType t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> + Some(Int64.shift_right_logical i1 (Int64.to_int i2)) + | _ -> None + end + | BinOp(BAnd,e1,(Const _ as e2),t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> Some(Int64.logand i1 i2) + | _ -> None + end + | BinOp(BXor,e1,(Const _ as e2),t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> Some(Int64.logxor i1 i2) + | _ -> None + end + | BinOp(BOr,e1,(Const _ as e2),t) -> begin + match ubExp e1, ubExp e2 with + | Some i1, Some i2 -> Some(Int64.logor i1 i2) + | _ -> None + end + | _ -> None + in + let ubTerm (f, e) : int64 option = + if f < Int64.zero then None else + match ubExp e with + | None -> None + | Some i -> Some(Int64.mul i f) + in + let rec folder sum l r : int64 * (int64 * exp) list = + match l with + | [] -> sum, r + | t :: rst -> begin + match ubTerm t with + | Some i -> folder (Int64.add sum i) rst r + | None -> folder sum rst (t::r) + end + in + let (c,l) = folder ce.DCE.Can.ct ce.DCE.Can.cf [] in + {DCE.Can.ct = c; DCE.Can.cf = l; DCE.Can.ck = ce.DCE.Can.ck} + + + +let biginteger (i : int64) : exp = Const(CInt64(i,ILongLong,None)) + + + + +(* cePosInState: "canonical expression positive in state" + *) +let rec cePosInState (modify : bool) + (state : absState) + (cdiff : DCE.Can.t) + : bool * absState + = + if !debug then log "cePosInState: %a" DCE.Can.d_t cdiff; + match DCE.Can.getSign cdiff with + | DCE.Can.Pos | DCE.Can.Zero -> (true, state) + | DCE.Can.Neg -> begin + if !debug then + log "doExpLeq: can't prove %a >= 0" + DCE.Can.d_t cdiff; + (false, state) + end + | DCE.Can.DontKnow -> begin + match cdiff.DCE.Can.cf with + | [ f, e ] -> begin + match e with + | StartOf lv + | Lval lv -> + (* need to get rid of coefs on the lval *) + if Int64.rem (Int64.abs cdiff.DCE.Can.ct)(Int64.abs f) = Int64.zero then + let c = Int64.div cdiff.DCE.Can.ct (Int64.abs f) in + let f = Int64.div f (Int64.abs f) in + (* need 0 - c <= f*lv --> f*lv + c >= 0 *) + if f >= Int64.zero then + if modify then + (true, addLessEq state zeroLv (Int64.neg c) lv VCV) + else if ineqHolds state zeroLv (Int64.neg c) lv VCV then + (true, state) + else begin + if !debug then + log "doExpLeq: in state %a\ncan't prove %a >= 0" + d_state state DCE.Can.d_t cdiff; + (false, state) + end + else + if modify then begin + (true, addLessEq state lv (Int64.neg c) zeroLv VCV) + end else + if ineqHolds state lv (Int64.neg c) zeroLv VCV then + (true, state) + else begin + if !debug then + log "doExpLeq: in state %a\ncan't prove %a >= 0" + d_state state DCE.Can.d_t cdiff; + (false, state) + end + else begin + if !debug then + log "doExpLeq: bad coefs %a" + DCE.Can.d_t cdiff; + (false, state) + end + | _ -> begin + if !debug then + log "doExpLeq: bad form1: %a" + DCE.Can.d_t cdiff; + (false, state) + end + end + (* We've only got octagons. *) + | (f1,e1') :: (f2,e2') :: [] -> begin + (* Check that f1*e1 + f2*e2 + c >= 0 *) + (* We want to make sure this is non-negative *) + (* If f1 f2 and c are >= 0, then check e1, e2 >= 0 *) + if f1 >= Int64.zero && f2 >= Int64.zero && + cdiff.DCE.Can.ct >= Int64.zero then + match e1', e2' with + | StartOf lv1, StartOf lv2 + | StartOf lv1, Lval lv2 + | Lval lv1, StartOf lv2 + | Lval lv1, Lval lv2 -> + if modify then + let state = addLessEq state zeroLv Int64.zero lv1 VCV in + (true, addLessEq state zeroLv Int64.zero lv2 VCV) + else if (ineqHolds state zeroLv Int64.zero lv1 VCV) && + (ineqHolds state zeroLv Int64.zero lv2 VCV) then + (true, state) + else begin + if !debug then + log "doExpLeq: in state %a\ncan't prove %a >= 0" + d_state state DCE.Can.d_t cdiff; + (false, state) + end + | _, _ -> begin + if !debug then + log "doExpLeq: bad form2: %a" + DCE.Can.d_t cdiff; + (false, state) + end + (* If f1 < 0, then check f2*e2 >= -f1*e1 - c *) + (* If f2 < 0, then check f1*e1 >= -f2*e2 - c *) + (* If both, then check c >= -f1*e1 + -f2*e2 *) + else begin + match e1', e2' with + | StartOf lv1, StartOf lv2 + | StartOf lv1, Lval lv2 + | Lval lv1, StartOf lv2 + | Lval lv1, Lval lv2 -> begin + if (Int64.abs f1) = (Int64.abs f2) && + Int64.rem (Int64.abs cdiff.DCE.Can.ct) (Int64.abs f1) = Int64.zero + then + let c = Int64.div cdiff.DCE.Can.ct (Int64.abs f1) in + let f1 = Int64.div f1 (Int64.abs f1) in + (*let f2 = f2 / (abs f2) in*) + if f1 < Int64.zero && f2 > Int64.zero then + if modify then + (true, addLessEq state lv1 (Int64.neg c) lv2 VCV) + else if ineqHolds state lv1 (Int64.neg c) lv2 VCV then + (true, state) + else begin + if !debug then + log "doExpLeq: in state %a\ncan't prove %a >= 0" + d_state state DCE.Can.d_t cdiff; + (false, state) + end + else if f2 < Int64.zero && f1 > Int64.zero then (* f2 < 0 *) + if modify then + (true, addLessEq state lv2 (Int64.neg c) lv1 VCV) + else if ineqHolds state lv2 (Int64.neg c) lv1 VCV then + (true, state) + else begin + if !debug then + log "doExpLeq: in state %a\ncan't prove %a >= 0" + d_state state DCE.Can.d_t cdiff; + (false, state) + end + else if f1 < Int64.zero && f2 < Int64.zero then + if modify then + (true, addLessEq state lv1 c lv2 VVC) + else if ineqHolds state lv1 c lv2 VVC || + ineqHolds state lv2 c lv1 VVC then + (true, state) + else begin + if !debug then + log "doExpLeq: in state %a\ncan't prove %a >= 0" + d_state state DCE.Can.d_t cdiff; + (false, state) + end + else begin + if !debug then + log "doExpLeq: bad coefs: %a" + DCE.Can.d_t cdiff; + (false, state) + end + else begin + if !debug then + log "doExpLeq: bad coefs: %a" + DCE.Can.d_t cdiff; + (false, state) + end + end + | _, _ -> begin + if !debug then + log "doExpLeq: bad form3: %a" + DCE.Can.d_t cdiff; + (false, state) + end + end + end + | _ -> begin (false, state) +(* + match upperBoundCE state ce2, modify with + | Some c, true -> + doExpLeq ~modify:modify e1 (biginteger c) state + | _, _ -> begin + if !debug then + log "doExpLeq: Too Many: %a" + DCE.Can.d_t cdiff; + (false, state) + end +*) + end + end + +(* Check that e1 <= e2 in state "state" + * fst(doExpLeq false e1 e2 s) is true if e1 <= e2 can be proved + * snd(doExpLeq true e1 e2 s) is the state with e1 <= e2 added. + * fst(doExpLeq true e1 e2 s) is false if the state couldn't be updated. + * + *) +and doExpLeq ?(modify:bool=false) + (e1 : exp) + (e2 : exp) + (state : absState) + : bool * absState + = + let ce1 = DCE.canonExp Int64.one e1 in + let ce2 = DCE.canonExp Int64.one e2 in + let cdiff = DCE.Can.sub ce2 ce1 ILong in + let cdiff = + if modify then cdiff else + let nozeroes = List.filter (isNonZeroInState state) cdiff.DCE.Can.cf in + {cdiff with DCE.Can.cf = nozeroes} + in + if modify && !debug then + log "doExpLeq: adding %a <= %a" DCE.Can.d_t ce1 DCE.Can.d_t ce2 + else if !debug then + log "doExpLeq: checking if %a <= %a" DCE.Can.d_t ce1 DCE.Can.d_t ce2; + let (b, s) = cePosInState modify state cdiff in + if b then (b,s) else + (* The inequality could not be proved or added. + * If we're doing a modify, use an upper bound on e2. + * If we're doing a check, use an upper bound on e1 + *) + if modify then begin + let ce2 = upperBoundCESum state ce2 in + let cdiff = DCE.Can.sub ce2 ce1 ILong in + if !debug then + log "doExpLeq: failed. now trying to add %a <= %a" + DCE.Can.d_t ce1 DCE.Can.d_t ce2; + cePosInState modify state cdiff + end else begin + let ce1 = upperBoundCEAtom state ce1 in + let cdiff = DCE.Can.sub ce2 ce1 ILong in + let nonzeroes = List.filter (isNonZeroInState state) cdiff.DCE.Can.cf in + let cdiff = {cdiff with DCE.Can.cf = nonzeroes} in + if !debug then + log "doExpLeq: failed. now checking if %a <= %a" + DCE.Can.d_t ce1 DCE.Can.d_t ce2; + cePosInState modify state cdiff + end + + +(* return true if we know that the expression is zero. + false is the safe answer *) +and isZeroInState (state : absState) (e : exp) : bool = + let bigone = Const(CInt64(Int64.of_int 1,IULongLong,None)) in + match e with + | Const _ when DCE.canonCompareExp e zero -> true + | Lval lv -> isLvalZero state lv + | UnOp(Neg,e,t) -> isZeroInState state e + | BinOp((PlusA|PlusPI|IndexPI),e1,e2,t) -> + isZeroInState state e1 && + isZeroInState state e2 + | BinOp((MinusA|MinusPI|MinusPP),e1,e2,t) -> + fst(doExpLeq e1 e2 state) && + fst(doExpLeq e2 e1 state) + | BinOp(Mult,e1,e2,t) -> + isZeroInState state e1 || + isZeroInState state e2 + | BinOp(Div,e1,e2,t) -> + isZeroInState state e1 + | BinOp(Shiftlt,e1,e2,t) -> + isZeroInState state e1 + | BinOp(Shiftrt,e1,e2,t) when not(isSignedType t) -> + isZeroInState state e1 || + fst(doExpLeq e1 (constFold true (BinOp(Shiftlt,bigone,e2,t))) state) + | BinOp(BAnd,e1,e2,t) -> + isZeroInState state e1 || + isZeroInState state e2 + | BinOp(BXor,e1,e2,t) -> + fst(doExpLeq e1 e2 state) && + fst(doExpLeq e2 e1 state) + | BinOp(BOr,e1,e2,t) -> + isZeroInState state e1 && + isZeroInState state e2 + | CastE(t,e) -> isZeroInState state e + | _ -> false + +and isNonZeroInState (state : absState) (fe : int64 * exp) : bool = + not(isZeroInState state (snd fe)) + + + + +(* FIXME: use the sign info! E.g. add e1 >= 0 *) +let doLessEq a (e1: exp) (e2:exp) ~(signed:bool): absState = + if !debug then log "Guard %a <= %a.\n" dx_exp e1 dx_exp e2; + try + let t1 = typeOf e1 in + let t2 = typeOf e2 in + let lv1, c1 = expToIntSum e1 in + let lv2, c2 = expToIntSum e2 in + (* if t1 is unsigned or pointer, then add zeroLv + 0 <= lv1 *) + let a = + match t1 with + | TInt(ku,_) -> addLessEq a zeroLv (~-% c1) lv1 VCV + | TPtr(_,_) -> addLessEq a zeroLv (~-% c1) lv1 VCV + | _ -> a + in + let a = + match t2 with + | TInt(ku,_) -> addLessEq a zeroLv (~-% c2) lv2 VCV + | TPtr(_,_) -> addLessEq a zeroLv (~-% c2) lv2 VCV + | _ -> a + in + (*addLessEq a lv1 (c1 -% c2) lv2*) + snd(doExpLeq ~modify:true e1 e2 a) + with CantDecompose -> + snd(doExpLeq ~modify:true e1 e2 a) + + +let doLess a (e1: exp) (e2:exp) ~(signed:bool): absState = + if !debug then log "Guard %a < %a.\n" d_exp e1 d_exp e2; + try + let t1 = typeOf e1 in + let t2 = typeOf e2 in + let lv1, c1 = expToIntSum e1 in + let lv2, c2 = expToIntSum e2 in + (* if t1 is unsigned or pointer, then add zeroLv + 0 <= lv1 *) + let a = + match t1 with + | TInt(ku,_) when not(isSigned ku) -> addLessEq a zeroLv (~-% c1) lv1 VCV + | TPtr(_,_) -> addLessEq a zeroLv (~-% c1) lv1 VCV + | _ -> a + in + let a = + match t2 with + | TInt(ku,_) when not(isSigned ku) -> addLessEq a zeroLv (~-% c2) lv2 VCV + | TPtr(_,_) -> addLessEq a zeroLv (~-% c2) lv2 VCV + | _ -> a + in + (*addLessEq a lv1 (1L +% c1 -% c2) lv2*) + let e' = BinOp(PlusPI,e1,one,typeOf e1) in + snd(doExpLeq ~modify:true e' e2 a) + with CantDecompose -> + let e' = BinOp(PlusPI,e1,one,typeOf e1) in + snd(doExpLeq ~modify:true e' e2 a) + + +(* Turn a conjunction into a list of conjuncts *) +let expToConjList (e:exp) : (exp list) = + let rec helper e l = + match e with + | BinOp(LAnd, e1, e2, _) -> + let l1 = helper e1 [] in + let l2 = helper e2 [] in + l@l1@l2 + | _ -> e::l + in + helper e [] + +let expToDisjList (e:exp) : (exp list) = + let rec helper e l = + match e with + | BinOp(LOr, e1, e2, _) -> + let l1 = helper e1 [] in + let l2 = helper e2 [] in + l@l1@l2 + | _ -> e::l + in + helper e [] + +class nonDisjEqTestFinderClass (b : bool ref) = object(self) + inherit nopCilVisitor + + method vexpr (e : exp) = + match e with + | BinOp(Eq,_,_,_) -> SkipChildren + | BinOp(LOr,_,_,_) -> DoChildren + | BinOp(_,_,_,_) + | UnOp(_,_,_) -> + b := true; + SkipChildren + | _ -> SkipChildren + +end + +let onlyDisjEqTests (e : exp) : bool = + let br = ref false in + ignore(visitCilExpr (new nonDisjEqTestFinderClass br) e); + not(!br) + +let mkAddablePred (p : exp) : (exp * int64) list = + let djs = expToDisjList p in + List.map (fun p -> match p with + | BinOp(Eq,e1,e2,_) -> begin + match isInteger e1, isInteger e2 with + | None, Some i -> (e1,i) + | Some i, None -> (e2,i) + | _ -> (p,Int64.one) (* if onlyDisjEqTests p, then impossible *) + end + | _ -> (p,Int64.one)) (* if onlyDisjEqTests p, then impossible *) + djs + +let doOneBranch (a:absState) (e:exp) : absState = + if !debug then + log "Guard %a.\n" dx_exp e; + let rec simplifyBoolExp e = + match stripNopCasts e with + UnOp(LNot, UnOp(LNot, e, _), _) -> simplifyBoolExp e + | BinOp(Ne, e, z, _) when isZero z -> simplifyBoolExp e + | UnOp(LNot,BinOp(Ne,e1,e2,t),_) -> + BinOp(Eq,e1,e2,t) + | UnOp(LNot, BinOp(Eq, e, z, _), _) -> simplifyBoolExp e + | UnOp(LNot, BinOp(Lt, e1, e2, t), _) -> + BinOp(Ge, e1, e2, t) + | UnOp(LNot, BinOp(Le, e1, e2, t), _) -> + BinOp(Gt, e1, e2, t) + | UnOp(LNot, BinOp(Gt, e1, e2, t), _) -> + BinOp(Le, e1, e2, t) + | UnOp(LNot, BinOp(Ge, e1, e2, t), _) -> + BinOp(Lt, e1, e2, t) + | e -> e + in + let e = simplifyBoolExp e in + match e with + | Lval lv -> begin + let a = + match lv with + | (Mem(Lval lvp), NoOffset) when isNullterm (typeOfLval lvp) -> + addCanIncrement a lvp Cil.one + | _ -> a + in + if isPointerType(typeOf e) then + addNonNull a lv + else + a + end + | BinOp(Lt, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLess a e1 e2 ~signed:(isSignedType (typeOf e1)) + | BinOp(Le, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLessEq a e1 e2 ~signed:(isSignedType (typeOf e1)) + | BinOp(Gt, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLess a e2 e1 ~signed:(isSignedType (typeOf e1)) + | BinOp(Ge, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLessEq a e2 e1 ~signed:(isSignedType (typeOf e1)) + | e -> if onlyDisjEqTests e then addPred a (mkAddablePred e) else a + +(* Update a state to reflect a branch *) +let doBranch (a:absState) (e:exp) : absState = + if !debug then log "doBranch: for branch %a: state %a ->" + d_exp e d_state a; + let conjList = expToConjList e in + let newstate = List.fold_left doOneBranch a conjList in + if !debug then log "doBranch: result %a" d_state newstate; + newstate + +(* Add that + * lv >= e1 and + * lv >= e2 + *) +let doMax a lv e1 e2 = + let a' = doLessEq a e1 (Lval lv) ~signed:(isSignedType(typeOf e1)) in + let a' = doLessEq a' e2 (Lval lv) ~signed:(isSignedType(typeOf e2)) in + a' + + +(* Update a state to reflect a check *) +let processCheck a (c:check) : absState = + match c with + CNonNull e -> doBranch a e + | CLeq(e1, e2, _) -> doLessEq a e1 e2 ~signed:false + | CLeqInt(e1, e2, _) -> doLessEq a e1 e2 ~signed:false + | CPtrArith(lo, hi, p, e, _) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + (*let a = doLessEq a e' (kinteger64 IUInt (maxUnsignedInt(typeOf e'))) ~signed:false in*) + let a = doLessEq a lo e' ~signed:false in + doLessEq a e' hi ~signed:false + | CPtrArithNT(lo, hi, p, e, _) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + (*let a = doLessEq a e' (kinteger64 IUInt (maxUnsignedInt(typeOf e'))) ~signed:false in*) + let a = doLessEq a lo e' ~signed:false in + a (* no upper bound *) + | CPtrArithAccess(lo, hi, p, e, _) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + (*let a = doLessEq a e' (kinteger64 IUInt (maxUnsignedInt(typeOf e'))) ~signed:false in*) + let a = doLessEq a lo e' ~signed: false in + doLessEq a (BinOp(PlusPI,p,BinOp(PlusA,e,one,typeOf e),typeOf p)) hi ~signed:false + | CSelected e -> doBranch a e + | CNotSelected e -> doBranch a (UnOp(LNot,e,typeOf e)) + | _ -> a + +(* Add to anext any relevant inequality information for the assignment + dest := e +*) +let doSet ~(aold:absState) ~(anext:absState) (dest: lval) (e:exp) : absState = + if !debug then log "doSet: %a := %a\n" dx_lval dest dx_exp e; + match isInteger (constFold true e) with + Some i -> + (* Add dest <= i and i <= dest *) + let anext = addLessEq anext dest (~-% i) zeroLv VCV in + let anext = addLessEq anext zeroLv i dest VCV in + anext + | None -> begin + let anext = match e with + Lval lv -> + (* For each fact about lv in the old state, + add an analogous fact about dest *) + List.fold_left + (fun anext (lv1, e, _) -> + if DCE.canonCompareLval lv1 lv then + addCanIncrement anext dest e + else + anext) + anext + aold.canIncrement + | _ -> anext + in + try + let lvrhs, c = expToIntSum e in + if c = 0L then begin + (* The assignment is dest := lvrhs *) + + (* For each fact about lvrhs in the old state, + add an analogous fact about dest *) + List.fold_left + (fun anext (lv1, n, lv2, _, k) -> + let anext = if DCE.canonCompareLval lv1 lvrhs then + addLessEq anext dest n lv2 k + else anext in + let anext = if DCE.canonCompareLval lv2 lvrhs then + addLessEq anext lv1 n dest k + else anext in + anext) + anext + aold.ineqs + end + else begin + (* The assignment is dest := lvrhs+c, where c is an int *) + + (* For each fact about lvrhs in the old state, + add a fact about dest, after adjusting by c *) + let anext = + List.fold_left + (fun anext (z, n, lv2, _, k) -> + (* We have to be very conservative, because of + overflow. If 0+n <= lvrhs AND lvrhs <= MAXINT-c, + then "dest := lvrhs+c" does not overflow, and we + get the new fact 0 + (n+c) <= dest *) + if (z == zeroLv && DCE.canonCompareLval lv2 lvrhs) (*&& k = VCV*) + (* so far, 0+n <= lvrhs *) + && + (ineqHolds aold lvrhs (c -% (maxUnsignedInt(typeOf e))) zeroLv VCV) + (* now lvrhs <= MAXINT-c. To see this, note that the line + above tests lvrhs + c-MAXINT <= 0, i.e. lvrhs <= -(c-MAXINT) + *) + then begin + if !debug then log "doSet: adding 0 + %Ld <= %a\n" + (n +% c) d_lval dest; + addLessEq anext zeroLv (n +% c) dest k + end else if (DCE.canonCompareLval dest lvrhs) (* y = y + c *) + && (DCE.canonCompareLval dest lv2) (* z + n <= y *) + (*&& k = VCV*) + && (ineqHolds aold dest (c -% (maxUnsignedInt(typeOf e))) zeroLv VCV) + (* y + c doesn't overflow *) + then + addLessEq anext z (n +% c) dest k + else if (DCE.canonCompareLval dest lvrhs) (* y = y + c *) + && (DCE.canonCompareLval dest z) (* y + n <= lv2 *) + (*&& k = VCV*) + && (ineqHolds aold dest (c -% (maxUnsignedInt(typeOf e))) zeroLv VCV) + (* y + c doesn't overflow *) + then + addLessEq anext z (n -% c) lv2 k + else + anext) + anext + aold.ineqs + in + if !debug then log "doSet: result = %a\n" d_state anext; + anext + end + with CantDecompose -> + anext + end + +let handleCall = P.handleCall (scrambleMem ~globalsToo:true) + +let fdato : DPF.functionData option ref = ref None +let flowHandleInstr a i = + if !debug then E.log "Doing instr %a in state %a\n" d_instr i d_state a; + match instrToCheck i with + | Some c -> processCheck a c + | None -> begin + match i with + + | Set (lh, e, _) when DCE.canonCompareExp (Lval lh) e -> a + | Set ((Var vi, NoOffset) as dest, e, _) + when isPointerType vi.vtype -> begin + let anext = scrambleVar a vi in + let anext = if isNonNull a e then + addNonNull anext dest + else + anext + in + doSet ~aold:a ~anext dest e + end + | Set ((Var vi, _) as dest, e, _)-> + let anext = scrambleVar a vi in + let anext = if isNonNull a e then + addNonNull anext dest + else + anext + in + doSet ~aold:a ~anext dest e + | Set ((Mem ee, _), _, _)-> + (* FIXME: Is this sound? What if the address of a global is taken + * somewhere and then written through the pointer? *) + scrambleMem a (Some ee) + | Call (Some(Var vi, NoOffset), Lval (Var vf, NoOffset), + [estr; bytes], _) + when (vf.vname = "deputy_findnull") -> begin + if not (isIntegralType vi.vtype) || not (isPointer estr) then + E.s (bug "bad arg to %s\n" vf.vname); + let a = scrambleVar a vi in + addStringlen a vi estr + end + | Call (Some(Var vi, NoOffset), Lval (Var vf, NoOffset), + [estr], _) + when (vf.vname = "strlen") -> begin + if not (isIntegralType vi.vtype) + || ((baseSize (typeOf estr)) <> 1) then + E.s (bug "bad arg to %s\n" vf.vname); + let a = scrambleVar a vi in + addStringlen a vi estr + end + | Call (Some(Var vi, NoOffset), Lval(Var vf, NoOffset),[e1;e2], _) + when vf.vname = "deputy_max" -> begin + let a' = scrambleVar a vi in + doMax a' (Var vi, NoOffset) e1 e2 + end + | Call (Some (Var vi, NoOffset), f, args, _) when isPointerType vi.vtype -> + let a = + if is_deputy_instr i || (!ignore_call) i then + scrambleVar a vi + else + handleCall (!fdato) f args (scrambleVar a vi) + (*scrambleMem ~globalsToo:true (scrambleVar a vi) None*) + in + let rt, _, _, _ = splitFunctionType (typeOf f) in + if isNonnullType rt then + addNonNull a (Var vi, NoOffset) + else + a + | Call (Some lv, f, args, _) -> + let a = + match lv with + | (Var vi, _) -> scrambleVar a vi + | (Mem ee, _) -> scrambleMem a (Some ee) + in + if !ignore_call i || is_deputy_instr i then + a + else + handleCall (!fdato) f args a + | Call (_, f, args, _) -> + if (!ignore_call) i then a else + handleCall (!fdato) f args a + (*scrambleMem ~globalsToo:true a None*) + | Asm (_, _, writes, _, _, _) -> + (* This is a quasi-sound handling of inline assembly *) + let a = scrambleMem a None in + List.fold_left (fun a (_,_,(lh,_)) -> + match lh with Var vi -> scrambleVar a vi + | Mem _ -> a) + a + writes + end + + +module Flow = struct + let name = "DeputyOpt" + let debug = debug + type t = absState + let copy x = x + let stmtStartData = stateMap + let pretty = d_state + let computeFirstPredecessor s a = a + + let combinePredecessors s ~(old:t) newa = + let nnv = List.filter + (fun (lv,_) -> isNonNull' newa lv) + old.nonNullLvals + in + let sv = List.filter + (fun x -> List.mem x newa.strlenVars) + old.strlenVars + in + let ie = List.filter + (fun ((lv1, c, lv2, _, k) as x) -> + (* Make sure newa contains something at least as strong as x *) + (List.memq x newa.ineqs) (* for performance *) + || (ineqHolds newa lv1 c lv2 k)) + old.ineqs + in + let ps = List.filter + (fun dl -> hasPred newa (List.map (fun (e,i,_) -> (e,i)) dl)) + old.preds + in + let ci = List.filter + (fun x -> List.mem x newa.canIncrement) + old.canIncrement + in + if (List.length nnv <> List.length old.nonNullLvals) + || (List.length sv <> List.length old.strlenVars) + || (List.length ie <> List.length old.ineqs) + || (List.length ps <> List.length old.preds) + || (List.length ci <> List.length old.canIncrement) then + Some {nonNullLvals = nnv; strlenVars = sv; ineqs = ie; preds = ps; canIncrement = ci} + else + None (* at fixed point *) + + let doInstr i a = +(* log "Visiting %a State is %a.\n" dn_instr i d_state a; *) + DF.Done (flowHandleInstr a i) + + let doStmt s a = + curStmt := s.sid; + DF.SDefault + + let doGuard e a = + if isFalse a e then DF.GUnreachable + else DF.GUse (doBranch a e) + + let filterStmt s = true +end + +module FlowEngine = DF.ForwardsDataFlow (Flow) + +(* a single term in a.preds precludes every case in djs *) +let predDisjNotSelected (a : absState) (djs : exp) = + let djs = mkAddablePred djs in + List.exists (fun adjs -> + not(List.exists (fun (e,i,_) -> + List.exists (fun (e',i') -> + i = i' && DCE.canonCompareExp e e') djs) adjs)) a.preds + +let flowOptimizeCheck (c: check) ((inState, acc):(absState * check list)) + : (absState * check list) = + let isNonNull = isNonNull inState in + (* Returns true if CPtrArith(lo, hi, p, Lval x, sz) can be optimized away:*) + let checkPtrArith lo hi p e : bool = + let e' = BinOp(PlusPI,p,e,typeOf p) in + (*(fst (doExpLeq e' (kinteger64 IUInt (maxUnsignedInt(typeOf e'))) inState)) &&*) + (fst (doExpLeq lo e' inState)) && + (fst (doExpLeq e' hi inState)) + in + (* Returns true if CPtrArithAccess(lo, hi, p, Lval x, sz) can be optimized away:*) + let checkPtrArithAccess lo hi p e : bool = + let e' = BinOp(PlusPI,p,e,typeOf p) in + (*(fst (doExpLeq e' (kinteger64 IUInt (maxUnsignedInt(typeOf e'))) inState)) &&*) + (fst (doExpLeq lo e' inState)) && + (fst (doExpLeq (BinOp(PlusPI,p,BinOp(PlusA,e,one,typeOf e),typeOf p)) hi inState)) + in + (* Returns true if CLeq(e1, e2) can be optimized away:*) + let checkLeq e1 e2 : bool = + fst (doExpLeq e1 e2 inState) + in + + (* doOpt is called recursivly if we simplify the check to a different check + that has its own optimization rule. + It returns the simplified check, or None if we satisfied the check + completely.*) + let rec doOpt (c : check) : check option = + match c with + | CNonNull e1 when isNonNull e1 -> + None + | CNonNull e1 when isZero e1 -> + error "non-null check will always fail."; + Some c + | CNullOrLeq (e1, _, _, why) + | CNullOrLeqNT (e1, _, _, _, why) when isZero e1 -> + None + | CNullOrLeq (e1, e2, e3, why) when isNonNull e1 -> + doOpt (CLeq(e2, e3, why)) + | CNullOrLeqNT (e1, e2, e3, e4, why) when isNonNull e1 -> + let c' = CLeqNT(e2, e3, e4, why) in + doOpt c' + | CPtrArithAccess (lo, hi, p, e, sz) when checkPtrArithAccess lo hi p e -> + None + | CPtrArith (lo, hi, p, e, sz) + | CPtrArithNT (lo, hi, p, e, sz) when checkPtrArith lo hi p e -> + None + | CPtrArithNT (_, _, Lval p, e, _) when canIncrement inState p e -> + None + | CLeq (e1, e2, _) + | CNullOrLeq (_, e1, e2, _) + | CNullOrLeqNT (_, e1, e2, _, _) when checkLeq e1 e2 -> + None + | CLeq(e1, e2, why) when isZero e2 && isNonNull e1 && + not (isSignedType (typeOf e1)) -> + deputyFail c; + Some c + | CEq (e1, e2, why, _) when isZero e2 && isNonNull e1 -> begin + deputyFail c; + Some c + end + | CLeqNT (e1, e2, sz, why) -> begin + match hasStringlen inState e2 with + Some len -> + let e2' = BinOp(PlusPI, e2, len, typeOf e2) in + (* len == strlen(e2). So rewrite the check as e1 <= e2+len *) + (* This will often be optimized away completely + by a later pass, since e1 often equals e2' *) + doOpt (CLeq(e1, e2', why)) + | None -> Some c + end + | CLeqInt (e1, (BinOp (MinusPP, hi, p, _)), _) -> + let e' = BinOp(PlusPI, p, e1, (typeOf p)) in + if checkLeq e' hi then + None + else + Some c + | CSelected e -> + if onlyDisjEqTests e && hasPred inState (mkAddablePred e) + then None + else Some c + | CNotSelected e -> + if (onlyDisjEqTests e && predDisjNotSelected inState e) + then None + else Some c + | _ -> Some c + in + let acc' = match doOpt c with + Some c -> c::acc | None -> acc + in + (processCheck inState c), acc' + + +(* returns the largest prefix of l such that each + * element of the prefix satisfies p *) +let prefix p l = + let rec helper p l seen = + match l with + | [] -> (List.rev seen, []) + | x :: rst -> begin + if p x + then helper p rst (x::seen) + else (List.rev seen, x :: rst) + end + in + helper p l [] + + +class flowOptimizeVisitor tryReverse = object (self) + inherit nopCilVisitor + + val mutable curSid = -1 + + method vstmt s = + (* now that checks and instructions can be mixed, + * the state has to be changed when an instruction is + * visited *) + let rec filterIl state il fl = + match il with + | [] -> List.rev fl + | i::rest -> begin + (* Make sure to update the location for checkToInstr's use. *) + currentLoc := get_instrLoc i; + let new_state = flowHandleInstr state i in + if !debug then log "state after %a is %a\n" d_instr i d_state new_state; + match instrToCheck i with + | Some c -> begin + let _, c' = flowOptimizeCheck c (state,[]) in + match c' with + | [] -> begin + if !debug then ignore(E.log "fOV: in state %a, optimized %a out\n" + d_state state d_instr i); + filterIl new_state rest fl + end + | [nc] -> begin + let i' = checkToInstr nc in + if !debug then ignore(E.log "fOV: changed to %a\n" d_instr i'); + filterIl new_state rest (i'::fl) + end + | _ -> begin + if !debug then ignore(E.log "fOV: didn't remove %a\n" d_instr i); + filterIl new_state rest (i::fl) + end + end + | None -> filterIl new_state rest (i::fl) + end + in + begin + try + curSid <- s.sid; + let state = IH.find stateMap s.sid in + if !debug then + E.log "Optimizing statement %a with state %a\n" d_stmt s d_state state; + begin + match s.skind with + (* Don't remove explicit programmer checks. There might be + special error handling + | If(e, blk1, blk2, l) when isNonNull state e -> + if hasALabel blk2 then + s.skind <- If(Cil.one, blk1, blk2, l) + else + (* blk2 is unreachable *) + s.skind <- Block blk1 + | If(e, blk1, blk2, l) when isFalse state e -> + if hasALabel blk1 then + s.skind <- If(Cil.zero, blk1, blk2, l) + else + (* blk1 is unreachable *) + s.skind <- Block blk2*) + | Instr il -> + if tryReverse then + let il' = filterIl state il [] in + let (pre, rst) = prefix is_check_instr il' in + let il'' = filterIl state (List.rev pre) [] in + s.skind <- Instr((List.rev il'')@rst) + else + s.skind <- Instr(filterIl state il []) + | _ -> () + end + with Not_found -> () (* stmt is unreachable *) + end; + DoChildren + + method vfunc fd = + curFunc := fd; + let cleanup x = + curFunc := dummyFunDec; + x + in + ChangeDoChildrenPost (fd, cleanup) + +end + +let addNonNullLocals (fd : fundec) (a : absState) : absState = + let nnls = List.filter (fun vi -> + match vi.vtype with + | TArray _ -> true + | _ -> false) fd.slocals + in + let nnlvals = List.map (fun vi -> + let lv = (Var vi, NoOffset) in + let refd = Dutil.varsOfExp (Lval lv) in + (Var vi, NoOffset), refd) nnls + in + { a with nonNullLvals = nnlvals } + +class switchFinderClass (br : bool ref) = object(self) + inherit nopCilVisitor + + method vstmt (s : stmt) = + match s.skind with + | Switch _ -> + br := true; + SkipChildren + | _ -> DoChildren + +end + +let funHasSwitch (fd : fundec) : bool = + let br = ref false in + ignore(visitCilFunction (new switchFinderClass br) fd); + !br + +class cSelectedFinderClass (br : bool ref) = object(self) + inherit nopCilVisitor + + method vinst (i : instr) = + match instrToCheck i with + | Some(CNotSelected _) + | Some(CSelected _) -> + br := true; + SkipChildren + | _ -> DoChildren + +end + +let funHasCSelected (fd : fundec) : bool = + let br = ref false in + ignore(visitCilFunction (new cSelectedFinderClass br) fd); + !br + +(** flow-sensitive optimizer for nonnull, strlen, and inequalities*) +let doFlowAnalysis ?(tryReverse:bool=false) + (fd:fundec) + (fdat : DPF.functionData) + : unit + = + try + IH.clear stateMap; + if funHasSwitch fd && funHasCSelected fd then begin + prepareCFG fd; + Cfg.clearCFGinfo fd; + ignore (Cfg.cfgFun fd) + end; + let fst = List.hd fd.sbody.bstmts in + let t = addNonNullLocals fd top in + let precs = + match IH.tryfind fdat.DPF.fdPCHash fd.svar.vid with + | None -> [] + | Some cl -> cl + in + let t = List.fold_left flowHandleInstr t precs in + IH.add stateMap fst.sid t; + FlowEngine.compute [fst]; + if !debug then + E.log "%s: finished analysis; starting optimizations.\n" Flow.name; + ignore (visitCilFunction (new flowOptimizeVisitor tryReverse) fd); + IH.clear stateMap; + curStmt := -1; + () + with Failure "hd" -> () + + +class nonNullReturnCheckerClass (br : bool ref) = object(self) + inherit nopCilVisitor + + method vstmt s = + match s.skind with + | Return(eo, _) -> begin + match eo with + | None -> begin + br := false; + SkipChildren + end + | Some e -> begin + match IH.tryfind stateMap s.sid with + | None -> begin + br := false; + SkipChildren + end + | Some state -> begin + br := (!br) && isNonNull state e; + DoChildren + end + end + end + | _ -> DoChildren +end + + +let isReturnNonNull (fvar : varinfo) (f : file) : bool = + try + let fdg = List.find (fun g -> match g with + | GFun(fd, _ ) -> fd.svar.vname = fvar.vname + | _ -> false) f.globals + in + match fdg with + | GFun(fd, _) -> begin + IH.clear stateMap; + let fst = List.hd fd.sbody.bstmts in + IH.add stateMap fst.sid top; + FlowEngine.compute [fst]; + let br = ref true in + ignore(visitCilFunction (new nonNullReturnCheckerClass br) fd); + IH.clear stateMap; + curStmt := -1; + !br + end + | _ -> false + with + | Failure "hd" -> false + | Not_found -> false + + + +let reportStats () = () diff --git a/src/optimizer/dfwdsubst.ml b/src/optimizer/dfwdsubst.ml new file mode 100644 index 0000000..bc846c4 --- /dev/null +++ b/src/optimizer/dfwdsubst.ml @@ -0,0 +1,403 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * dfwdsubst.ml + * + * The visitor below symbolically evaluates expressions + * inside of checks for easy consumption by the other + * passes. + * + *) + +open Cil +open Pretty +open Dutil +open Dcheckdef +open Doptimutil + +module E = Errormsg +module AE = Availexps +module AELV = Availexpslv +module UD = Usedef +module RCT = Rmciltmps +module S = Stats +module IH = Inthash + +module DFI = Dflowinsens + +let doTime = ref false + +let time s f a = + if !doTime then + S.time s f a + else f a + +(* First, some things for handling funkyness created by the composition + * of CIL transformations and Deputy transormations in regards to + * temporaries created for function calls. This will make reducing the + * number of remaining temps(and even some checks) easier. *) + +(* Type for the form of temporary variable names *) +type nameform = Suffix of string | Prefix of string | Exact of string + +(* check if a name matches a form *) +(* string -> nameform -> bool *) +let check_form s f = + match f with + Suffix sfx -> + let frmlen = String.length sfx in + let slen = String.length s in + slen >= frmlen && + compare (String.sub s (slen - frmlen) frmlen) sfx = 0 + | Prefix pfx -> + let frmlen = String.length pfx in + String.length s >= frmlen && + compare (String.sub s 0 frmlen) pfx = 0 + | Exact ext -> + let frmlen = String.length ext in + String.length s = frmlen && + compare s ext = 0 + +(* check a name against a list of forms + if it matches any then return true *) +(* string -> nameform list -> bool *) +let inTmpForm s fl = + List.fold_left (fun b f -> b || check_form s f) + false fl + +let tmpForms = [Exact "tmp"; + Prefix "tmp___"; + Prefix "__cil_tmp"; + Suffix "__e"; + Suffix "__b";] + + + +(* This will clean up the CIL a bit so that + the forward substitution can do a better job *) +(* If we see: + tmp = f(...); + notatemp = tmp; + then replace with: + notatemp = f(...); + tmp = notatemp; + *) +class symEvalPrePass (fd : fundec) = object(self) + inherit nopCilVisitor + + method private procIl il = + let rec helper il seen = match il with + | [] -> List.rev seen + | [x] -> List.rev (x::seen) + | i1::i2::rest -> begin + match i1, i2 with + | Call(Some(Var rvi, NoOffset), flv, el, l), + Set((Var vi', NoOffset), Lval(Var rvi', NoOffset),l') + when inTmpForm rvi.vname tmpForms && not(inTmpForm vi'.vname tmpForms) + && rvi'.vid = rvi.vid + -> begin + + if !debug then ignore(E.log "Merging Instructions %a and %a\n" + d_instr i1 d_instr i2); + let new1 = Call(Some(Var vi',NoOffset),flv,el,l) in + let new2 = Set((Var rvi,NoOffset),Lval(Var vi',NoOffset),l') in + helper rest (new2::new1::seen) + end + | Set((Var vi1, NoOffset), Lval(Var vir1, NoOffset), l1), + Set((Var vi2, NoOffset), Lval(Var vir2, NoOffset), ll2) + when inTmpForm vi1.vname tmpForms && + inTmpForm vir1.vname tmpForms && + vir1.vid = vir2.vid && + not(inTmpForm vi2.vname tmpForms) -> begin + match seen with + | [] -> helper rest (i1::i2::seen) + | i3 :: seen -> (* backtrack and try again *) + helper (i3 :: i2 :: i1 :: rest) seen + end + | _, _ -> begin + helper (i2::rest) (i1::seen) + end + end + in + helper il [] + + method private procStmt s = + match s.skind with + | Instr il -> begin + s.skind <- Instr(self#procIl il); + s + end + | _ -> s + + method private processStmts sl = + let rec helper sl seen = match sl with + | [] -> List.rev seen + | [x] -> List.rev ((self#procStmt x)::seen) + | s1::s2::rest -> begin + match s1.skind, s2.skind with + | Instr il1, Instr il2 when s1.labels = [] && s2.labels = [] -> begin + s1.skind <- Instr(il1 @ il2); + helper (s1 :: rest) seen + end + | Instr il1, Instr il2 when il1 <> [] && il2 <> [] -> begin + (* get the last instr in il1 and the first in il2 *) + let i1 = List.hd (List.rev il1) in + let il1' = List.tl (List.rev il1) in + let i2 = List.hd il2 in + let il2' = List.tl il2 in + match i1, i2 with + | Call(Some(Var rvi, NoOffset), flv, el, l), + Set((Var vi',NoOffset),Lval(Var rvi',NoOffset),l') + when inTmpForm rvi.vname tmpForms && not(inTmpForm vi'.vname tmpForms) + && rvi'.vid = rvi.vid + -> begin + + if !debug then ignore(E.log "Merging Stmts %a and %a\n" d_stmt s1 d_stmt s2); + let newi1 = Call(Some(Var vi',NoOffset),flv,el,l) in + let newi2 = Set((Var rvi,NoOffset),Lval(Var vi',NoOffset),l') in + let new1 = Instr (List.rev (newi1::il1')) in + let new2 = Instr (newi2::il2') in + s1.skind <- new1; + s2.skind <- new2; + helper rest ((self#procStmt s2)::(self#procStmt s1)::seen) + end + | Set((Var vi1, NoOffset), Lval(Var vir1, NoOffset), l1), + Set((Var vi2, NoOffset), Lval(Var vir2, NoOffset), l2) + when inTmpForm vi1.vname tmpForms && + inTmpForm vir1.vname tmpForms && + vir1.vid = vir2.vid && + not(inTmpForm vi2.vname tmpForms) + -> begin + match seen with + | [] -> begin + s1.skind <- Instr (List.rev (i2::il1')); + s2.skind <- Instr (i1::il2'); + helper rest ((self#procStmt s2)::(self#procStmt s1)::seen) + end + | s3 :: seen -> begin (* backtrack and try again *) + s1.skind <- Instr (List.rev (i2::il1')); + s2.skind <- Instr (i1::il2'); + if !debug then ignore(E.log "backtrack: %a\n%a\n" d_stmt s3 d_stmt s1); + helper (s3 :: s1 :: s2 :: rest) seen + end + end + | _, _ -> helper (s2 :: rest) ((self#procStmt s1) :: seen) + end + | _, Instr [] when s2.labels = [] -> + (* dump empty statements having no labels *) + helper (s1::rest) seen + | _, _ -> begin + helper (s2::rest) ((self#procStmt s1)::seen) + end + end + in + helper sl [] + + (* Cil.constFold doesn't bother getting rid of addition of zero when + the result type is a pointer, so handle that here *) + method vexpr e = + 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 + match e with + | BinOp(bop,e1,e2,typ) -> begin + match bop, mkInt e1, mkInt e2 with + | PlusA, Const(CInt64(z,_,_)), e2 when z = Int64.zero -> ChangeTo(e2) + | PlusA, e1, Const(CInt64(z,_,_)) when z = Int64.zero -> ChangeTo(e1) + | PlusPI, e1, Const(CInt64(z,_,_)) when z = Int64.zero -> ChangeTo(e1) + | IndexPI, e1, Const(CInt64(z,_,_)) when z = Int64.zero -> ChangeTo(e1) + | MinusPI, e1, Const(CInt64(z,_,_)) when z = Int64.zero -> ChangeTo(e1) + | _,_,_ -> DoChildren + end + | _ -> DoChildren + + method vblock b = + b.bstmts <- self#processStmts b.bstmts; + DoChildren + +end + +let preFwdSubst (fd : fundec) = + visitCilFunction (new symEvalPrePass fd) fd + + +(* Here follows the actual forward substitution transformaction. + This currently uses some code in rmciltmps, but that code + isn't really general purpose anymore, and should move here. *) + +let can_elim_check c = + match DFI.optimizeCheck ~supErr:true c with + [] -> true + | _ -> false + +let checkVisit_change = ref true + +let checkAEVisit action (fd : fundec) = object(self) + inherit AE.aeVisitorClass as super + + method private do_action b e = + match self#get_cur_eh() with + None -> e + | Some eh -> + let e', b' = action eh sid e fd b in + if b' then checkVisit_change := true; + e' + + method private fix_check = + let fold_act e = constFold true (self#do_action true e) in + map_to_check ~cond:can_elim_check fold_act + + method vexpr e = + ChangeTo (self#do_action false e) + + method vinst i = + let action = super#vinst i in + if action <> DoChildren then + E.s (bug "Expected DoChildren"); + match instrToCheck i with + | Some c -> + let c' = time "handle checks" self#fix_check c in + ChangeTo [checkToInstr c'] + | None -> begin + (* see if it's a deputy function *) + if not (is_deputy_fun i) then + DoChildren + else match i with + | Call(lvo,lv,el,l) -> + let el = List.map (self#do_action true) el in + ChangeTo [Call(lvo,lv,el,l)] + | _ -> DoChildren + end + + method vfunc fd = + time "available expressions" AE.computeAEs fd; + curFunc := fd; + let cleanup x = + curFunc := dummyFunDec; + x + in + ChangeDoChildrenPost (fd, cleanup) + +end + +let checkAELVVisit action (fd : fundec) = object(self) + inherit AELV.aeVisitorClass as super + + method private do_action b e = + match self#get_cur_eh() with + None -> e + | Some eh -> + let e', b' = action eh sid e fd b in + if b' then checkVisit_change := true; + e' + + method private fix_check = + let fold_act e = constFold true (self#do_action true e) in + map_to_check ~cond:can_elim_check fold_act + + method vexpr e = + ChangeTo (self#do_action false e) + + method vinst i = + let action = super#vinst i in + if action <> DoChildren then + E.s (bug "Expected DoChildren"); + match instrToCheck i with + | Some c -> + let c' = time "handle checks" self#fix_check c in + ChangeTo [checkToInstr c'] + | None -> begin + (* see if it's a deputy function *) + if not (is_deputy_fun i) then + DoChildren + else match i with + | Call(lvo,lv,el,l) -> + let el = List.map (self#do_action true) el in + ChangeTo [Call(lvo,lv,el,l)] + | _ -> DoChildren + end + + method vfunc fd = + if !debug then ignore(E.log "Computing AELV for %s\n" fd.svar.vname); + time "available expressions" AELV.computeAEs fd; + curFunc := fd; + let cleanup x = + curFunc := dummyFunDec; + x + in + ChangeDoChildrenPost (fd, cleanup) + +end + +(* applies the action to the function until + no changes are made, or lim is reached *) +(* action: 'a -> sid -> exp -> fundec -> bool -> exp * bool *) +(* action -> int -> fundec -> unit *) +let fp cls action lim fd = + let vis = cls action fd in + let i = ref 0 in + checkVisit_change := true; + while !i < lim && !checkVisit_change do + if !debug then ignore(E.log "fp: in while loop\n"); + checkVisit_change := false; + ignore(visitCilFunction (vis :> cilVisitor) fd); + i := !i + 1; + done + + +let forwardTmpSub (fd : fundec) = + ignore(preFwdSubst fd); + fp checkAELVVisit RCT.ae_lv_fwd_subst 4 fd; + ignore(preFwdSubst fd) + +(*let forwardTmpSub = fp checkAEVisit RCT.ae_fwd_subst 4*) + +(* Constant propagation into checks. This is probably useless. *) +let constProp = fp checkAEVisit RCT.ae_const_prop 4 + + + + diff --git a/src/optimizer/dloopoptim.ml b/src/optimizer/dloopoptim.ml new file mode 100644 index 0000000..7b23b23 --- /dev/null +++ b/src/optimizer/dloopoptim.ml @@ -0,0 +1,482 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * dloopoptim.ml + * + * Move loop invariant checks out + * of loops. + * + * TODO: identify loop induction variables and move bounds + * checks on each iteration to one check before the loop. + *) + +open Cil +open Expcompare +open Pretty +open Dutil +open Dcheckdef +open Doptimutil + + +module E = Errormsg +module IH = Inthash +module RD = Reachingdefs +module AE = Availexps +module AELV = Availexpslv +module RCT = Rmciltmps +module UD = Usedef +module S = Stats + + +(* stm -> UD.VS.t *) +let find_varying loop_stm = + let _, d = UD.computeDeepUseDefStmtKind loop_stm.skind in + d + +(* for visiting a block to determine whether it contains + * a write to memory or a function call *) +class writeOrCallFinderClass br = object(self) + inherit nopCilVisitor + method vinst i = + if is_deputy_instr i then SkipChildren else + match i with + Set((Mem _,_),_,_) -> + br := true; + DoChildren + | Call(_,_,_,_) -> + br := true; + DoChildren + | Asm(_,_,_,_,_,_) -> (* Not precisely... *) + br := true; + DoChildren + | _ -> DoChildren +end + +let writeOrCallFinder = new writeOrCallFinderClass + +(* block -> bool *) +let block_has_write_or_call b = + let br = ref false in + let vis = new writeOrCallFinderClass br in + ignore(visitCilBlock vis b); + !br + +(* UD.VS.t -> fundec -> UD.VS.t *) +let add_globs_addrs vvs fd = + List.fold_left (fun vvs' vi -> + if vi.vglob || vi.vaddrof + then UD.VS.add vi vvs' + else vvs') vvs (fd.sformals@fd.slocals) + +(* check -> bool *) +let check_has_mem_read c = + test_check AELV.exp_has_mem_read c + +(* the argument b is the body of a Loop *) +(* returns the loop termination condition along with + * the checks that must preceed its evaluation *) +(* block -> (exp option * instr list) *) +let get_loop_condition b = + let isListOfChecks = + List.fold_left (fun b i -> + b && (is_check_instr i)) + true + in + (* returns the first non-empty, non-check + * statement of a statement list along with + * the list of checks that were seen *) + (* stm list -> stm list * instr list *) + let rec skipEmpty = function + [] -> [], [] + | {skind = Instr []; labels = []}::rest -> + skipEmpty rest + | ({skind = Instr il; labels = []} as s)::rest -> + if isListOfChecks il + then let sl,il' = skipEmpty rest in + sl, il@il' + else let sl, _ = skipEmpty rest in + s::sl, [] + | x -> x, [] + in + (* stm -> exp option * instr list *) + let rec get_cond_from_if if_stm = + match if_stm.skind with + If(e,tb,fb,_) -> + let e = stripNopCasts e in + RCT.fold_blocks tb; + RCT.fold_blocks fb; + let tsl, tcil = skipEmpty tb.bstmts in + let fsl, fcil = skipEmpty fb.bstmts in + (match tsl, fsl with + {skind = Break _} :: _, [] -> Some e, tcil + | [], {skind = Break _} :: _ -> + Some(UnOp(LNot, e, intType)), fcil + | ({skind = If(_,_,_,_)} as s) :: _, [] -> + let teo, tcil' = get_cond_from_if s in + (match teo with + None -> None, [] + | Some te -> + Some(BinOp(LAnd,e,stripNopCasts te,intType)), tcil@tcil') + | [], ({skind = If(_,_,_,_)} as s) :: _ -> + let feo, fcil' = get_cond_from_if s in + (match feo with + None -> None, [] + | Some fe -> + Some(BinOp(LAnd,UnOp(LNot,e,intType), + stripNopCasts fe,intType)), fcil@fcil') + | {skind = Break _} :: _, ({skind = If(_,_,_,_)} as s):: _ -> + let feo,fcil' = get_cond_from_if s in + (match feo with + None -> None, [] + | Some fe -> + Some(BinOp(LOr,e,stripNopCasts fe,intType)), fcil@fcil') + | ({skind = If(_,_,_,_)} as s) :: _, {skind = Break _} :: _ -> + let teo, tcil' = get_cond_from_if s in + (match teo with + None -> None, [] + | Some te -> + Some(BinOp(LOr,UnOp(LNot,e,intType), + stripNopCasts te,intType)), tcil@tcil') + | ({skind = If(_,_,_,_)} as ts) :: _ , ({skind = If(_,_,_,_)} as fs) :: _ -> + let teo, tcil' = get_cond_from_if ts in + let feo, fcil' = get_cond_from_if fs in + (match teo, feo with + Some te, Some fe -> + Some(BinOp(LOr,BinOp(LAnd,e,stripNopCasts te,intType), + BinOp(LAnd,UnOp(LNot,e,intType), + stripNopCasts fe,intType),intType)), + tcil@fcil@tcil'@fcil' + | _,_ -> None, []) + | _, _ -> (if !debug then ignore(E.log "checkMover: branches of %a not good\n" + d_stmt if_stm); + None, [])) + | _ -> (if !debug then ignore(E.log "checkMover: %a not an if\n" d_stmt if_stm); + None, []) + in + let sl, cil = skipEmpty b.bstmts in + match sl with + ({skind = If(_,_,_,_)} as s) :: _ -> + let eo, cil' = get_cond_from_if s in + eo, cil@cil' + | s :: _ -> + (if !debug then ignore(E.log "checkMover: %a is first, not an if\n" + d_stmt s); + None, []) + | [] -> + (if !debug then ignore(E.log "checkMover: no statements in loop block?\n"); + None, []) + +(* UD.VS.t -> check -> bool *) +let check_has_varying_var vvs c = + UD.VS.fold (fun vi b -> + b || test_check (AELV.exp_has_vi vi) c) + vvs false + +(* if the instruction is deputy_findnull or + * deputy_max, then if the arguments + * are loop invariant and there is no + * other definition of vi reaching i, then + * the instruction can be lifted out of the + * loop *) +let can_lift_instr i vvs mw iosh = + let bad_args el = + List.fold_left (fun b e -> + b || (UD.VS.fold (fun vi b -> + b || (AELV.exp_has_vi vi e) || + (mw && AELV.exp_has_mem_read e)) vvs false)) + false el + in + let check_def vi = + if IH.mem iosh vi.vid then + let ios = IH.find iosh vi.vid in + if not(RD.IOS.cardinal ios = 2) then + (if !debug then ignore(E.log "checkMover: %d defs reach\n" (RD.IOS.cardinal ios)); + false) + else match RD.IOS.elements ios with + [io1;io2] -> (match io1,io2 with + Some did, None | + None, Some did -> RD.isDefInstr i did + | Some d1, Some d2 -> + (if !debug then ignore(E.log "checkMover: more than one real def reaches %d %d\n" d1 d2); + false) + | _ -> false) + | _ -> (if !debug then ignore(E.log "checkMover: impossible\n"); + false) + else (if !debug then ignore(E.log "checkMover: %s not in iosh\n" vi.vname); + false) + in + match i with + Call(Some(Var vi,NoOffset),Lval(Var vf,NoOffset),el,_) -> + if (vf.vname = "deputy_findnull" || vf.vname = "deputy_max") + then if bad_args el + then (if !debug then ignore(E.log "checkMover: has varying arg %a\n" d_instr i); + false) + else if check_def vi + then (if !debug then ignore(E.log "checkMover: can be moved %a\n" d_instr i); + true) + else (if !debug then ignore(E.log "checkMover: had bad def %a\n" d_instr i); + false) + else false + | _ -> false + +(* remove and return a list of check instructions + * not containing things in vvs and not having + * memory reads when mw is true. + *) +(* UD.VS.t -> bool -> (instr * rddat) list -> instr list * instr list *) +let filter_instr_list vvs mw ildl = + let gir, rir = List.fold_left + (fun (gi,ri) (i,(u,s,iosh)) -> match instrToCheck i with + None -> if can_lift_instr i vvs mw iosh + then (gi,i::ri) + else (i::gi,ri) + | Some c -> + (if check_has_varying_var vvs c + then (if !debug then ignore(E.log "checkMover: has varying var %a\n" d_instr i); + (i::gi,ri)) + else if mw && check_has_mem_read c + then (if !debug then ignore(E.log "checkMover: has memory read %a\n" d_instr i); + (i::gi,ri)) + else (if !debug then ignore(E.log "checkMover: can be moved %a\n" d_instr i); + (gi, i::ri)))) + ([],[]) + ildl + in + List.rev gir, List.rev rir + +(* remove loop invariant checks from the block, + * return a list of checks along with the + * expression that must guard them *) +(* block -> UD.VS.t -> int -> (exp,instr list) list *) +let rec filter_and_collect_checks b vvs sid = + let mw = block_has_write_or_call b in + List.fold_left (fun cl s -> + match s.skind with + Block b' -> cl@(filter_and_collect_checks b' vvs s.sid) + | If(e,tb,fb,_) -> + (* see if e is loop invariant *) + let aedato = AELV.getAEs s.sid in + (match aedato with None -> cl | Some aedat -> + let e',_ = RCT.ae_lv_simp_fwd_subst aedat e true in + let e' = stripNopCasts e' in + if (UD.VS.exists (fun vi -> AELV.exp_has_vi vi e') vvs) || + (mw && AELV.exp_has_mem_read e) then cl (* can't move *) + else let tgcl = filter_and_collect_checks tb vvs s.sid in + let fgcl = filter_and_collect_checks fb vvs s.sid in + let tgcl' = List.map (fun (g,cl) -> + if DCE.canonCompareExp(*StripCasts*) g one + then (e',cl) + else if DCE.canonCompareExp(*StripCasts*) g e' + then (e',cl) + else (BinOp(LAnd,e',g,intType),cl)) tgcl in + let fgcl' = List.map (fun (g,cl) -> + if DCE.canonCompareExp(*StripCasts*) g one + then (UnOp(LNot,e',intType),cl) + else (BinOp(LAnd,UnOp(LNot,e',intType),g,intType),cl)) + fgcl in + cl@tgcl'@fgcl') + | Instr il -> + (match RD.getRDs s.sid with None -> cl | Some(_,x,iosh) -> + let rd_dat_lst = RD.instrRDs il s.sid ((),x,iosh) false in + let il_dat_lst = List.combine il rd_dat_lst in + let gi, ri = filter_instr_list vvs mw il_dat_lst in + if !debug then ignore(E.log "checkMover: after filter to move %d\n" + (List.length ri)); + s.skind <- Instr gi; + cl@[(one ,ri)]) + | _ -> cl) [] b.bstmts + +(* exp -> exp * instr list -> stmt option *) +let eil_to_if_stmt cond (e,il) = + match il with + [] -> (if !debug then ignore(E.log "checkMover: no checks to make\n"); + None) + | _ -> + let ifblk = mkBlock [mkStmt(Instr il)] in + if DCE.canonCompareExp(*StripCasts*) e one || + DCE.canonCompareExp(*StripCasts*) e cond + then (if !debug then ignore(E.log "checkMover: need check %a\n" d_block ifblk); + Some(mkStmt (Block ifblk))) + else if DCE.canonCompareExp(*StripCasts*) e zero + then (if !debug then ignore(E.log "checkMover: checks never made\n"); + None) + else (if !debug then ignore(E.log "checkMover: need checks %a\n" d_block ifblk); + Some(mkStmt (If(e,ifblk,mkBlock [],locUnknown)))) + +(* stmt option list -> stmt list *) +let rec filter_sol sol = + match sol with [] -> [] | + so :: rest -> match so with + None -> filter_sol rest + | Some s -> s :: (filter_sol rest) + +(* return an If statement that does + * the invariant checks if the condition is true. *) +(* instr list -> (exp, instr list) list -> exp -> stmt -> stmt option *) +let make_pre_header cil gcl cond loop_stm = + let if_stmo_lst = List.map (eil_to_if_stmt cond) gcl in + let if_stm_lst = filter_sol if_stmo_lst in + match if_stm_lst with [] -> None | _ -> + let preheader_checks = mkStmt (Instr cil) in + let preheader_if = mkStmt (If(cond, mkBlock if_stm_lst, + mkBlock [], locUnknown)) in + let preheader_block = mkBlock [preheader_checks; + preheader_if] in + let preheader_stm = mkStmt (Block preheader_block) in + Some preheader_stm + +let check_moved = ref false +class loopInvCheckMoverClass fd = object(self) + inherit nopCilVisitor + + val mutable cur_block = ref {bstmts = []; battrs = []} + + method vstmt s = match s.skind with + Loop(b,_,_,_) -> + if !debug then ignore(E.log "checkMover: looking at loop statement\n%a\n" d_stmt s); + let vvs = find_varying s in + let vvs = if block_has_write_or_call b + then add_globs_addrs vvs fd else vvs in + RCT.fold_blocks b; + let condo, cil = get_loop_condition b in + (match condo with + None -> + if !debug then ignore(E.log "checkMover: sid %d: no cond\n" s.sid); + DoChildren + | Some cond -> + let cond = UnOp(LNot,cond,intType) in (* Need the opposite of termination cond *) + if !debug then ignore(E.log "checkMover: found condition %a\n" d_exp cond); + let gcl = filter_and_collect_checks b vvs s.sid in + if !debug then ignore(E.log "checkMover: %d checks to move\n" + (List.length gcl)); + match gcl with [] -> DoChildren | _ -> + let pho = make_pre_header cil gcl cond s in + match pho with None -> DoChildren | Some ph -> + check_moved := true; + if !debug then ignore(E.log "checkMover: pre-header=\n%a\n" d_stmt ph); + (* put the new statement in the current + block's statement list before the loop *) + let rec insert_before seen to_insert notseen = + match notseen with [] -> seen + | s'::rest -> if s'.sid = s.sid + then (if !debug then ignore(E.log "checkMover: inserting pre-header\n"); + seen@[to_insert]@notseen) + else insert_before (seen@[s']) to_insert rest + in + (!cur_block).bstmts <- insert_before [] ph (!cur_block).bstmts; + if !debug then ignore(E.log "checkMover: new enclosing block=\n%a\n" d_block (!cur_block)); + DoChildren) + | _ -> DoChildren + + method vblock b = + let old_block = cur_block in + cur_block <- ref b; + let block_restore b' = + cur_block <- old_block; + b + in + ChangeDoChildrenPost(b,block_restore) + + method vfunc fd = + Cfg.clearCFGinfo fd; + ignore (Cfg.cfgFun fd); + AELV.computeAEs fd; + RD.computeRDs fd; + DoChildren + +end + +let loopInvCheckMover fd = + check_moved := true; + while !check_moved do + check_moved := false; + ignore(visitCilFunction (new loopInvCheckMoverClass fd) fd) + done + +class checkMoverCleanupClass = object(self) + inherit nopCilVisitor + + method private is_empty_if s = + match s.skind with + If(_,tb,fb,_) -> + (match tb.bstmts, fb.bstmts with + [],[] -> true + | _,_ -> false) + | _ -> false + + method private if_to_block s = + if self#is_empty_if s + then mkStmt(Block(mkBlock [])) + else s + + method vstmt s = match s.skind with + If(e,tb,fb,l) -> + let aedato = AELV.getAEs s.sid in + (match aedato with None -> DoChildren + | Some aedat -> begin + let e',_ = RCT.ae_lv_simp_fwd_subst aedat e true in + let e'' = stripNopCasts(constFold true e') in + match isInteger e'' with + | Some 0L when not (hasALabel tb) -> (* tb is unreachable *) + s.skind <- Block fb; + DoChildren + | Some n when not (hasALabel fb) + && n <> Int64.zero -> (* fb is unreachable *) + s.skind <- Block tb; + DoChildren + | _ -> (* Both branches reachable *) + s.skind <- If(e'',tb,fb,l); + ChangeDoChildrenPost(s,self#if_to_block) + end) + | _ -> DoChildren + + method vblock b = + RCT.fold_blocks b; + let new_stmts = List.filter (fun s -> + match s.skind with + Instr [] when s.labels = [] -> false + | _ -> true) b.bstmts in + b.bstmts <- new_stmts; + DoChildren + + method vfunc fd = + Cfg.clearCFGinfo fd; + ignore (Cfg.cfgFun fd); + AELV.computeAEs fd; + DoChildren +end + diff --git a/src/optimizer/dnonnullfinder.ml b/src/optimizer/dnonnullfinder.ml new file mode 100644 index 0000000..b3d95ab --- /dev/null +++ b/src/optimizer/dnonnullfinder.ml @@ -0,0 +1,147 @@ +(* + * Find checks on globals and formals at the beginning of functions. + * Also, some utilities for filtering the results. + * + *) + +open Cil +open Pretty +open Dattrs +open Dutil +open Dcheckdef +open Doptimutil + +module F = Frontc +module IH = Inthash +module E = Errormsg +module S = Stats +module DPF = Dprecfinder +module DFS = Dflowsens +module DP = Dpatch + +(* This visitor sets br to true if it finds an lval that is not + * (Var vi, NoOffset) or one where the vi is not in the formal list of fd *) +class nonFormalLvalFinderClass (fvar : varinfo) (br : bool ref) = object(self) + inherit nopCilVisitor + + method vlval lv = match lv with + | (Var vi, NoOffset) -> begin + if vi.vname <> "__LOCATION__" then begin + match fvar.vtype with + | TFun(_, Some args, _, _) -> + br := not(List.exists (fun (s,_,_) -> vi.vname = s) args) + | _ -> () + end; + DoChildren + end + | _ -> begin + br := true; + DoChildren; + end +end + +(* returns true if the instruction refers only to formals of fd *) +let instrOnlyFormals (fvar : varinfo) (i : instr) : bool = + let br = ref false in + let vis = new nonFormalLvalFinderClass fvar br in + match i with + | Call(_, _, el, _) -> begin + List.iter (fun e -> ignore(visitCilExpr vis e)) el; + not !br + end + | _ -> false (* This is impossible *) + + +(* Filter down preconditions to those that are only in terms of formals *) +let precFormalFilter (fdat : DPF.functionData) : unit = + DPF.precFilter instrOnlyFormals fdat + + +let nonNullFilter (fvar : varinfo) (c : instr) : bool = + match instrToCheck c with + | None -> false + | Some c -> begin + match c with + | CNonNull _ -> true + | _ -> false + end + + +(* Filter down preconditions to NonNulls *) +let precNonNullFilter (fdat : DPF.functionData) : unit = + DPF.precFilter nonNullFilter fdat + + +(* returns only the precondition data about the NonNullness of formals *) +let getNonNullPreConditions (fdat : DPF.functionData) (f : file) : unit = + DPF.preConditionFinder fdat f; + precFormalFilter fdat; + precNonNullFilter fdat + + +(* add attributes a to the parameter called name in the type of function fd *) +let addAttrToFormalType (name : string) (a : attributes) (fvar : varinfo) : unit = + match fvar.vtype with + | TFun(ft,args,b,fattrs) -> begin + let rec helper args seen = + match args with + | [] -> List.rev seen + | (n,t,aattr) :: rst -> begin + if n <> name then helper rst ((n,t,aattr)::seen) else + let newtyp = typeAddAttributes a t in + (List.rev seen)@((n,newtyp,aattr)::rst) + end + in + match args with + | None -> () + | Some args -> + fvar.vtype <- TFun(ft, Some(helper args []), b, fattrs) + end + | _ -> () + +let addAttrToReturnType (a : attributes) (fvar : varinfo) : bool = + match fvar.vtype with + | TFun(rt, args, b, fattrs) -> begin + match unrollType rt with + | TPtr(_,_) -> begin + let newrt = typeAddAttributes a rt in + fvar.vtype <- TFun(newrt, args, b, fattrs); + true + end + | _ -> false + end + | _ -> false + + +(* add NONNULL annotations to the types of formals indicated by fdat *) +let addAnnotations (fdat : DPF.functionData) (f : file) : unit = + IH.iter (fun vid cl -> + match IH.tryfind fdat.DPF.fdFnHash vid with + | None -> () (* an error message? *) + | Some (fvar, _) -> begin + + (* Annotate returns *) + if DFS.isReturnNonNull fvar f then begin + (*let (fd, _) = IH.find fdat.DPF.fdFnHash vid in*) + let nattr = [Attr("nonnull",[])] in + let b = addAttrToReturnType nattr fvar in + IH.replace fdat.DPF.fdFnHash vid (fvar, b) + end; + + (* Annotate arguments *) + List.iter (fun c -> + match instrToCheck c with + | Some(CNonNull(Lval(Var vi,NoOffset))) -> begin + let nattr = [Attr("nonnull",[])] in + addAttrToFormalType vi.vname nattr fvar; + IH.replace fdat.DPF.fdFnHash vid (fvar,true) + end + | _ -> () (* impossible *)) cl + + end) fdat.DPF.fdPCHash + + +let addNonNullAnnotations (fdat : DPF.functionData) (f : file) : unit = + getNonNullPreConditions fdat f; + addAnnotations fdat f; + () diff --git a/src/optimizer/doptimmain.ml b/src/optimizer/doptimmain.ml new file mode 100644 index 0000000..77420dd --- /dev/null +++ b/src/optimizer/doptimmain.ml @@ -0,0 +1,358 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * + * doptimmain.ml + * + * This is the interface of the optimizer exposed to Deputy proper. + * + *) + +open Cil +open Pretty +open Doptions +open Dutil +open Dcheckdef + +module E = Errormsg +module AE = Availexps +module AELV = Availexpslv +module RCT = Rmciltmps +module S = Stats + +(* optimizer modules *) +module DFI = Dflowinsens +module DFS = Dflowsens +module DSA = Dfwdsubst +module DDE = Ddupcelim +module DLO = Dloopoptim +module DCS = Dcheckstrengthen +module DOU = Doptimutil +module DCH = Dcheckhoister +module DOA = Doctanalysis +module DPF = Dprecfinder + +(* Determine some properties of the remaining checks *) +class localFinderClass (fd : fundec) br = object(self) + inherit nopCilVisitor + + method vvrbl vi = + let isFormal vi = + List.exists (fun vi' -> vi'.vid = vi.vid) + fd.sformals + in + if not vi.vglob && not (isFormal vi) then br := true; + DoChildren + +end + +class globFormFinderClass (fd : fundec) br = object(self) + inherit nopCilVisitor + + method vvrbl vi = + if vi.vglob then br := true; + DoChildren + +end + +(* returns true if e only refers to globals. *) +let expOnlyGlobalsAndFormals fd e = + let br = ref false in + let vis = new localFinderClass fd br in + ignore(visitCilExpr vis e); + not !br + +let expHasGlobOrForm fd e = + let br = ref false in + let vis = new globFormFinderClass fd br in + ignore(visitCilExpr vis e); + !br + +class checkPropsClass ogcr hgcr = object(self) + inherit nopCilVisitor + + val mutable curFunc = None + + method vinst i = + match instrToCheck i with + | None -> DoChildren + | Some c -> begin + match curFunc with + | Some fd -> begin + let f = expOnlyGlobalsAndFormals fd in + if (DOU.test_check ~comb:(fun a b -> a && b) f c) then + ogcr := !ogcr + 1; + if (DOU.test_check (expHasGlobOrForm fd) c) then + hgcr := !hgcr + 1; + DoChildren + end + | None -> DoChildren + end + + method vfunc f = + curFunc <- (Some f); + DoChildren + +end + +let numGlobalChecks (f : file) = + let ogcount = ref 0 in + let hgcount = ref 0 in + let vis = new checkPropsClass ogcount hgcount in + ignore(visitCilFile vis f); + !ogcount, !hgcount + +class checkCounterClass (cr : int ref) = object(self) + inherit nopCilVisitor + + method vinst i = + match instrToCheck i with + | None -> DoChildren + | Some _ -> begin + incr cr; + DoChildren + end +end + +let countChecks (fd : fundec) : int = + let cr = ref 0 in + let vis = new checkCounterClass cr in + ignore(visitCilFunction vis fd); + !cr + +let recomputeCfg (fd:fundec) : unit = + Cfg.clearCFGinfo fd; + ignore (Cfg.cfgFun fd) + +let optLevel1 (fd:fundec) : unit = + if !verbose then + log "Doing flow-insensitive optimizations.\n"; + recomputeCfg fd; + ignore (visitCilFunction (DFI.optimizeVisitor()) fd); + ignore (visitCilFunction DCS.checkStrengthener fd); + recomputeCfg fd + +let optLevel2 (fd:fundec) (fdat: DPF.functionData) : unit = + if !verbose then + log "Doing some flow-sensitive optimizations.\n"; + recomputeCfg fd; + ignore (visitCilFunction (DFI.optimizeVisitor()) fd); + DFS.doFlowAnalysis fd fdat; + ignore (visitCilFunction (DFI.optimizeVisitor()) fd); + ignore (visitCilFunction DCS.checkStrengthener fd); + recomputeCfg fd + + +let optLevel3 (fd:fundec) (fdat : DPF.functionData) : unit = + if !verbose then + log "Doing one pass of all optimizations:\n"; + recomputeCfg fd; + let cf = constFoldVisitor false in + AE.registerIgnoreInst is_check_instr; + AE.registerIgnoreCall is_deputy_instr; + AE.registerIgnoreCall isLibcNoSideEffects; + AELV.registerIgnoreInst is_check_instr; + AELV.registerIgnoreCall is_deputy_instr; + AELV.registerIgnoreCall isLibcNoSideEffects; + DFS.registerIgnoreCall is_deputy_instr; + DFS.registerIgnoreCall isLibcNoSideEffects; + DCH.registerIgnoreCall isLibcNoSideEffects; + Deadcodeelim.callHasNoSideEffects := is_deputy_fun; + + ignore (S.time "flow-insensitive" + (visitCilFunction (DFI.optimizeVisitor ~supErr:true ())) fd); + + S.time "matts" (DFS.doFlowAnalysis fd) fdat; + + DPF.addChecksAtCallSites fd fdat; + recomputeCfg fd; + S.time "dup-check-elim" (DDE.elim_dup_checks fd) fdat; + + ignore(S.time "check-merge" + (visitCilFunction DCS.checkStrengthener) fd); + + if !findNonNull || !findPreconditions then begin + recomputeCfg fd; + S.time "check-hoist" (DCH.hoistChecks fd) fdat + end; + + recomputeCfg fd; + ignore(S.time "dce" Deadcodeelim.elim_dead_code fd); + + recomputeCfg fd; + S.time "symbol-eval" DSA.forwardTmpSub fd; + ignore(S.time "constant-fold" (visitCilFunction cf) fd); + + recomputeCfg fd; + S.time "symbol-eval" DSA.forwardTmpSub fd; + ignore(S.time "constant-fold" (visitCilFunction cf) fd); + + (* doFlowAnalysis *must* come before the optimizeVisitor + after fwd subst, const prop, and const folding *) + recomputeCfg fd; + S.time "matts" (DFS.doFlowAnalysis ~tryReverse:true fd) fdat; + + ignore(S.time "flow-insensitive" + (visitCilFunction (DFI.optimizeVisitor())) fd); + ignore(S.time "check-merge" + (visitCilFunction DCS.checkStrengthener) fd); + + recomputeCfg fd; + S.time "dup-check-elim" (DDE.elim_dup_checks fd) fdat; + + recomputeCfg fd; + S.time "loopcheck" DLO.loopInvCheckMover fd; + + if !findNonNull || !findPreconditions then begin + recomputeCfg fd; + S.time "check-hoist" (DCH.hoistChecks fd) fdat; + + recomputeCfg fd; + S.time "symbol-eval" DSA.forwardTmpSub fd; + ignore(S.time "constant-fold" (visitCilFunction cf) fd); + recomputeCfg fd; + S.time "check-hoist" (DCH.hoistChecks fd) fdat; + + recomputeCfg fd; + S.time "symbol-eval" DSA.forwardTmpSub fd; + ignore(S.time "constant-fold" (visitCilFunction cf) fd); + recomputeCfg fd; + S.time "check-hoist" (DCH.hoistChecks fd) fdat; + end; + recomputeCfg fd + + + +let optLevel4 (fd: fundec) (fdat : DPF.functionData) : unit = + if (not DOA.real) || !findNonNull || !findPreconditions + then optLevel3 fd fdat else begin + recomputeCfg fd; + let cf = constFoldVisitor false in + AE.registerIgnoreInst is_check_instr; + AE.registerIgnoreCall is_deputy_instr; + AE.registerIgnoreCall isLibcNoSideEffects; + AELV.registerIgnoreInst is_check_instr; + AELV.registerIgnoreCall is_deputy_instr; + AELV.registerIgnoreCall isLibcNoSideEffects; + DFS.registerIgnoreCall is_deputy_instr; + DFS.registerIgnoreCall isLibcNoSideEffects; + DOA.registerIgnoreCall is_deputy_instr; + DOA.registerIgnoreCall isLibcNoSideEffects; + Deadcodeelim.callHasNoSideEffects := is_deputy_fun; + + + (*if fd.svar.vname <> "__deputy_global_initializers" then + ignore(E.log "PreFIChecks %d\n" (countChecks fd));*) + (*ignore (E.log "flow-insensitive\n");*) + ignore (S.time "flow-insensitive" + (visitCilFunction (DFI.optimizeVisitor ~supErr:true ())) fd); + (*if fd.svar.vname <> "__deputy_global_initializers" then + ignore(E.log "PostFIChecks %d\n" (countChecks fd));*) + + (*ignore(E.log "matts\n");*) + S.time "matts" (DFS.doFlowAnalysis fd) fdat; + + DPF.addChecksAtCallSites fd fdat; + recomputeCfg fd; + (*ignore (E.log "dup-check-elim\n");*) + S.time "dup-check-elim" (DDE.elim_dup_checks fd) fdat; + (*ignore (E.log "check-merge\n");*) + ignore(S.time "check-merge" + (visitCilFunction DCS.checkStrengthener) fd); + + recomputeCfg fd; + (*ignore (E.log "dce\n");*) + ignore(S.time "dce" Deadcodeelim.elim_dead_code fd); + + recomputeCfg fd; + (*ignore (E.log "symbol-eval\n");*) + S.time "symbol-eval" DSA.forwardTmpSub fd; + (*ignore (E.log "constant-fold\n");*) + ignore(S.time "constant-fold" (visitCilFunction cf) fd); + + (*ignore (E.log "matts\n");*) + S.time "matts" (DFS.doFlowAnalysis ~tryReverse:true fd) fdat; + (*ignore (E.log "flow-insensitive\n");*) + ignore(S.time "flow-insensitive" + (visitCilFunction (DFI.optimizeVisitor())) fd); + + (*ignore(E.log "check-merge\n");*) + ignore(S.time "check-merge" + (visitCilFunction DCS.checkStrengthener) fd); + + recomputeCfg fd; + (*ignore(E.log "loopcheck\n");*) + S.time "loopcheck" DLO.loopInvCheckMover fd; + + recomputeCfg fd; + (*ignore(E.log "oct-analysis\n");*) + S.time "oct-analysis" (DOA.doOctAnalysis fd) fdat; + DOA.reportStats(); + + (*ignore(E.log "dup-check-elim\n");*) + S.time "dup-check-elim" (DDE.elim_dup_checks fd) fdat + end; + recomputeCfg fd + +let deadCodeElim (f:file) : unit = + Cfg.clearFileCFG f; + Cfg.computeFileCFG f; + S.time "dce" Deadcodeelim.dce f; + List.iter + (fun g -> + match g with + | GFun (fd, _) -> begin + RCT.rm_unused_locals fd + end + | _ -> ()) + f.globals; + Cfg.clearFileCFG f; + () + +let optimFunction (fd: fundec) (l: location) (fdat : DPF.functionData) = + currentLoc := l; + if !optLevel = 1 then + Stats.time "optimizations" optLevel1 fd + else if !optLevel = 2 then + Stats.time "optimizations" (optLevel2 fd) fdat + else if !optLevel = 3 then + Stats.time "optimizations" (optLevel3 fd) fdat + else if !optLevel = 4 then + Stats.time "optimizations" (optLevel4 fd) fdat + + + diff --git a/src/optimizer/doptimutil.ml b/src/optimizer/doptimutil.ml new file mode 100644 index 0000000..f217214 --- /dev/null +++ b/src/optimizer/doptimutil.ml @@ -0,0 +1,300 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * doptimutil.ml + * + * This file contains useful utility functions for the Deputy + * optimizer. + * + *) + +open Cil +open Expcompare +open Pretty +open Dattrs +open Dutil +open Dcheckdef + +module E = Errormsg +module P = Ptranal + +module DCE = Dcanonexp + +let debug = ref false + +let (<%) = (fun x y -> (Int64.compare x y) < 0) +let (<=%) = (fun x y -> (Int64.compare x y) <= 0) +let (>%) = (fun x y -> (Int64.compare x y) > 0) +let (>=%) = (fun x y -> (Int64.compare x y) >= 0) +let (<>%) = (fun x y -> (Int64.compare x y) <> 0) + +let (+%) = Int64.add +let (-%) = Int64.sub +let ( *% ) = Int64.mul +let (/%) = Int64.div +let (~-%) = Int64.neg + +let debugOptim = false + +(* let int64to32 (i: int64) : int32 = *) +(* let i' = Int64.to_int32 i in (\* Silently drop the high 32 bits *\) *) +(* if i = Int64.of_int32 i' then i' *) +(* else E.s (unimp "A constant that doesn't fit in 32 bits.") *) + +(* What is the largest number that can be stored in the given integral type, + assuming it is treated as unsigned? *) +let maxUnsignedInt (t:typ) : int64 = + (Int64.shift_left 1L (bitsSizeOf t)) -% 1L + +let rec isIntOrPtrType (t:typ) : bool = + match t with + TInt _ | TPtr _ -> true + | TNamed (tt,_) -> isIntOrPtrType tt.ttype + | _ -> false + +(* Returns the size of a pointer's base type in bytes, if known *) +let sizeOfBaseType ptrt: int option = + match unrollType ptrt with + | TPtr (bt, _) -> begin + match isInteger (constFold true (SizeOf bt)) with + | Some n -> Some (to_int n) + | None -> None + end + | _ -> (* maybe the expression is NULL *) + None + +(* Do we need an alignment check for p + x? Well, that depends on the size of + * *p. If the size is a power of two, p + x will be aligned even if it + * overflows, so we can skip the check. *) +let needsAlignCheck ptrt: bool = + match sizeOfBaseType ptrt with (* Look for common multiples of 2 *) + Some (1|2|4|8|16|32|64|128|256|512|1024|2048|4096) -> false + | _ -> true + +let false_cond (c:check) = false + +(* map f to all the expressions in a check + * only if cnd c is false *) +(* (check -> bool) -> (exp -> exp) -> check -> check *) +let map_to_check ?cond:(cnd=false_cond) f c = + match c with + CNonNull e -> + let e' = f e in + CNonNull e' + | CEq(e1,e2,why,docs) -> + let e1' = f e1 in + if cnd (CEq(e1',e2,why,docs)) then CEq(e1',e2,why,docs) else + let e2' = f e2 in + if cnd (CEq(e1,e2',why,docs)) then CEq(e1,e2',why,docs) else + CEq(e1',e2',why,docs) + | CMult(e1,e2) -> + let e1' = f e1 in + let e2' = f e2 in + CMult(e1',e2') + | CPtrArith(e1,e2,e3,e4,sz) -> + let e1' = f e1 in + if isZero e1' then CPtrArith(e1',e2,e3,e4,sz) else + let e2' = f e2 in + if cnd (CPtrArith(e1',e2',e3,e4,sz)) then CPtrArith(e1',e2',e3,e4,sz) else + let e3' = f e3 in + if cnd (CPtrArith(e1',e2,e3',e4,sz)) then CPtrArith(e1',e2,e3',e4,sz) else + let e4' = f e4 in + if cnd (CPtrArith(e1',e2,e3',e4',sz)) then CPtrArith(e1',e2,e3',e4',sz) else + CPtrArith(e1',e2',e3',e4',sz) + | CPtrArithAccess(e1,e2,e3,e4,sz) -> + let e1' = f e1 in + if isZero e1' then CPtrArithAccess(e1',e2,e3,e4,sz) else + let e2' = f e2 in + if cnd (CPtrArithAccess(e1',e2',e3,e4,sz)) then CPtrArithAccess(e1',e2',e3,e4,sz) else + let e3' = f e3 in + if cnd (CPtrArithAccess(e1',e2,e3',e4,sz)) then CPtrArithAccess(e1',e2,e3',e4,sz) else + let e4' = f e4 in + if cnd (CPtrArithAccess(e1',e2,e3',e4',sz)) then CPtrArithAccess(e1',e2,e3',e4',sz) else + CPtrArithAccess(e1',e2',e3',e4',sz) + | CPtrArithNT(e1,e2,e3,e4,sz) -> + let e1' = f e1 in + if isZero e1' then CPtrArithNT(e1',e2,e3,e4,sz) else + let e2' = f e2 in + if cnd (CPtrArithNT(e1',e2',e3,e4,sz)) then CPtrArithNT(e1',e2',e3,e4,sz) else + let e3' = f e3 in + if cnd (CPtrArithNT(e1',e2,e3',e4,sz)) then CPtrArithNT(e1',e2,e3',e4,sz) else + let e4' = f e4 in + if cnd (CPtrArithNT(e1',e2,e3',e4',sz)) then CPtrArithNT(e1',e2,e3',e4',sz) else + CPtrArithNT(e1',e2',e3',e4',sz) + | CLeqInt(e1,e2,why) -> + let e1' = f e1 in + let e2' = f e2 in + CLeqInt(e1',e2',why) + | CLeq(e1,e2,why) -> + let e1' = f e1 in + if cnd (CLeq(e1',e2,why)) then CLeq(e1',e2,why) else + let e2' = f e2 in + if cnd (CLeq(e1,e2,why)) then CLeq(e1,e2',why) else + CLeq(e1',e2',why) + | CLeqNT(e1,e2,sz,why) -> + let e1' = f e1 in + if cnd (CLeqNT(e1',e2,sz,why)) then CLeqNT(e1',e2,sz,why) else + let e2' = f e2 in + if cnd (CLeqNT(e1,e2',sz,why)) then CLeqNT(e1,e2',sz,why) else + CLeqNT(e1',e2',sz,why) + | CNullOrLeq(e1,e2,e3,why) -> + let e1' = f e1 in + if isZero e1' then CNullOrLeq(e1',e2,e3,why) else + let e2' = f e2 in + if cnd (CNullOrLeq(e1',e2',e3,why)) then CNullOrLeq(e1',e2',e3,why) else + let e3' = f e3 in + if cnd (CNullOrLeq(e1',e2,e3',why)) then CNullOrLeq(e1',e2,e3',why) else + CNullOrLeq(e1',e2',e3',why) + | CNullOrLeqNT(e1,e2,e3,sz,why) -> + let e1' = f e1 in + if isZero e1' then CNullOrLeqNT(e1',e2,e3,sz,why) else + let e2' = f e2 in + if cnd (CNullOrLeqNT(e1',e2',e3,sz,why)) then CNullOrLeqNT(e1',e2',e3,sz,why) else + let e3' = f e3 in + if cnd (CNullOrLeqNT(e1',e2,e3',sz,why)) then CNullOrLeqNT(e1',e2,e3',sz,why) else + CNullOrLeqNT(e1',e2',e3',sz,why) + | CWriteNT(e1,e2,e3,sz) -> + let e1' = f e1 in + let e2' = f e2 in + let e3' = f e3 in + CWriteNT(e1',e2',e3',sz) + | CSelected e -> + let e' = f e in + CSelected e' + | CNotSelected e -> + let e' = f e in + CNotSelected e' + | CNullUnionOrSelected (lv,e) -> + let e' = f e in + CNullUnionOrSelected(lv,e') + + +(* Apply f to all expressions in a check + * and return the combination of the results + * specified by comb the default for which is + * ||. + *) +(* (bool -> bool -> bool) -> (exp -> bool) -> check -> bool *) +let test_check ?comb:(cmb=(fun a b -> a || b)) f c = + match c with + CNonNull e + | CNotSelected e + | CSelected e -> + f e + | CNullUnionOrSelected (lv,e) -> + cmb (f (Lval lv)) (f e) + | CEq(e1,e2,_,_) + | CMult(e1,e2) + | CLeq(e1,e2,_) + | CLeqInt(e1,e2,_) + | CLeqNT(e1,e2,_,_) -> + let b1 = f e1 in + let b2 = f e2 in + cmb b1 b2 + | CNullOrLeq(e1,e2,e3,why) -> + let b1 = f e1 in + let b2 = f e2 in + let b3 = f e3 in + cmb b1 (cmb b2 b3) + | CNullOrLeqNT(e1,e2,e3,sz,_) + | CWriteNT(e1,e2,e3,sz) -> + let b1 = f e1 in + let b2 = f e2 in + let b3 = f e3 in + cmb (cmb b1 b2) b3 + | CPtrArith(e1,e2,e3,e4,sz) + | CPtrArithAccess(e1,e2,e3,e4,sz) + | CPtrArithNT(e1,e2,e3,e4,sz) -> + let b1 = f e1 in + let b2 = f e2 in + let b3 = f e3 in + let b4 = f e4 in + cmb (cmb b1 b2) (cmb b3 b4) + +let compareExpLists el1 el2 = + if List.length el1 <> List.length el2 + then false + else List.fold_left (fun b (e1,e2) -> + b && DCE.canonCompareExp(*StripCasts*) e1 e2) + true (List.combine el1 el2) + +let deputyCallsEqual i1 i2 = + (*ignore(E.log "comparing %a and %a\n" d_instr i1 d_instr i2);*) + match instrToCheck i1, instrToCheck i2 with + Some c1, Some c2 -> checks_equal c1 c2 + | Some _, None -> false + | None, Some _ -> false + | None, None -> + if not(is_deputy_instr i1) || + not(is_deputy_instr i2) + then false + else match i1, i2 with + Call(_,fn1,el1,_), Call(_,fn2,el2,_) -> + if not(compareExp fn1 fn2) + then false + else compareExpLists el1 el2 + | _ -> false + + +(* Is the block reachable through a goto? *) +let hasALabel (b:block) : bool = + let hasLabel = ref false in + let hasALabelVisitor = object (self) + inherit nopCilVisitor + method vstmt s = + if s.labels <> [] then begin + hasLabel := true; + end; + DoChildren + end in + ignore (visitCilBlock hasALabelVisitor b); + !hasLabel + +(* returns the largest prefix of l such that each + * element of the prefix satisfies p *) +let prefix p l = + let rec helper p l seen = + match l with + | [] -> (List.rev seen, []) + | x :: rst -> begin + if p x + then helper p rst (x::seen) + else (List.rev seen, x :: rst) + end + in + helper p l [] + diff --git a/src/optimizer/dprecfinder.ml b/src/optimizer/dprecfinder.ml new file mode 100644 index 0000000..d4ef0f1 --- /dev/null +++ b/src/optimizer/dprecfinder.ml @@ -0,0 +1,880 @@ +(* + * Find checks on globals and formals at the beginning of functions. + * Also, some utilities for filtering the results. + * + *) + +open Cil +open Pretty +open Dattrs +open Dutil +open Dcheckdef +open Doptimutil + +module IH = Inthash +module E = Errormsg +module S = Stats +module F = Frontc +module DP = Dpatch + +let debug = ref false + +let patch_fname = "preconditions.patch.h" +let modp_fname = "modifies.patch.h" + +type functionData = + { + (* Hash from function vids to list of preconditions *) + fdPCHash : instr list IH.t; + + (* Hash from function vids to fundecs. The bool is true + * if the function has been modified *) + fdFnHash : (varinfo * bool) IH.t; + + (* Hash from the function vids to lists of modified globals and + parameters *) + fdModHash : (varinfo list * int list) IH.t + } + +let mkFDat () = + { + fdPCHash = IH.create 100; + fdFnHash = IH.create 100; + fdModHash = IH.create 100; + } + +(* Visit each function. + * Find checks before any real instructions. + * Add checks to entry in fnPCHash for the function + *) +class preConditionFinderClass (fdat : functionData) = object(self) + inherit nopCilVisitor + + (* return the checks that are first in the block *) + method private findDomChecks (blk : block) fd = + let rec helper (sl : stmt list) (cl : instr list) = + match sl with + | [] -> cl + | s :: rst -> begin + match s.skind with + | Instr il -> begin + (*if !debug then + ignore(E.log "precFinder: LOOKING AT %a in %s\n" + d_stmt (mkStmt (Instr il)) fd.svar.vname);*) + if List.exists (fun i -> not(is_check_instr i)) il + then begin + let newcs = fst((prefix is_check_instr il)) in + if !debug && newcs <> [] then + ignore(E.log "precFinder: MIXED %a in %s\n" + d_stmt (mkStmt (Instr newcs)) fd.svar.vname); + newcs@cl + end + else begin + if !debug then + ignore(E.log "precFinder: ADDING %a to %s\n" + d_stmt (mkStmt (Instr il)) fd.svar.vname); + helper rst (il @ cl) + end + end + | _ -> cl + end + in + helper blk.bstmts [] + + method vfunc (fd: fundec) = + let precs = self#findDomChecks fd.sbody fd in + IH.replace fdat.fdPCHash fd.svar.vid precs; + IH.replace fdat.fdFnHash fd.svar.vid (fd.svar, false); + SkipChildren + +end + + +(* return a hash from function var id to a list of + * preconditions for the function *) +let preConditionFinder (fdat : functionData) (f : file) : unit = + let vis = new preConditionFinderClass fdat in + visitCilFile vis f + +(* filter returns true if a precondition should be kept *) +let precFilter (filter : varinfo -> instr -> bool) + (fdat : functionData) + : unit + = + IH.iter (fun vid cl -> + match IH.tryfind fdat.fdFnHash vid with + | None -> () (* an error message perhaps? *) + | Some (fvar, _) -> begin + let newcl = List.filter (filter fvar) cl in + IH.replace fdat.fdPCHash vid newcl + end) fdat.fdPCHash + +(* get the place of arg in fnargs *) +let argToNumber (arg: varinfo) (fnvi: varinfo) : int option = + let rec helper (count : int) + (args : (string * typ * attributes) list) : + int option + = + match args with + | [] -> None + | (n,_,_) :: rst -> + if arg.vname = n then (Some count) else + helper (count + 1) rst + in + match fnvi.vtype with + | TFun(_,Some args,_,_) -> helper 0 args + | _ -> None + + +(* Convert an expression into an attribute, if possible. Otherwise raise + * NotAnAttrParam *) +exception NotAnAttrParam of exp +let rec expToAttrParam (fnvi: varinfo) (e: exp) : attrparam = + match e with + | Const(CInt64(i,k,_)) -> + let i', trunc = truncateInteger64 k i in + if trunc then + raise (NotAnAttrParam e); + let i2 = Int64.to_int i' in + if i' <> Int64.of_int i2 then + raise (NotAnAttrParam e); + AInt i2 + | Lval lv -> lvalToAttrParam fnvi lv + | StartOf lv -> lvalToAttrParam fnvi lv + | AddrOf lv -> AAddrOf(lvalToAttrParam fnvi lv) + | SizeOf t -> ASizeOf t + | SizeOfE e' -> ASizeOfE (expToAttrParam fnvi e') + | UnOp(uo, e', _) -> AUnOp (uo, expToAttrParam fnvi e') + | BinOp(bo, e1',e2', _) -> ABinOp (bo, expToAttrParam fnvi e1', + expToAttrParam fnvi e2') + | CastE(t, e) when deputyCompareTypes t (typeOf e) -> + expToAttrParam fnvi e + | _ -> begin + if !debug then ignore(E.log "expToAttrParam: not a param: %a\n" d_exp e); + raise (NotAnAttrParam e) + end + +(* Convernt an lvalue to an attribute parameter *) +and lvalToAttrParam (fnvi : varinfo) (lv : lval) : attrparam = + match lv with + | (Var vi, off) -> begin + match argToNumber vi fnvi with + | None -> + offToAttrParam fnvi (ACons(vi.vname, [])) off + | Some i -> + let vname = "$"^(string_of_int i) in + offToAttrParam fnvi (ACons(vname,[])) off + end + | (Mem e, off) -> begin + let eattr = expToAttrParam fnvi e in + offToAttrParam fnvi (AStar eattr) off + end + +(* convert an attrparam with an offset into an attrparam *) +and offToAttrParam (fnvi: varinfo) + (ap: attrparam) + (off: offset) + : attrparam + = + match off with + | NoOffset -> ap + | Field(fi, off) -> + offToAttrParam fnvi (ADot(ap,fi.fname)) off + | Index(e, off) -> + let eap = expToAttrParam fnvi e in + offToAttrParam fnvi (AIndex(ap,eap)) off + + +(* convert an attribute parameter into an expresssion *) + +exception NotAnExp of attrparam +let rec attrParamToExp ?(fnargs: varinfo list = []) + (globmap: (string,varinfo) Hashtbl.t) + (ap: attrparam) + : exp + = + let attrParamStringToLval (s: string) : exp = + if String.sub s 0 1 = "$" then begin + try + let nstr = String.sub s 1 ((String.length s) - 1) in + let n = int_of_string nstr in + let vi = List.nth fnargs n in + if isArrayType vi.vtype then + StartOf(Var vi, NoOffset) + else + Lval(Var vi, NoOffset) + with + | Failure "nth" -> begin + ignore(E.log "Failure \"nth\" in attrParamStringToLval: %a\n" + d_attrparam ap); + raise (NotAnExp ap) + end + (*| Failure "int_of_string" -> + raise (NotAnExp ap) + | Invalid_argument -> + raise (NotAnExp ap) *) + end else begin + try + let vi = Hashtbl.find globmap s in + if isArrayType vi.vtype then + StartOf(Var vi, NoOffset) + else + Lval(Var vi, NoOffset) + with Not_found -> begin + ignore(E.log "Not_found in attrParamStringToLval: %a\n" + d_attrparam ap); + raise (NotAnExp ap) + end + end + in + let fieldInfoFromName (t: typ) (fn: string) : fieldinfo = + match unrollType t with + | TComp(ci, _) -> begin + try List.find (fun fi -> fi.fname = fn) ci.cfields + with Not_found -> raise (NotAnExp ap) + end + | _ -> raise (NotAnExp ap) + in + let attrParamToExp = attrParamToExp ~fnargs:fnargs globmap in + match ap with + | AInt i -> integer i + | AStr s -> Const(CStr s) + | ACons(s, []) -> attrParamStringToLval s + | ASizeOf typ -> SizeOf typ + | ASizeOfE ap -> SizeOfE (attrParamToExp ap) + | AAlignOf typ -> AlignOf typ + | AAlignOfE ap -> AlignOfE (attrParamToExp ap) + | AUnOp(op, ap) -> + let e = attrParamToExp ap in + UnOp(op, e, typeOf e) + | ABinOp(op, ap1, ap2) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + (* Need to make sure that op is correct, here *) + match op, unrollType (typeOf e1) with + | PlusA, (TPtr _ | TArray _) -> BinOp(PlusPI, e1, e2, typeOf e1) + | _, _ -> BinOp(op, e1, e2, typeOf e1) + end + | ADot(lap, fn) -> begin + let e = attrParamToExp lap in + let fi = fieldInfoFromName (typeOf e) fn in + match e with + | Lval(lh, off) -> + let newoff = Field(fi,NoOffset) in + if isArrayType fi.ftype then + StartOf(lh, addOffset newoff off) + else + Lval(lh, addOffset newoff off) + | _ -> raise (NotAnExp ap) + end + | AStar ap -> + let e = attrParamToExp ap in + Lval(Mem e, NoOffset) + | AAddrOf aap -> begin + let e = attrParamToExp aap in + match e with + | Lval lv -> AddrOf lv + | _ -> raise (NotAnExp ap) + end + | AIndex(bap,iap) -> begin + let be = attrParamToExp bap in + let ie = attrParamToExp iap in + match be with + | Lval(lh,off) -> + let newoff = Index(ie,NoOffset) in + Lval(lh, addOffset newoff off) + | StartOf(lh, off) -> + let newoff = Index(ie, NoOffset) in + Lval(lh, addOffset newoff off) + | _ -> raise (NotAnExp ap) + end + | _ -> raise (NotAnExp ap) + +class globalMapMakerClass (globmap : (string,varinfo) Hashtbl.t) = object(self) + inherit nopCilVisitor + + method vvrbl vi = + if vi.vglob then begin + Hashtbl.replace globmap vi.vname vi + end; + DoChildren + + method vglob = function + | GVar(vi,_,_) + | GVarDecl(vi,_) -> begin + Hashtbl.replace globmap vi.vname vi; + DoChildren + end + | _ -> DoChildren + +end + + + +(* Convert a whold deputy check into an attribute parameter *) +let checkToAttrParam (fnvi: varinfo) + (i : instr) + : attrparam option + = + let mkACons ?(sz : int option = None) + (name : string) + (el : exp list) + : attrparam + = + let expToAttrParam = expToAttrParam fnvi in + let ael = List.map expToAttrParam el in + let asz = match sz with Some sz -> [AInt sz] | None -> [] in + ACons(name, ael@asz) + in + try + match instrToCheck i with + | None -> None + | Some c -> begin + match c with + | CNonNull e -> Some(mkACons "_CNonNull" [e]) + | CEq(e1,e2,_,_) -> Some(mkACons "_CEq" [e1;e2]) + | CPtrArith(e1,e2,e3,e4,sz) -> + Some(mkACons ~sz:(Some sz) "_CPtrArith" [e1;e2;e3;e4]) + | CPtrArithNT(e1,e2,e3,e4,sz) -> + Some(mkACons ~sz:(Some sz) "_CPtrArithNT" [e1;e2;e3;e4]) + | CPtrArithAccess(e1,e2,e3,e4,sz) -> + Some(mkACons ~sz:(Some sz) "_CPtrArithAccess" [e1;e2;e3;e4]) + | CLeqInt(e1,e2,_) -> Some(mkACons "_CLeqInt" [e1;e2]) + | CLeq(e1,e2,_) -> Some(mkACons "_CLeq" [e1;e2]) + | CLeqNT(e1,e2,sz,_) -> Some(mkACons ~sz:(Some sz) "_CLeqNT" [e1;e2]) + | CNullOrLeq(e1,e2,e3,_) -> Some(mkACons "_CNullOrLeq" [e1;e2;e3]) + | CNullOrLeqNT(e1,e2,e3,sz,_) -> + Some(mkACons ~sz:(Some sz) "_CNullOrLeqNT" [e1;e2;e3]) + | CWriteNT(e1,e2,e3,sz) -> + Some(mkACons ~sz:(Some sz) "_CWriteNT" [e1;e2;e3]) + | CNullUnionOrSelected(lv,e) -> + Some(mkACons "_CNullUnionOrSelected" [(Lval lv);e]) + | CSelected e -> Some(mkACons "_CSelected" [e]) + | CNotSelected e -> Some(mkACons "_CNotSelected" [e]) + | _ -> None + end + with NotAnAttrParam e -> begin + if !debug then ignore(E.log "checkToAttrParam: %a\n" d_exp e); + None + end + +type ctxt = + { + mutable cGlobMap : (string, varinfo) Hashtbl.t; + mutable cInited : bool; + mutable cFile : file + } + +let mkGlobalContext (f : file) : ctxt = + let cgm = Hashtbl.create 100 in + ignore(visitCilFile (new globalMapMakerClass cgm) f); + { + cGlobMap = cgm; + cInited = true; + cFile = f + } + +(* Convert a Precondition attribute into a list of check instructions *) +let attributeToCheckInstrs ?(fnargs : varinfo list = []) + (c : ctxt) + (a : attribute) + : instr list + = + let attrParamToCheck (ap : attrparam) : instr list = + let attrParamToExp = attrParamToExp ~fnargs:fnargs c.cGlobMap in + match ap with + | ACons("_CNonNull", [ap]) -> + let e = attrParamToExp ap in + [checkToInstr(CNonNull(e))] + | ACons("_CEq", [ap1;ap2]) -> + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + [checkToInstr(CEq(e1,e2,"precondition",[]))] + | ACons("_CPtrArith", [ap1;ap2;ap3;ap4;ap5]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + let e4 = attrParamToExp ap4 in + let e5 = attrParamToExp ap5 in + match e5 with + | Const(CInt64(i64,_,_)) -> + let sz = Int64.to_int i64 in + [checkToInstr(CPtrArith(e1,e2,e3,e4,sz))] + | _ -> [] + end + | ACons("_CPtrArithNT", [ap1;ap2;ap3;ap4;ap5]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + let e4 = attrParamToExp ap4 in + let e5 = attrParamToExp ap5 in + match e5 with + | Const(CInt64(i64,_,_)) -> + let sz = Int64.to_int i64 in + [checkToInstr(CPtrArithNT(e1,e2,e3,e4,sz))] + | _ -> [] + end + | ACons("_CPtrArithAccess", [ap1;ap2;ap3;ap4;ap5]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + let e4 = attrParamToExp ap4 in + let e5 = attrParamToExp ap5 in + match e5 with + | Const(CInt64(i64,_,_)) -> + let sz = Int64.to_int i64 in + [checkToInstr(CPtrArithAccess(e1,e2,e3,e4,sz))] + | _ -> [] + end + | ACons("_CLeqInt", [ap1;ap2]) -> + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + [checkToInstr(CLeqInt(e1,e2,"precondition"))] + | ACons("_CLeq", [ap1; ap2]) -> + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + [checkToInstr(CLeq(e1,e2,"precondition"))] + | ACons("_CLeqNT", [ap1;ap2;ap3]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + match e3 with + | Const(CInt64(i64,_,_)) -> + let sz = Int64.to_int i64 in + [checkToInstr(CLeqNT(e1,e2,sz,"precondition"))] + | _ -> [] + end + | ACons("_CNullOrLeq", [ap1;ap2;ap3]) -> + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + [checkToInstr(CNullOrLeq(e1,e2,e3,"precondition"))] + | ACons("_CNullOrLeqNT", [ap1;ap2;ap3;ap4]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + let e4 = attrParamToExp ap4 in + match e4 with + | Const(CInt64(i64,_,_)) -> + let sz = Int64.to_int i64 in + [checkToInstr(CNullOrLeqNT(e1,e2,e3,sz,"precondition"))] + | _ -> [] + end + | ACons("_CWriteNT", [ap1;ap2;ap3;ap4]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + let e3 = attrParamToExp ap3 in + let e4 = attrParamToExp ap4 in + match e4 with + | Const(CInt64(i64,_,_)) -> + let sz = Int64.to_int i64 in + [checkToInstr(CWriteNT(e1,e2,e3,sz))] + | _ -> [] + end + | ACons("_CNullUnionOrSelected", [ap1; ap2]) -> begin + let e1 = attrParamToExp ap1 in + let e2 = attrParamToExp ap2 in + match e1 with + | Lval lv -> + [checkToInstr(CNullUnionOrSelected(lv,e2))] + | _ -> [] + end + | ACons("_CSelected", [ap]) -> + let e1 = attrParamToExp ap in + [checkToInstr(CSelected(e1))] + | ACons("_CNotSelected", [ap]) -> + let e1 = attrParamToExp ap in + [checkToInstr(CNotSelected(e1))] + | _ -> [] + in + match a with + | Attr("Preconditions",apl) -> begin + try + if not c.cInited then + ignore(visitCilFile (new globalMapMakerClass c.cGlobMap) c.cFile); + if !debug then + ignore(E.log "From attr: %a\n" d_attr a); + let cl = List.concat(List.map attrParamToCheck apl) in + if !debug then + ignore(E.log "Extracted: %a\n" d_stmt (mkStmt (Instr cl))); + cl + with NotAnExp ap -> begin + ignore(E.log "Warning: NotAnExp: %a\n" d_attrparam ap); + [] + end + end + | Attr(s, _) -> begin + if !debug then + ignore(E.log "Found attr = %s\n" s); + [] + end + + +class precsFromAnnotsClass (c : ctxt) (fdat : functionData) = object(self) + inherit nopCilVisitor + + method vfunc (fd : fundec) = + try + if !debug then + ignore(E.log "Preconditions for: %s : %a\n" + fd.svar.vname d_type fd.svar.vtype); + let attrToChecks = attributeToCheckInstrs ~fnargs:fd.sformals c in + let attrs = typeAttrs fd.svar.vtype in + let cl = List.concat(List.map attrToChecks attrs) in + if cl <> [] then begin + IH.replace fdat.fdPCHash fd.svar.vid cl; + match IH.tryfind fdat.fdFnHash fd.svar.vid with + | None -> IH.add fdat.fdFnHash fd.svar.vid (fd.svar, true) + | Some _ -> () + end; + SkipChildren + with Not_found -> SkipChildren +end + +let extractPrecsFromAnnots (fdat : functionData) (f : file) : unit = + let c = mkGlobalContext f in + ignore(visitCilFile (new precsFromAnnotsClass c fdat) f) + +let rec fixIndexLval (lv : lval) : lval = + let lvp, off = removeOffsetLval lv in + match off with + | Index(i, NoOffset) -> begin + let lvp = fixIndexLval lvp in + let p = StartOf lvp in + (Mem (BinOp (PlusPI, p, i, typeOf p)), NoOffset) + end + | _ -> lv + +class formalSubsterClass stalal = object(self) + inherit nopCilVisitor + + method vexpr (e : exp) = + match e with + | AddrOf(Var vi, off) + | StartOf(Var vi, off) + | Lval(Var vi, off) -> begin + try + let ((_,t,_),ae) = List.find (fun ((s,_,_),_) -> s = vi.vname) + stalal + in + match ae with + | AddrOf(lh, aoff) -> + let lv = fixIndexLval (lh, addOffset off aoff) in + let newe = mkCast (AddrOf lv) t in + ChangeTo(newe) + | StartOf(lh, aoff) -> + let lv = fixIndexLval (lh, addOffset off aoff) in + let newe = mkCast (StartOf lv) t in + ChangeTo(newe) + | Lval(lh, aoff) -> + let lv = fixIndexLval (lh, addOffset off aoff) in + let newe = mkCast (Lval lv) t in + ChangeTo(newe) + | _ -> begin + match off with + | NoOffset -> ChangeTo (mkCast ae t) + | _ -> begin + ignore(E.log "%a not a good argument\n" d_exp ae); + DoChildren + end + end + with Not_found -> begin + if !debug then + ignore(E.log "%s not a formal\n" vi.vname); + DoChildren + end + end + | _ -> begin + DoChildren + end + +end + +(* Replace the formals of t mentioned in ci with the corresponding expr from + al *) +let substForFormals (t : typ) (al : exp list) (ci : instr) : instr list = + match t with + | TFun(rt, Some stal, _, _) -> begin + let stalal = List.combine stal al in + let fixedcl = visitCilInstr (new formalSubsterClass stalal) ci in + if !debug then + ignore(E.log "type: %a\n oldcheck = %a\n fixedcheck = %a\n" + d_type t + d_stmt (mkStmt (Instr [ci])) d_stmt (mkStmt (Instr fixedcl))); + fixedcl + end + | _ -> [ci] (* internal error *) + +class callSitePrecAdderClass (fdat : functionData) = object(self) + inherit nopCilVisitor + + method vinst (i : instr) = + match i with + | Call(_, Lval(Var fvi, NoOffset), el, _) -> begin + try + let cl = IH.find fdat.fdPCHash fvi.vid in + let clGoodArgs = + List.concat(List.map (substForFormals fvi.vtype el) cl) + in + ChangeTo(clGoodArgs@[i]) + with Not_found -> DoChildren + end + | _ -> DoChildren +end + +let addChecksAtCallSites (fd : fundec) (fdat : functionData) : unit = + ignore(visitCilFunction (new callSitePrecAdderClass fdat) fd) + +(* list of options to list of the things inside the Somes *) +let filterNoneAndUnwrap (aol : 'a option list) : 'a list = + let rec helper aol seen = + match aol with + | [] -> List.rev seen + | x :: rst -> + match x with + | None -> helper rst seen + | Some a -> helper rst (a::seen) + in + helper aol [] + + +let addAllPreconditions (fdat : functionData) (f : file) : unit = + preConditionFinder fdat f + (*;addPreconditionAttributes fdat*) + + +(* prints the annotated prototypes from f in file called fname.nonnull.h *) +let printPrototypes (fdat : functionData) (fname : string) : unit = + let gl = IH.fold (fun vid (fvar,b) gl -> + if not b then gl else + (GVarDecl(fvar,locUnknown))::gl) + fdat.fdFnHash [] + in + if gl = [] then () else + let outpf = open_out fname in + List.iter (fun g -> + match g with + | GVarDecl _ -> + let d = dprintf "%a\n" dp_global g in + ignore(E.log "Adding %a to %s\n" dp_global g fname); + fprint outpf ~width:200 d + | _ -> ()) gl; + close_out outpf + +let binopEqual o1 o2 = + o1 = o2 || + match o1, o2 with + | PlusA, PlusPI + | PlusA, IndexPI + | PlusPI, PlusA + | PlusPI, IndexPI + | IndexPI, PlusA + | IndexPI, PlusPI + | MinusA, MinusPP + | MinusA, MinusPI + | MinusPP, MinusA + | MinusPP, MinusPI + | MinusPI, MinusA + | MinusPI, MinusPP -> true + | _, _ -> false + +let rec attrParamsEqual ap1 ap2 = + ap1 == ap2 || + match ap1, ap2 with + | AInt i1, AInt i2 -> i1 = i2 + | AStr s1, AStr s2 -> String.compare s1 s2 = 0 + | ASizeOf t1, ASizeOf t2 -> deputyCompareTypes t1 t2 + | ASizeOfE ap1, ASizeOfE ap2 -> attrParamsEqual ap1 ap2 + | ASizeOfS ts1, ASizeOfS ts2 -> Util.equals ts1 ts2 + | AAlignOf t1, AAlignOf t2 -> deputyCompareTypes t1 t2 + | AAlignOfE ap1, AAlignOfE ap2 -> attrParamsEqual ap1 ap2 + | AAlignOfS ts1, AAlignOfS ts2 -> Util.equals ts1 ts2 + | AUnOp(o1,ap1), AUnOp(o2,ap2) -> o1 = o2 && (attrParamsEqual ap1 ap2) + | ABinOp(o1,ap11,ap12), ABinOp(o2,ap21,ap22) -> + (binopEqual o1 o2) && + (attrParamsEqual ap11 ap21) && + (attrParamsEqual ap12 ap22) + | ADot(ap1,s1), ADot(ap2,s2) -> + String.compare s1 s2 = 0 && + (attrParamsEqual ap1 ap2) + | AStar ap1, AStar ap2 -> attrParamsEqual ap1 ap2 + | AAddrOf ap1, AAddrOf ap2 -> attrParamsEqual ap1 ap2 + | AIndex(apb1, api1), AIndex(apb2, api2) -> + (attrParamsEqual apb1 apb2) && + (attrParamsEqual api1 api2) + | AQuestion(ap11,ap12,ap13), AQuestion(ap21,ap22,ap23) -> + (attrParamsEqual ap11 ap21) && + (attrParamsEqual ap12 ap22) && + (attrParamsEqual ap13 ap23) + | ACons(s1,apl1), ACons(s2,apl2) -> + String.compare s1 s2 = 0 && + List.length apl1 = List.length apl2 && + List.fold_left (fun b (ap1, ap2) -> + b && (attrParamsEqual ap1 ap2)) + true (List.combine apl1 apl2) + | _ -> false + + +let list_union l1 l2 = + List.fold_left (fun l x -> + if List.exists (attrParamsEqual x) l then l + else x :: l) l1 l2 + +(* Take two function types and merge the attributes in the names list *) +let mergeAttributes (oldt : typ) + (newt : typ) + (names : string list) + : typ + = + List.fold_left (fun oldt name -> + match oldt, newt with + | TFun(r1, args1, v1, attrs1), TFun(r2, args2, v2, attrs2) -> begin + match filterAttributes name attrs1 with + | [] -> begin + match filterAttributes name attrs2 with + | [] -> oldt + | newprecs :: _ -> + TFun(r1, args1, v1, addAttribute newprecs attrs1) + end + | (Attr(_,precs1)) :: _ -> begin + match filterAttributes name attrs2 with + | [] -> TFun(r1, args1, v1, attrs1) + | (Attr(_,precs2)) :: _ -> begin + let newattrs = dropAttributes [name] attrs1 in + let newprecs = Attr(name, list_union precs1 precs2) in + let newattrs = addAttribute newprecs newattrs in + TFun(r1, args1, v1, newattrs) + end + end + end + | _, _ -> oldt) oldt names + + +(* Add Precondition attributes to functions *) +let addPreconditionAttributes (fdat : functionData) : unit = + IH.iter (fun vid cl -> + match IH.tryfind fdat.fdFnHash vid with + | None -> () + | Some (fvar, _) -> begin + (* HACK: only add if function is static and address is not taken *) + if fvar.vstorage <> Static || fvar.vaddrof then () else + let apl = List.map (checkToAttrParam fvar) cl in + let apl = filterNoneAndUnwrap apl in + if apl = [] then begin + if !debug then + ignore(E.log "addPreconditionAttributes: nothing to add for %s : %a\n" + fvar.vname d_type fvar.vtype); + () + end else + let precAttr = [Attr("Preconditions",apl)] in + fvar.vtype <- typeAddAttributes precAttr fvar.vtype; + if !debug then + ignore(E.log "addPreconditionAttributes: new prec for %s = %a\n" + fvar.vname d_type fvar.vtype); + IH.replace fdat.fdFnHash vid (fvar,true) + end) fdat.fdPCHash + +(* add things in fdat.fdModHash to the prototypes in fdat.fdFnHash *) +let addModificationAttributes (fdat : functionData) : unit = + IH.iter (fun vid (vilst, anlst) -> + match IH.tryfind fdat.fdFnHash vid with + | None -> () + | Some (fvar, _) -> begin + (* HACK: only add if function is static and address is not taken *) + if fvar.vstorage <> Static || not(fvar.vaddrof) then () else + let gattrs = List.map (fun vi -> ACons(vi.vname,[])) vilst in + let anattrs = List.map (fun i -> ACons("$"^(string_of_int i), [])) anlst in + let attrs = gattrs @ anattrs in + let modAttr = + if attrs = [] then + [Attr("Modifies",[ACons("None",[])])] + else + [Attr("Modifies",attrs)] + in + fvar.vtype <- typeAddAttributes modAttr fvar.vtype; + if !debug then + ignore(E.log "DModRef: added attr: %s : %a\n" + fvar.vname d_type fvar.vtype); + IH.replace fdat.fdFnHash vid (fvar, true) + end) fdat.fdModHash + +(* Make sure that all the right annotations are on the fundecs in fdFnHash *) +let mergeFunctionData (fdat : functionData) : unit = + addPreconditionAttributes fdat; + addModificationAttributes fdat + +(* If there is an annotated prototype in the patch file already, then merge + * these annotations with it, otherwise add the prototype to the patch file *) +let addAnnotsToPatch (fdat : functionData) (pfname : string) : unit = + mergeFunctionData fdat; + try + let dummy = open_in pfname in (* see if the file exists *) + close_in dummy; + let pfile = F.parse pfname () in + IH.iter (fun vid (fvar,b) -> + let matched = ref false in + if b then + List.iter (fun g -> + match g with + | GVarDecl(fdv, _) when fdv.vname = fvar.vname -> begin + let attrnames = ["Preconditions";"Modifies"] in + let newt = mergeAttributes fdv.vtype fvar.vtype attrnames in + if !debug then + ignore(E.log "addAnnotsToPatch: changing %a to %a\n" + d_type fdv.vtype d_type newt); + fdv.vtype <- newt; + matched := true + end + | _ -> ()) pfile.globals; + if not !matched && b then begin + pfile.globals <- (GVarDecl(fvar,locUnknown)) :: pfile.globals + end) + fdat.fdFnHash; + let outpf = open_out pfname in + List.iter (fun g -> + match g with + | GVarDecl _ -> + let d = dprintf "%a\n" dp_global g in + fprint outpf ~width:200 d + | _ -> ()) pfile.globals; + close_out outpf; + with Sys_error msg -> (* If "Cannot open" is at beginning of msg, then create *) + printPrototypes fdat pfname + | x-> begin + ignore(E.log "%s was raised in addAnnotsToPatch\n" (Printexc.to_string x)); + raise x + end + +let getModifiesPatch (f : file) : unit = + try + let fh = open_in modp_fname in + close_in fh; + Dpatch.applyPatch f modp_fname + with Sys_error _ -> () + +(* apply the preconditions patch if it exists. otherwise return false *) +let applyPrecPatch (f : file) : bool = + let pfn = (Filename.chop_extension f.fileName) ^ ".patch.h" in + try + let fh = open_in pfn in + close_in fh; + Dpatch.applyPatch f pfn; + true + with Sys_error _ -> begin + false + end +(* + try + let fh = open_in patch_fname in + close_in fh; + let fh = open_in pfn in + close_in fh; + Dpatch.applyPatch f patch_fname; + getModifiesPatch f; + true + with Sys_error _ -> begin + let fh = open_out pfn in + close_out fh; + false + end +*) diff --git a/src/optimizer/modref/saturnModRef/dmodref.ml b/src/optimizer/modref/saturnModRef/dmodref.ml new file mode 100644 index 0000000..3cfec7a --- /dev/null +++ b/src/optimizer/modref/saturnModRef/dmodref.ml @@ -0,0 +1,342 @@ +(* + * dmodref.ml + * + * Figure out what globals and formals a function may modify and reference. + * Add Modifies annotations. + * + *) + +open Cil +open Pretty +open Doptions +open Doptimutil + +(* From Saturn *) +module B = Bdb +module S = Spec +module SIO = Specio + +module E = Errormsg +module IH = Inthash +module DPF = Dprecfinder + +let debug = ref false + +(* To match the interface *) +let registerIgnoreInst (f : instr -> bool) : unit = () +let registerIgnoreCall (f : instr -> bool) : unit = () + +let varinfoEqual vi1 vi2 = vi1.vid = vi2.vid + +let addGlobalMod (fdat : DPF.functionData) + (fvi : varinfo) + (gvi : varinfo) : + unit + = + ignore(E.log "DModRef: %s modifies global %s\n" fvi.vname gvi.vname); + match IH.tryfind fdat.DPF.fdModHash fvi.vid with + | Some(gvil,argl) -> begin + if List.exists (varinfoEqual gvi) gvil then () else begin + IH.replace fdat.DPF.fdModHash fvi.vid (gvi::gvil,argl); + match IH.tryfind fdat.DPF.fdFnHash fvi.vid with + | None -> IH.add fdat.DPF.fdFnHash fvi.vid (fvi, true) + | Some _ -> () + end + end + | None -> begin + IH.add fdat.DPF.fdModHash fvi.vid ([gvi],[]); + match IH.tryfind fdat.DPF.fdFnHash fvi.vid with + | None -> IH.add fdat.DPF.fdFnHash fvi.vid (fvi, true) + | Some _ -> () + end + +let addArgMod (fdat : DPF.functionData) + (fvi : varinfo) + (i : int) : + unit + = + ignore(E.log "DModRef: %s modifies argument %d\n" fvi.vname i); + match IH.tryfind fdat.DPF.fdModHash fvi.vid with + | Some(gvil,argl) -> begin + if List.mem i argl then () else begin + IH.replace fdat.DPF.fdModHash fvi.vid (gvil,i::argl); + match IH.tryfind fdat.DPF.fdFnHash fvi.vid with + | None -> IH.add fdat.DPF.fdFnHash fvi.vid (fvi, true) + | Some _ -> () + end + end + | None -> begin + IH.add fdat.DPF.fdModHash fvi.vid ([],[i]); + match IH.tryfind fdat.DPF.fdFnHash fvi.vid with + | None -> IH.add fdat.DPF.fdFnHash fvi.vid (fvi, true) + | Some _ -> () + end + +type satConst = + | SatStr of string + | SatInt of int +(* look inside of v for glob sums and arg sums *) +let extractModsFromVal (fvi : varinfo) + (fdat : DPF.functionData) + (c : DPF.ctxt) + (v : S.t_val) : + unit + = + (* if it's a sum, unwrap the first val and repeat. + if it's a constant, then return that *) + let rec helper (v : S.t_val) : satConst option = + try + let (name, vars) = S.val2sum v in + if name = "arg" then + Some(SatInt(S.val2sint vars.(0))) + else if name = "glob" then + Some(SatStr(S.val2str vars.(0))) + else helper vars.(0) + with S.Unexpected s -> begin + ignore(E.log "DModRef: Expected sum but got %s: %s\n" + (S.full_string_of_val v) s); + None + end + in + match helper v with + | None -> () + | Some(SatStr s) -> begin + try + (* there might be a colon. we want things to the right of it *) + if String.contains s ':' then begin + let ci = String.index s ':' in + let len = String.length s in + let s = String.sub s (ci+1) (len - ci - 1) in + let vi = Hashtbl.find c.DPF.cGlobMap s in + addGlobalMod fdat fvi vi; + () + end else begin + let vi = Hashtbl.find c.DPF.cGlobMap s in + addGlobalMod fdat fvi vi; + () + end + with Not_found -> begin + ignore(E.log "DModRef: %s not found in global table\n" s); + () + end + end + | Some(SatInt i) -> + addArgMod fdat fvi i; + () + +let extractModsFromPred (fvi : varinfo) + (fdat : DPF.functionData) + (c : DPF.ctxt) + (pred : S.t_pred) : + unit + = + let (name, valarr) = S.pred2rep pred in + if name <> "stuse" then begin + if !debug then + ignore(E.log "DModRef: name %s is not stuse\n" name); + () + end else + let typ = valarr.(1) in + try + let (typstr,_) = S.val2sum typ in + if typstr <> "write" && typstr <> "deepwrite" then begin + if !debug then + ignore(E.log "DModRef: %s is not write or deepwrite\n" + typstr); + () + end else + let written = valarr.(0) in + extractModsFromVal fvi fdat c written; + () + with S.Unexpected s -> begin + ignore(E.log "typ not a string: %s\n" s); + () + end + +let dbTryFind (db : B.db) (key : string) : string option = + try Some(B.find db key) + with Not_found -> None + +let getDbData (db : B.db) + (fname : string) + (name : string) : + string option (* this is really database data. not a real string *) + = + let key = "sum_usemod(\""^name^"\",s_func)" in + match dbTryFind db key with + | Some s -> Some s + | None -> begin + let basename = Filename.basename fname in + (* force extension to be .c *) + let basename = + try (Filename.chop_extension basename)^".c" + with Invalid_argument _ -> basename^".c" + in + let key = "sum_usemod(\""^basename^":"^name^"\",s_func)" in + match dbTryFind db key with + | Some s -> Some s + | None -> begin + ignore(E.log "DModRef: Neither %s nor %s were in the database\n" + name (basename^":"^name)); + None + end + end + + +let extractModsFromDB (db : B.db) + (c : DPF.ctxt) + (fdat : DPF.functionData) + (f : file) : + unit + = + let handleFunVi (vi : varinfo) : unit = + if not(isFunctionType vi.vtype) then () else + (* XXX: Also, figure out how to add Modifies(None) annotations! *) + match getDbData db f.fileName vi.vname with + | Some data -> begin + ignore(E.log "DModRef: db found key for %s\n" vi.vname); + match SIO.load_session_str data with + | Some sess -> + S.iter_ext_logic sess (extractModsFromPred vi fdat c) + | None -> begin + ignore(E.log "DModRef: SIO.load_session_str returned None\n") + end + end + | None -> begin + ignore(E.log "DModRef: key for %s was not found in database\n" + vi.vname); + match IH.tryfind fdat.DPF.fdModHash vi.vid with + | Some _ -> begin (* Don't change what's already there *) + ignore(E.log "DModRef: already data about %s\n" + vi.vname); + () + end + | None -> begin + (* If we don't already know about it, and Saturn says it + * doesn't modify anything, then we'll go with that. + * The caveat here is that if Saturn warns us that it + * doesn't know about something, then we have to add a stub + * for it to analyse *) + IH.add fdat.DPF.fdModHash vi.vid ([],[]); + () + end; + () + end + in + List.iter (fun g -> match g with + | GVarDecl(vi, _) -> handleFunVi vi + | GFun(fd, _) -> handleFunVi fd.svar + | _ -> ()) f.globals + + +(* Entry point: find Modifications and add them to the prototypes in + fdat *) +let addAllModifications (fdat : DPF.functionData) (f : file) : unit = + let sumFile = !saturnLogicPath ^ "/sum_usemod.db" in + try + let fd = open_in sumFile in + close_in fd; + let db = Bdb.opendbm None sumFile [ Bdb.Dbm_rdonly ] 0o666 in + let c = DPF.mkGlobalContext f in + extractModsFromDB db c fdat f; + () + with Sys_error msg -> begin + ignore(E.log "DModRef: Could not open database file: %s\n" msg); + () + end + + +(* The functions below are copied from ../zraModRef/dmodref.ml *) +(* helper for modsFromAnnotationsClass *) +let attributeToModVar (c : DPF.ctxt) + (al : attribute list) : + (varinfo list * int list) option + = + let helper a = + let attrParamListToModInfo (apl : attrparam list) : + (varinfo list * int list) + = + let rec helper apl (viacc,iacc) = + match apl with + | [] -> viacc, iacc + | [ACons("None",[])] -> [], [] + | ap :: rst -> begin + match ap with + | ACons(s, []) -> begin + if String.sub s 0 1 = "$" then + let nstr = String.sub s 1 ((String.length s) - 1) in + let n = int_of_string nstr in + helper rst (viacc, n :: iacc) + else try + let vi = Hashtbl.find c.DPF.cGlobMap s in + helper rst (vi :: viacc, iacc) + with Not_found -> begin + helper rst (viacc, iacc) + end + end + | _ -> helper rst (viacc, iacc) + end + in + helper apl ([],[]) + in + match a with + | Attr("Modifies",apl) -> begin + try + if not c.DPF.cInited then + ignore(visitCilFile + (new DPF.globalMapMakerClass c.DPF.cGlobMap) + c.DPF.cFile); + Some(attrParamListToModInfo apl) + with DPF.NotAnExp ap -> begin + ignore(E.log "DModRef: Not an Exp %a\n" d_attrparam ap); + None + end + end + | Attr(s, _) -> begin + None + end + in + (*if al = [] then ignore(E.log "DModRef: No Attributes at all!\n");*) + List.fold_left (fun r a -> + match helper a with + | None -> r + | Some(vilst, ilst) -> Some(vilst, ilst)) + None al + +(* helper for extractModAnnotations *) +class modsFromAnnotationsClass (c : DPF.ctxt) + (fdat : DPF.functionData) = object(self) + inherit nopCilVisitor + + method vvdec (vi : varinfo) = + if isFunctionType vi.vtype then + try + let attrs = typeAttrs vi.vtype in + let modso = attributeToModVar c attrs in + (match modso with + | None -> begin + if !debug then + ignore(E.log "DModRef: no annotations for %s:%d\n" + vi.vname vi.vid); + end + | Some(vilst,ilst) -> begin + if !debug then + ignore(E.log "DModRef: found annotations for %s:%d\n" + vi.vname vi.vid); + (* strip annotation to avoid type errors *) + vi.vtype <- setTypeAttrs vi.vtype (dropAttribute "Modifies" attrs); + IH.replace fdat.DPF.fdModHash vi.vid (vilst,ilst) + end); + SkipChildren + with Not_found -> DoChildren + else DoChildren +end + +(* Entry point: take info from Modifies annotations and add to fdat *) +let extractModAnnotations (fdat : DPF.functionData) + (f : file) : + unit + = + let c = DPF.mkGlobalContext f in + let vis = new modsFromAnnotationsClass c fdat in + ignore(visitCilFile vis f) diff --git a/src/optimizer/modref/zraModRef/dmodref.ml b/src/optimizer/modref/zraModRef/dmodref.ml new file mode 100644 index 0000000..b4f9317 --- /dev/null +++ b/src/optimizer/modref/zraModRef/dmodref.ml @@ -0,0 +1,415 @@ +(* + * dmodref.ml + * + * Figure out what globals and formals a function may modify and reference. + * Add Modifies annotations. + * + *) + + open Cil + open Pretty + open Doptions + open Doptimutil + + module E = Errormsg + module IH = Inthash + + module P = Dptranal + module DPF = Dprecfinder + +let debug = ref false + +(* + * When ignore_inst returns true, then + * the instruction in question has no + * effects on the abstract state. + * When ignore_call returns true, then + * the instruction only has side-effects + * from the assignment if there is one. + *) +let ignore_inst = ref (fun i -> false) +let ignore_call = ref (fun i -> false) + +let registerIgnoreInst (f : instr -> bool) : unit = + let f' = !ignore_inst in + ignore_inst := (fun i -> (f i) || (f' i)) + +let registerIgnoreCall (f : instr -> bool) : unit = + let f' = !ignore_call in + ignore_call := (fun i -> (f i) || (f' i)) + + +let varinfoEqual vi1 vi2 = vi1.vid = vi2.vid + + +(* helper for modFinderVisitor *) +let addViToGlobMod (globmod : varinfo list ref) + (vi : varinfo) : + unit + = + if vi.vglob then + if not(List.exists (varinfoEqual vi) (!globmod)) then + globmod := vi :: (!globmod) + +(* helper for modFinderVisitor *) +let addViToArgMod (argmod : int list ref) + (f : fundec) + (vi : varinfo) : + unit + = + if List.exists (varinfoEqual vi) f.sformals then + if not(List.mem vi.vid (!argmod)) then + match DPF.argToNumber vi f.svar with + | Some i -> argmod := i :: (!argmod) + | None -> () + +let kill (globmod : varinfo list ref) + (argmod : int list ref) + (error : bool ref) : + unit + = + globmod := []; + argmod := []; + error := true + +(* helper for modFinderVisitor *) +let memWrite (globmod : varinfo list ref) + (argmod : int list ref) + (error : bool ref) + (f : fundec) + (ptre : exp) : + bool + = + if not(!doPtrAnalysis) then begin + if !debug then ignore(E.log "DModRef: Pointer Analysis is off\n"); + kill globmod argmod error; + false + end else begin + match P.try_resolve_exp ptre with + | Some dests -> begin + if dests = [] then + if !debug then + ignore(E.log "DModRef: pt-set for %a was empty\n" d_exp ptre); + List.iter (fun vi -> + if !debug then + ignore(E.log "DModRef: %s is a dest of %a\n" + vi.vname d_exp ptre); + addViToGlobMod globmod vi; + addViToArgMod argmod f vi) + dests; + true + end + | None -> begin + kill globmod argmod error; + false + end + end + +(* helper for modFinderVisitor *) +let funCall (fdat : DPF.functionData) + (globmod : varinfo list ref) + (argmod : int list ref) + (error : bool ref) + (f : fundec) + (vf : varinfo) + (args : exp list) : + bool + = + if vf.vname = "__deputy_memset" then begin + match P.try_resolve_exp (List.hd args) with + | Some dests -> begin + List.iter (fun vi -> + addViToGlobMod globmod vi; + addViToArgMod argmod f vi) + dests; + true + end + | None -> begin + kill globmod argmod error; + false + end + end else match IH.tryfind fdat.DPF.fdModHash vf.vid with + | None -> begin + if !debug then + ignore(E.log "DModRef: No data for %s:%d\n" vf.vname vf.vid); + kill globmod argmod error; + false + end + | Some(gm, am) -> begin + List.iter (addViToGlobMod globmod) gm; + List.fold_left (fun b i -> + let ae = List.nth args i in + if not(!doPtrAnalysis) then begin + if !debug then + ignore(E.log "DModRef: Pointer Analysis is off\n"); + kill globmod argmod error; + false + end else + match P.try_resolve_exp ae with + | Some dests -> begin + List.iter (fun vi -> + addViToGlobMod globmod vi; + addViToArgMod argmod f vi) + dests; + b + end + | None -> begin + kill globmod argmod error; + false + end) + true am + end + +(* accumulate globals and arguments modified by f in globmod and argmod. + if error is true after the visitor is run, then this information could not + be determined. If error is false but the lists are empty, then the function + is pure. fdat gives info about other functions. *) +(* helper for funcModificationFinder *) +class modFinderVisitor (fdat : DPF.functionData) + (f : fundec) + (globmod : varinfo list ref) + (argmod : int list ref) + (error : bool ref) = object(self) + inherit nopCilVisitor + + method vinst (i : instr) = + (* If the function writes memory, but no pointer analysis has been done + * then give up. *) + if (!error) && not(!doPtrAnalysis) then SkipChildren else + match i with + | Set((Var vi, _), _, _) -> begin + addViToGlobMod globmod vi; + DoChildren + end + | Set((Mem e, _), _, _) -> begin + if memWrite globmod argmod error f e then + DoChildren + else + SkipChildren + end + | Call(Some(Var vi,_), fe, args, _) -> begin + addViToGlobMod globmod vi; + if (!ignore_call) i then DoChildren else + match fe with + | Lval(Var vf, NoOffset) -> begin + if funCall fdat globmod argmod error f vf args then + DoChildren + else SkipChildren + end + | _ -> begin + if not(!doPtrAnalysis) then begin + if !debug then + ignore(E.log "DModRef: Pointer Analysis is off\n"); + kill globmod argmod error; + SkipChildren + end else begin + match P.try_resolve_funptr fe with + | None -> begin + kill globmod argmod error; + SkipChildren + end + | Some fds -> + let b = List.fold_left (fun b fd -> + b && (funCall fdat globmod argmod error f fd.svar args)) + true fds + in + if b then DoChildren else SkipChildren + end + end + end + | Call(Some(Mem e, off), fe, args, _) -> begin + if memWrite globmod argmod error f e then + if (!ignore_call) i then DoChildren else + match fe with + | Lval(Var vf, NoOffset) -> begin + if funCall fdat globmod argmod error f vf args then + DoChildren + else + SkipChildren + end + | _ -> begin + if not(!doPtrAnalysis) then begin + if !debug then + ignore(E.log "DModRef: Pointer Analysis is off\n"); + kill globmod argmod error; + SkipChildren + end else begin + match P.try_resolve_funptr fe with + | None -> begin + kill globmod argmod error; + SkipChildren + end + | Some fds -> + let b = List.fold_left (fun b fd -> + b && (funCall fdat globmod argmod error f fd.svar args)) + true fds + in + if b then DoChildren else SkipChildren + end + end + else + SkipChildren + end + | Call(None, fe, args, _) -> begin + if (!ignore_call) i then DoChildren else + match fe with + | Lval(Var vf, NoOffset) -> begin + if funCall fdat globmod argmod error f vf args then + DoChildren + else + SkipChildren + end + | _ -> begin + if not(!doPtrAnalysis) then begin + if !debug then + ignore(E.log "DModRef: Pointer Analysis is off\n"); + kill globmod argmod error; + SkipChildren + end else begin + match P.try_resolve_funptr fe with + | None -> begin + kill globmod argmod error; + SkipChildren + end + | Some fds -> + let b = List.fold_left (fun b fd -> + b && (funCall fdat globmod argmod error f fd.svar args)) + true fds + in + if b then DoChildren else SkipChildren + end + end + end + | Asm(_,_,writes,_,_,_) -> begin + (* XXX: fix me! *) + DoChildren + end +end + +(* helper for modificationFinder *) +let funcModificationFinder (fdat : DPF.functionData) (f : fundec) : unit = + let globmod = ref [] in + let argmod = ref [] in + let error = ref false in + let vis = new modFinderVisitor fdat f globmod argmod error in + ignore(visitCilFunction vis f); + if not(!error) then begin + if !debug then + ignore(E.log "DModRef: found some Modifies stuff! %s\n" f.svar.vname); + IH.replace fdat.DPF.fdModHash f.svar.vid (!globmod,!argmod); + match IH.tryfind fdat.DPF.fdFnHash f.svar.vid with + | None -> IH.add fdat.DPF.fdFnHash f.svar.vid (f.svar, true) + | Some _ -> () + end else + if !debug then + ignore(E.log "DModRef: problem with %s\n" f.svar.vname) + +(* helper for addAllModifications. finds Modifications and adds them to + fdat.fdModHash *) +let modificationFinder (fdat : DPF.functionData) (f : file) : unit = + List.iter (fun g -> match g with + | GFun(fd, _ ) -> funcModificationFinder fdat fd + | _ -> ()) f.globals + + +(* Entry point: find Modifications and add them to the prototypes in + fdat *) +let addAllModifications (fdat : DPF.functionData) (f : file) : unit = + modificationFinder fdat f + (*;addModificationAttributes fdat*) + +(* The functions below are also in ../saturnModRef/dmodref.ml *) +(* helper for modsFromAnnotationsClass *) +let attributeToModVar (c : DPF.ctxt) + (al : attribute list) : + (varinfo list * int list) option + = + let helper a = + let attrParamListToModInfo (apl : attrparam list) : + (varinfo list * int list) + = + let rec helper apl (viacc,iacc) = + match apl with + | [] -> viacc, iacc + | [ACons("None",[])] -> [], [] + | ap :: rst -> begin + match ap with + | ACons(s, []) -> begin + if String.sub s 0 1 = "$" then + let nstr = String.sub s 1 ((String.length s) - 1) in + let n = int_of_string nstr in + helper rst (viacc, n :: iacc) + else try + let vi = Hashtbl.find c.DPF.cGlobMap s in + helper rst (vi :: viacc, iacc) + with Not_found -> begin + helper rst (viacc, iacc) + end + end + | _ -> helper rst (viacc, iacc) + end + in + helper apl ([],[]) + in + match a with + | Attr("Modifies",apl) -> begin + try + if not c.DPF.cInited then + ignore(visitCilFile + (new DPF.globalMapMakerClass c.DPF.cGlobMap) + c.DPF.cFile); + Some(attrParamListToModInfo apl) + with DPF.NotAnExp ap -> begin + if !debug then + ignore(E.log "DModRef: Not an Exp %a\n" d_attrparam ap); + None + end + end + | Attr(s, _) -> begin + None + end + in + (*if al = [] then ignore(E.log "DModRef: No Attributes at all!\n");*) + List.fold_left (fun r a -> + match helper a with + | None -> r + | Some(vilst, ilst) -> Some(vilst, ilst)) + None al + +(* helper for extractModAnnotations *) +class modsFromAnnotationsClass (c : DPF.ctxt) + (fdat : DPF.functionData) = object(self) + inherit nopCilVisitor + + method vvdec (vi : varinfo) = + if isFunctionType vi.vtype then + try + let attrs = typeAttrs vi.vtype in + let modso = attributeToModVar c attrs in + (match modso with + | None -> begin + if !debug then + ignore(E.log "DModRef: no annotations for %s:%d\n" + vi.vname vi.vid); + end + | Some(vilst,ilst) -> begin + if !debug then + ignore(E.log "DModRef: found annotations for %s:%d\n" + vi.vname vi.vid); + (* strip annotation to avoid type errors *) + vi.vtype <- setTypeAttrs vi.vtype (dropAttribute "Modifies" attrs); + IH.replace fdat.DPF.fdModHash vi.vid (vilst,ilst) + end); + SkipChildren + with Not_found -> DoChildren + else DoChildren +end + +(* Entry point: take info from Modifies annotations and add to fdat *) +let extractModAnnotations (fdat : DPF.functionData) + (f : file) : + unit + = + let c = DPF.mkGlobalContext f in + let vis = new modsFromAnnotationsClass c fdat in + ignore(visitCilFile vis f) diff --git a/src/optimizer/nullSolver/nullSolverInterface.ml b/src/optimizer/nullSolver/nullSolverInterface.ml new file mode 100644 index 0000000..a94e087 --- /dev/null +++ b/src/optimizer/nullSolver/nullSolverInterface.ml @@ -0,0 +1,11 @@ +(* + * nullSolverInterface.ml + * + * This is the interface of a null solver provided to the Deputy optimizer + * + *) + +(* This is the interface exposed to doptim.ml *) +(* check if (e1 op e2) is valid in state s *) +let valid s op e1 e2 = false + diff --git a/src/optimizer/oct/mineOct/doctanalysis.ml b/src/optimizer/oct/mineOct/doctanalysis.ml new file mode 100644 index 0000000..db4864d --- /dev/null +++ b/src/optimizer/oct/mineOct/doctanalysis.ml @@ -0,0 +1,1215 @@ +(* + * + * Copyright (c) 2004, + * Jeremy Condit + * George C. Necula + * 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. + * + *) + +(* + * + * doctanalysis.ml + * + * An octogon analysis using the library by Antoine Mine' + * + * + *) + +open Cil +open Expcompare +open Pretty +open Dattrs +open Dutil +open Dcheckdef +open Doptimutil +open Doptions + +open Dflowinsens + +module E = Errormsg +module IH = Inthash +module P = Dptranal +module DF = Dataflow +module S = Stats +module DCE = Dcanonexp +module AELV = Availexpslv +module H = Hashtbl +module UF = Unionfind +module DFF = Dfailfinder +module SI = SolverInterface +module DPF = Dprecfinder + +module O = Oct + +module LvHash = + H.Make(struct + type t = lval + let equal lv1 lv2 = compareLval lv1 lv2 + let hash = H.hash + end) + +module LvSet = + Set.Make(struct + type t = lval + let compare = Pervasives.compare + end) + +module LvUf = UF.Make(LvSet) + +(* A mapping from lvals to the family(list) of lvals + that the lval belongs to *) +type lvalFams = lval list ref LvHash.t + + +(* The abstract state for one family of lvals *) +type smallState = { + (* The octagon *) + mutable octagon: O.oct; + + (* The mapping from lvals to octagon variables *) + lvHash: int LvHash.t; + } + +(* A mapping from each lval to the abstract state for + * its family *) +type absState = { + (* the state for each lv *) + lvState: smallState ref LvHash.t; + + (* A list of small states for easy iteration, etc. *) + smallStates: smallState ref list + } + +let debug = ref false + +let doTime = ref true + +let time s f x = if !doTime then S.time s f x else f x + + +(* + * When ignore_inst returns true, then + * the instruction in question has no + * effects on the abstract state. + * When ignore_call returns true, then + * the instruction only has side-effects + * from the assignment if there is one. + *) +let ignore_inst = ref (fun i -> false) +let ignore_call = ref (fun i -> false) + +let registerIgnoreInst (f : instr -> bool) : unit = + let f' = !ignore_inst in + ignore_inst := (fun i -> (f i) || (f' i)) + +let registerIgnoreCall (f : instr -> bool) : unit = + let f' = !ignore_call in + ignore_call := (fun i -> (f i) || (f' i)) + +(* unit -> bool *) +(* This should be called from doptimmain before doing anything *) +let init = O.init + +(* This indicates that this module actualy does something *) +let real = true + +let octprinter = + O.foctprinter (fun i -> "v"^(string_of_int i)) + Format.str_formatter + +let d_oct () (o: O.oct) = + octprinter o; + text (Format.flush_str_formatter()) + +let d_state () (a:absState) = + List.fold_left (fun d sSr -> + if O.is_universe (!sSr).octagon then + d ++ text "-> Universe" + ++ line + else if O.is_empty (!sSr).octagon then + d ++ text "-> Empty" + ++ line + else begin + octprinter (!sSr).octagon; + d ++ text ("-> "^(Format.flush_str_formatter())) + ++ line + end) nil a.smallStates + +let d_vnum () (v:O.vnum) = + O.fvnumprinter Format.str_formatter v; + text (Format.flush_str_formatter()) ++ line + +let lvHashRevLookup (lvih : int LvHash.t) (i : int) : lval option = + LvHash.fold (fun lv j lvo -> if i = j then (Some lv) else lvo) + lvih None + + +(* Convert an octagon to a list of Cil expressions embodying the constraints *) +let octToBinOpList (a : absState) : exp list = + List.fold_left (fun el sSr -> + let o = (!sSr).octagon in + let lvih = (!sSr).lvHash in + let nel = ref [] in + let n = O.dim o in + if O.is_empty o then el else begin + for i = 0 to n - 1 do + let m_ij = O.get_elem o (2*i + 1) (2*i) in + match O.int_of_num m_ij with + | None -> () + | Some m_ij -> begin + match lvHashRevLookup lvih i with + | Some lv_i -> + let e_i = Lval lv_i in + let ineq = BinOp(Le, e_i, integer m_ij, intType) in + nel := ineq :: (!nel) + | _ -> () + end + done; + for i = 0 to n - 1 do + for j = 0 to i - 1 do + let m_ij = O.get_elem o (2*j) (2*i) in + (match O.int_of_num m_ij with + | None -> () + | Some m_ij -> begin + (* v_i - v_j <= m_ij *) + (* Reverse lookup in lvih for the lvals of v_j and v_i, + then build an expression and add it to the list *) + match lvHashRevLookup lvih i, lvHashRevLookup lvih j with + | Some lv_i, Some lv_j -> + let e_i = Lval lv_i in + let e_j = Lval lv_j in + let diff = BinOp(MinusA, e_i, e_j, intType) in + let ineq = BinOp(Le, diff, integer m_ij, intType) in + nel := ineq :: (!nel) + | _, _ -> () + end); + let m_ij = O.get_elem o (2*j+1) (2*i) in + (match O.int_of_num m_ij with + | None -> () + | Some m_ij -> begin + (* v_i + v_j <= m_ij *) + match lvHashRevLookup lvih i, lvHashRevLookup lvih j with + | Some lv_i, Some lv_j -> + let e_i = Lval lv_i in + let e_j = Lval lv_j in + let sum = BinOp(PlusA, e_i, e_j, intType) in + let ineq = BinOp(Le, sum, integer m_ij, intType) in + nel := ineq :: (!nel) + | _, _ -> () + end) + done + done; + el @ (!nel) + end) + [] a.smallStates + + +(* Forget the state for any lval that mentions lv *) +let forgetLval (a: absState) (lv: lval) : absState = + List.iter (fun sSr -> + let newoct = LvHash.fold (fun elv id o -> + if AELV.exp_has_lval lv (Lval elv) then + time "oct-forget" (O.forget o) id + else o) (!sSr).lvHash (!sSr).octagon + in + (!sSr).octagon <- newoct) a.smallStates; + a + +let forgetMem ?(globalsToo : bool=false) + (a : absState) + (eo : exp option) (* e is being written if (Some e) *) + : absState + = + List.iter (fun sSr -> + let newoct = LvHash.fold (fun elv id o -> + if !doPtrAnalysis then + match eo with + | Some ee -> + if P.lval_has_alias_read ee elv then begin + time "oct-forget" (O.forget o) id + end else o + | None -> + if AELV.lval_has_mem_read elv then + time "oct-forget" (O.forget o) id + else o + else if AELV.lval_has_mem_read elv then + time "oct-forget" (O.forget o) id + else o) + (!sSr).lvHash (!sSr).octagon + in + (!sSr).octagon <- newoct)a.smallStates; + a + + +let stateMap : absState IH.t = IH.create 50 + + +let rec gcd a b = + if b = 0 then a else gcd b (a mod b) + +(* find the gcd of the non-zero elements of the array *) +let arrayGCD (a: int array) = + Array.fold_left (fun g x -> + if x = 0 then g else + if g = 0 then (abs x) else gcd g (abs x)) 0 a + +(* divide each non-zero element of the array by the gcd of + all the non-zero elements of the array *) +let divByGCD (a: int array) = + let gcd = arrayGCD a in + if gcd = 0 then a else + Array.map (fun x -> x / gcd) a + + +exception BadConExp +(* Take a canonicalized expression and return a list of lval ids and coefficients + * along with the smallState for their family. If not all lvals are from + * the same family, or if the canonicalized expression isn't of the form we need + * then raise BadConExp. *) +let getCoefIdList (cdiff: DCE.Can.t) (state: absState) + : (int * int) list * smallState ref + = + (* Make a list of (id, coef) pairs *) + let sSror = ref None in (* For Sanity Checking *) + let id_coef_lst = + List.map (fun (f, e) -> + match e with + | StartOf lv + | Lval lv -> begin + try + let sSr = LvHash.find state.lvState lv in + let id = LvHash.find (!sSr).lvHash lv in + (* Sanity Check! Make sure all lvals are in + * the same family. For loop conditions that don't matter + * it's okay if they're not, though. *) + if true then begin + match (!sSror) with + | None -> sSror := Some sSr + | Some sSr' -> if not(sSr' == sSr) then begin + if !debug then + ignore(E.log "Not all lvals in the same family!! %a in %a\n" + d_lval lv DCE.Can.d_t cdiff); + raise BadConExp + end + end; + (id, Int64.to_int f) (* TODO: mine's oct lib doesn't do 64-bits? *) + with Not_found -> begin + (* If this happens, it is likely a failure in + expression canonicalization. *) + if not(LvHash.mem state.lvState lv) && !debug then + warn "lval not in hash in getCoefIdList: %a\n" d_lval lv + else if !debug then + warn "lval not in smallState for itself?!: %a\n" d_lval lv; + raise BadConExp + end + end + | _ -> begin + if !debug then + ignore(E.log "Non lv in canon exp\n"); + raise BadConExp + end) cdiff.DCE.Can.cf + in + + (* get the small state of interest *) + let sSr = + match (!sSror) with + | None -> raise BadConExp + | Some sSr -> sSr + in + (id_coef_lst, sSr) + + +(* Given a canonicalized expression, make a vnum of + * coefs and return the smallState that the lvals in + * the expression belong to *) +let makeCoefVnum (cdiff: DCE.Can.t) (state: absState) + : O.vnum * smallState ref + = + let (id_coefs_lst, sSr) = getCoefIdList cdiff state in + (* make an array of coefficients. The last elemens is the constant *) + let numcs = O.dim (!sSr).octagon in + let coefs = Array.make (numcs + 1) 0 in + + (* add coefs to the array *) + List.iter (fun (id, f) -> coefs.(id) <- f) id_coefs_lst; + + (* Add the constant term *) + coefs.(numcs) <- Int64.to_int cdiff.DCE.Can.ct; (* TODO: 64-bits *) + + (* Try to make all of the coefs +/-1 *) + let coefs = divByGCD coefs in + + (* If any but the constant term are not +/-1 or 0, then + raise BadConExp, which will return false and not update state *) +(* let cs = Array.sub coefs 0 numcs in + let hasBadE = Array.fold_left + (fun b i -> b || (abs i <> 1 && i <> 0)) false cs + in + if hasBadE then begin + if !debug then + ignore(E.log "makeCoefVnum: bad coef %a\n" DCE.Can.d_t cdiff); + raise BadConExp + end else*) + + (* convert coefs to something that the Octagon library understands *) + let octcoefs = O.vnum_of_int coefs in + (octcoefs, sSr) + +let findCounterExamples (a : absState) + (ce1 : DCE.Can.t) + (ce2 : DCE.Can.t) : doc option = + if !debug then + ignore(E.log "findCounterExamples: converting oct to binop list\n"); + let el = octToBinOpList a in + if !debug then + ignore(E.log "findCounterExamples: calling DFF.failCheck\n"); + if SI.is_real then begin + let ce = DCE.Can.sub ce2 ce1 ILong in + let eil = DFF.failCheck el ce in + if eil = [] then None else begin + let d = List.fold_left (fun d (e, i) -> + d ++ text "\t" ++ d_exp () e ++ text " = " ++ num i ++ line) + (text "Check will fail when:" ++ line) eil + in + Some d + end + end else begin + try + let ce = DCE.Can.sub ce1 ce2 ILong in + let ce = DCE.Can.sub ce (DCE.Can.mkInt Int64.one ILong) ILong in + let (enoughFacts, _) = DFF.checkFacts el ce in + if not enoughFacts then None else + let (octcoefs, sSr) = makeCoefVnum ce a in + let newoct = O.add_constraint (!sSr).octagon octcoefs in + if O.is_empty newoct then None else + (*if O.is_included_in (!sSr).octagon newoct then + Some (text "\n\nCHECK WILL ALWAYS FAIL\n\n") else*) + let newbox = O.int_of_vnum (O.get_box newoct) in + let oldbox = O.int_of_vnum (O.get_box (!sSr.octagon)) in + let n = O.dim newoct in + let d = ref nil in + if !debug then + ignore(E.log "findCounterExamples: looping over octagon: %d\n" + n); + for i = 0 to n - 1 do + match lvHashRevLookup (!sSr).lvHash i with + | None -> () + | Some lv -> begin + let newlo = newbox.(2*i + 1) in + let newhi = newbox.(2*i) in + let oldlo = oldbox.(2*i + 1) in + let oldhi = oldbox.(2*i) in + match newlo, newhi with + | None, Some hi -> + if newhi <> oldhi || newlo <> oldlo then () + (*d := !d ++ text "\t" ++ dx_lval () lv ++ text " <= " + ++ num hi ++ line*) + | Some lo, None -> + if newlo <> oldlo || newhi <> oldhi then () + (*d := !d ++ text "\t" ++ num (-lo) ++ text " <= " + ++ dx_lval () lv ++ line*) + | Some lo, Some hi -> + if (newlo <> oldlo || newhi <> oldhi) && + hi - (-lo) <= 10 + then + d := !d ++ text "\t" ++ num (-lo) ++ text " <= " + ++ dx_lval () lv ++ text " <= " ++ num hi + ++ line + | _, _ -> () + end + done; + if !d <> nil then begin + let d = text "Check will fail when:\n" ++ (!d) in + Some d + end else None + with + | BadConExp -> None + end + +(* Check that e1 <= e2 in state "state" + * fst(doExpLeq false e1 e2 s) is true if e1 <= e2 can be proved + * snd(doExpLeq true e1 e2 s) is the state with e1 <= e2 added. + * fst(doExpLeq true e1 e2 s) is false if the state couldn't be updated. + * + * Remember the invariant that all lvals that will be compared here will + * be in the same family. (If they aren't, it is a bug) + *) +let totalChecks = ref 0 +let totalAssert = ref 0 +let octoCheckInsuf = ref 0 +let octoAssertInsuf = ref 0 +let interAssertInsuf = ref 0 +let interCheckInsuf = ref 0 +let doExpLeq ?(modify : bool = false) + ?(fCE : bool = true) + (e1 : exp) + (e2 : exp) + (state : absState) + : bool * absState * doc option + = + if modify then incr totalChecks else incr totalAssert; + try + let ce1 = DCE.canonExp Int64.one e1 in + let ce2 = DCE.canonExp Int64.one e2 in + let cdiff = DCE.Can.sub ce2 ce1 ILong in + (* if modify is true then add the fact that cdiff >= 0, + if modify is false return true iff absState can show that cdiff >= 0 *) + + (* May raise BadConExp *) + if !debug then ignore(E.log "doExpLeq: %a\n" DCE.Can.d_t cdiff); + let canonSign = DCE.Can.getSign cdiff in + if canonSign = DCE.Can.Pos || canonSign = DCE.Can.Zero then (true, state, None) else + let (octcoefs, sSr) = makeCoefVnum cdiff state in + + if List.length cdiff.DCE.Can.cf > 1 then begin + if modify then incr interCheckInsuf else incr interAssertInsuf + end; + + (* if modify is true, then add the information to the state, + otherwise check if the inequality holds *) + if modify then begin + let newoct = time "oct-add-constraint" (O.add_constraint (!sSr).octagon) octcoefs in + if !debug then ignore(E.log "doExpLeq: adding %a >= 0 to %a to get %a\n" + DCE.Can.d_t cdiff d_oct (!sSr).octagon d_oct newoct); + (!sSr).octagon <- newoct; + (true, state, None) + end else begin + if !debug then ignore(E.log "doExpLeq: coefs = %a\n" d_vnum octcoefs); + if !debug then ignore(E.log "adding %a >= 0\n" DCE.Can.d_t cdiff); + let testoct = time "oct-add-constraint" (O.add_constraint (!sSr).octagon) octcoefs in + if !debug then ignore(E.log "is %a included in %a?\n" + d_oct (!sSr).octagon d_oct testoct); + if time "oct-inclusion" (O.is_included_in (!sSr).octagon) testoct && + not(O.is_empty testoct) && not(O.is_universe testoct) + then begin + if !debug then ignore(E.log "Yes!\n"); + (true, state, None) + end else begin + if !debug then ignore(E.log "No!\n"); + try + if !debug then ignore(E.log "doExpLeq: finding counterexamples\n"); + let docoption = + if fCE then + findCounterExamples state ce1 ce2 + else None + in + (*let docoption = None in*) + if !debug then ignore(E.log "doExpLeq: done finding counterexamples\n"); + (false, state, docoption) + with ex -> begin + ignore(E.log "doExpLeq: findCounterEamples raised %s\n" + (Printexc.to_string ex)); + raise ex + end + end + end + with + | BadConExp -> begin + if modify then incr octoCheckInsuf else incr octoAssertInsuf; + if modify then incr interCheckInsuf else incr interAssertInsuf; + (false, state, None) + end + +let fst3 (f,s,t) = f +let snd3 (f,s,t) = s +let trd3 (f,s,t) = t + +(* FIXME: use the sign info! E.g. add e1 >= 0 *) +let doLessEq a (e1: exp) (e2:exp) ~(signed:bool): absState = +(* log "Guard %a <= %a.\n" dx_exp e1 dx_exp e2; *) + snd3(doExpLeq ~modify:true e1 e2 a) + + +let doLess a (e1: exp) (e2:exp) ~(signed:bool): absState = +(* log "Guard %a < %a.\n" d_plainexp e1 d_plainexp e2; *) + match unrollType (typeOf e1) with + | TPtr _ -> snd3(doExpLeq ~modify:true (BinOp(PlusPI,e1,one,typeOf e1)) e2 a) + | TInt _ -> snd3(doExpLeq ~modify:true (BinOp(PlusA,e1,one,typeOf e1)) e2 a) + | _ -> a + +let isNonNull state e: bool = false +(* +(* log "isNonNull? on %a.\n" d_plainexp e; *) + (isNonnullType (typeOf e)) || + (match stripNopCasts e with + | BinOp((PlusPI|IndexPI|MinusPI), e1, e2, _) -> + (* We've disallowed ptr arith if e1 is null. *) + let t1 = typeOf e1 in + isPointerType t1 && not (isSentinelType t1) + | AddrOf lv + | StartOf lv -> true + | Const(CStr _) -> true + | _ -> fst(doExpLeq one e state)) +*) + +let isFalse state e = + match e with + UnOp(LNot, e', _) -> isNonNull state e' + | _ -> isZero e + + +let addNonNull (state:absState) (lv: lval) : absState = state + (*snd(doExpLeq ~modify:true one (Lval lv) state)*) + + +(* Turn a conjunction into a list of conjuncts *) +let expToConjList (e:exp) : (exp list) = + let rec helper e l = + match e with + | BinOp(LAnd, e1, e2, _) -> + let l1 = helper e1 [] in + let l2 = helper e2 [] in + l@l1@l2 + | _ -> e::l + in + helper e [] + +let rec simplifyBoolExp e = + match stripNopCasts e with + UnOp(LNot, UnOp(LNot, e, _), _) -> simplifyBoolExp e + | BinOp(Ne, e, z, _) when isZero z -> simplifyBoolExp e + | UnOp(LNot, BinOp(Eq, e, z, _), _) when isZero z -> simplifyBoolExp e + | UnOp(LNot, BinOp(Lt, e1, e2, t), _) -> + BinOp(Ge, e1, e2, t) + | UnOp(LNot, BinOp(Le, e1, e2, t), _) -> + BinOp(Gt, e1, e2, t) + | UnOp(LNot, BinOp(Gt, e1, e2, t), _) -> + BinOp(Le, e1, e2, t) + | UnOp(LNot, BinOp(Ge, e1, e2, t), _) -> + BinOp(Lt, e1, e2, t) + | e -> e + +let doOneBranch (a:absState) (e:exp) : absState = + if !debug then + log "Guard %a.\n" dx_exp e; + let e = simplifyBoolExp e in + match e with + | BinOp(Lt, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLess a e1 e2 ~signed:(isSignedType (typeOf e1)) + | BinOp(Le, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLessEq a e1 e2 ~signed:(isSignedType (typeOf e1)) + | BinOp(Gt, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLess a e2 e1 ~signed:(isSignedType (typeOf e1)) + | BinOp(Ge, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let e1 = stripNopCasts e1 in + let e2 = stripNopCasts e2 in + doLessEq a e2 e1 ~signed:(isSignedType (typeOf e1)) + | Lval lv -> + doLess a zero (Lval lv) ~signed:(isSignedType (typeOf (Lval lv))) + | _ -> (* TODO: Add things here for BinOp(Eq, Ne) and Lval *) + a + +(* Update a state to reflect a branch *) +let doBranch (a:absState) (e:exp) : absState = + let conjList = expToConjList e in + List.fold_left doOneBranch a conjList + +(* Add that + * lv >= e1 and + * lv >= e2 + *) +let doMax a lv e1 e2 = + let a' = doLessEq a e1 (Lval lv) ~signed:(isSignedType(typeOf e1)) in + let a' = doLessEq a' e2 (Lval lv) ~signed:(isSignedType(typeOf e2)) in + a' + + +(* Update a state to reflect a check *) +let processCheck a (c:check) : absState = + match c with + (*CNonNull e -> doBranch a e*) + | CLeq(e1, e2, _) -> doLessEq a e1 e2 ~signed:false + | CLeqInt(e1, e2, _) -> doLessEq a e1 e2 ~signed:false + | CPtrArith(lo, hi, p, e, _) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + let a = doLessEq a lo e' ~signed:false in + doLessEq a e' hi ~signed:false + | CPtrArithNT(lo, hi, p, e, _) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + let a = doLessEq a lo e' ~signed:false in + a (* no upper bound *) + | CPtrArithAccess(lo, hi, p, e, _) -> + let e' = BinOp(PlusPI,p,e,typeOf p) in + let a = doLessEq a lo e' ~signed: false in + doLessEq a (BinOp(PlusPI,p,BinOp(PlusA,e,one,typeOf e),typeOf p)) hi ~signed:false + | _ -> a + +(* Add to anext any relevant inequality information for the assignment + dest := e +*) +let doSet ~(state: absState) (dest: lval) (e:exp) : absState = + if !debug then log "doSet: %a := %a\n" dx_lval dest dx_exp e; + let ce = DCE.canonExp Int64.one e in + let cdest = DCE.canonExp Int64.one (Lval dest) in + + let dlv = + match cdest.DCE.Can.cf with + | [(_,e)] -> begin + match e with + | Lval lv | StartOf lv | AddrOf lv -> lv + | _ -> begin + ignore(E.log "doSet: bad lval %a\n" d_plainexp e); + raise BadConExp + end + end + | _ -> begin + if !debug then + ignore(E.log "doSet: bad canon lval %a" d_plainexp e); + raise BadConExp + end + in + try + let (octcoefs, sSr) = + match ce.DCE.Can.cf with + | [] -> begin + let sSr = LvHash.find state.lvState dlv in + let numcs = O.dim (!sSr).octagon in + let coefs = Array.make (numcs + 1) 0 in + coefs.(numcs) <- Int64.to_int ce.DCE.Can.ct; + let octcoefs = O.vnum_of_int coefs in + (octcoefs, sSr) + end + | _ -> makeCoefVnum ce state + in + let destid = LvHash.find (!sSr).lvHash dlv in + + (* do the assignment! *) (* TODO: check for overflow *) + let newoct = time "oct-assign" (O.assign_var (!sSr).octagon destid) octcoefs in + if !debug then ignore(E.log "doSet: {%a} %a <- %a {%a}\n" + d_oct (!sSr).octagon d_lval dest d_exp e d_oct newoct); + (!sSr).octagon <- newoct; + state + with + | BadConExp -> begin + if !debug then + ignore(E.log "doSet: BadConExp: %a\n" DCE.Can.d_t ce); + state + end + | Not_found -> + if !debug then + ignore(E.log "doSet: %a should be in the same family as %a" + d_lval dlv DCE.Can.d_t ce); + state + +let int_list_union l1 l2 = + List.fold_left (fun l x -> + if List.mem x l then l else x :: l) l1 l2 + +let vi_list_union l1 l2 = + List.fold_left (fun l x -> + if List.exists (fun vi -> vi.vid = x.vid) l then l else x :: l) + l1 l2 + + +let handleCall = P.handleCall (forgetMem ~globalsToo:true) + + +(* fdato is set in doOctAnalysis. + Easier for it to be a global b/c of dataflow functor *) +let fdato : DPF.functionData option ref = ref None +let flowHandleInstr a i = + (* E.log "Doing instr %a in state %a\n" d_instr i d_state a; *) + match instrToCheck i with + | Some c -> processCheck a c + | None -> begin + match i with + | Set (lh, e, _) when compareExpStripCasts (Lval lh) e -> a + | Set ((Var _, _) as dest, e, _) -> + let anext = forgetLval a dest in + doSet ~state:anext dest e + | Set ((Mem e, _), _, _) -> + forgetMem a (Some e) + | Call (Some(Var vi, NoOffset), Lval(Var vf, NoOffset), [e1;e2], _) + when vf.vname = "deputy_max" -> begin + let a' = forgetLval a (Var vi, NoOffset) in + doMax a' (Var vi, NoOffset) e1 e2 + end + | Call (Some (Var vi, NoOffset), f, args, _) when isPointerType vi.vtype -> + let a = + if is_deputy_instr i || (!ignore_call) i then + forgetLval a (Var vi, NoOffset) + else + handleCall (!fdato) f args (forgetLval a (Var vi, NoOffset)) + (*forgetMem ~globalsToo:true (forgetLval a (Var vi, NoOffset)) + None*) + in + let rt, _, _, _ = splitFunctionType (typeOf f) in + if isNonnullType rt then + addNonNull a (Var vi, NoOffset) + else + a + | Call (Some lv, f, args, _) -> + if !ignore_call i || is_deputy_instr i then + forgetLval a lv + else + handleCall (!fdato) f args (forgetLval a lv) + (*forgetMem ~globalsToo:true (forgetLval a lv)*) + | Call (_, f, args, _) -> + if (!ignore_call) i || is_deputy_instr i then a else + handleCall (!fdato) f args a + (*forgetMem ~globalsToo:true a None*) + | Asm (_, _, writes, _, _, _) -> + (* This is a quasi-sound handling of inline assembly *) + let a = forgetMem a None in + List.fold_left (fun a (_,_,lv) -> + forgetLval a lv) a writes + end + +(* make a copy of the absState *) +let absStateCopy (a: absState) = + (* make copy of list *) + let newSSRList = List.map (fun sSr -> + let newoct = (!sSr).octagon in + let newhash = (!sSr).lvHash in + let newSS = {octagon = newoct; lvHash = newhash} in + ref newSS) a.smallStates + in + (* zip up with old list *) + let newold = List.combine newSSRList a.smallStates in + let newFromOld old = fst(List.find (fun (n,o) -> old == o) newold) in + (* Iter through old hash table to make new hash table *) + let newSSHash = LvHash.create 10 in + LvHash.iter (fun lv sSr -> + LvHash.add newSSHash lv (newFromOld sSr)) a.lvState; + {lvState = newSSHash; smallStates = newSSRList} + +let absStateEqual (a1: absState) (a2: absState) = + (* Check that each of the octagons are the same *) + let not_equal = + List.exists (fun (sSr1,sSr2) -> + not(O.is_equal (!sSr1).octagon (!sSr2).octagon)) + (List.combine a1.smallStates a2.smallStates) + in + not(not_equal) + +let absStateWiden (old: absState) (newa: absState) = + List.iter (fun (old_sSr, new_sSr) -> + (!new_sSr).octagon <- + O.widening (!old_sSr).octagon (!new_sSr).octagon O.WidenFast) + (List.combine old.smallStates newa.smallStates) + +let absStateUnion (old: absState) (newa: absState) = + List.iter (fun (old_sSr, new_sSr) -> + (!new_sSr).octagon <- + O.union (!old_sSr).octagon (!new_sSr).octagon) + (List.combine old.smallStates newa.smallStates) + +module Flow = struct + let name = "DeputyOpt" + let debug = debug + type t = absState + let copy = time "oct-copy" absStateCopy + let stmtStartData = stateMap + let pretty = d_state + let computeFirstPredecessor s a = a + + let combinePredecessors s ~(old:t) newa = + if time "oct-equal" (absStateEqual old) newa then None else + match s.skind with + | Loop(b, l, so1, so2) -> begin + if !debug then ignore(E.log "widening at sid: %d\n" s.sid); + time "oct-widen" (absStateWiden old) newa; + Some newa + end + | _ -> begin + time "oct-union" (absStateUnion old) newa; + Some newa + end + + let doInstr i a = + if !debug then ignore(E.log "Visiting %a State is %a.\n" dn_instr i d_state a); + let newstate = flowHandleInstr a i in + DF.Done (newstate) + + let doStmt s a = + curStmt := s.sid; + DF.SDefault + + let doGuard e a = + if isFalse a e then DF.GUnreachable + else DF.GUse (doBranch (copy a) e) + + let filterStmt s = true +end + +module FlowEngine = DF.ForwardsDataFlow (Flow) + +let printFailCond (tl : (bool * absState * doc option) list) + (c : check) + : bool + = + let ci = checkToInstr c in + List.fold_left (fun b1 (b2, _, fco) -> + (match fco with + | Some fc -> ignore(E.log "%a\n%t" dt_instr ci (fun () -> fc)) + | None -> ()); + b1 && b2) + true tl + + +let flowOptimizeCheck (c: check) ((inState, acc):(absState * check list)) + : (absState * check list) = + let isNonNull = isNonNull inState in + (* Returns true if CPtrArith(lo, hi, p, Lval x, sz) can be optimized away:*) + let checkPtrArith lo hi p e : bool = + let e' = BinOp(PlusPI,p,e,typeOf p) in + printFailCond [doExpLeq lo e' inState; doExpLeq e' hi inState] c + in + (* Returns true if CPtrArithAccess(lo, hi, p, Lval x, sz) can be optimized away:*) + let checkPtrArithAccess lo hi p e : bool = + let e' = BinOp(PlusPI,p,e,typeOf p) in + let e'' = BinOp(PlusPI,p,BinOp(PlusA,e,one,typeOf e),typeOf p) in + printFailCond [doExpLeq lo e' inState; doExpLeq e'' hi inState] c + in + let checkPtrArithNT lo hi p e : bool = + let e' = BinOp(PlusPI,p,e,typeOf p) in + printFailCond [doExpLeq lo e' inState; doExpLeq ~fCE:false e' hi inState] c + in + (* Returns true if CLeq(e1, e2) can be optimized away:*) + let checkLeq ?(fCE: bool = true) e1 e2 : bool = + printFailCond [doExpLeq ~fCE:fCE e1 e2 inState] c + in + + (* doOpt is called recursivly if we simplify the check to a different check + that has its own optimization rule. + It returns the simplified check, or None if we satisfied the check + completely.*) + let rec doOpt (c : check) : check option = + match c with + | CNonNull (e1) when isNonNull e1 -> + None + | CNonNull (e1) when isZero e1 -> + error "non-null check will always fail."; + Some c + | CNullOrLeq (e1, _, _, why) + | CNullOrLeqNT (e1, _, _, _, why) when isZero e1 -> + None + | CNullOrLeq (e1, e2, e3, why) when isNonNull e1 -> + doOpt (CLeq(e2, e3, why)) + | CNullOrLeqNT (e1, e2, e3, e4, why) when isNonNull e1 -> + let c' = CLeqNT(e2, e3, e4, why) in + doOpt c' + | CPtrArithAccess(lo,hi,p,e,sz) when checkPtrArithAccess lo hi p e -> + None + | CPtrArith(lo, hi, p, e, sz) when checkPtrArith lo hi p e -> + None + | CPtrArithNT(lo, hi, p, e, sz) when checkPtrArithNT lo hi p e -> + None + | CLeqNT(e1,e2,_,_) when checkLeq ~fCE:false e1 e2 -> + None + | CLeq(e1, e2, _) + | CNullOrLeq(_, e1, e2, _) + | CNullOrLeqNT(_, e1, e2, _, _) when checkLeq e1 e2 -> + None + | CLeqInt(e1, (BinOp (MinusPP, hi, p, _)), _) -> + let e' = BinOp(PlusPI, p, e1, (typeOf p)) in + if checkLeq e' hi then + None + else + Some c + | _ -> Some c + in + let acc' = match doOpt c with + Some c -> c::acc | None -> acc + in + (processCheck inState c), acc' + + + + + +class flowOptimizeVisitor tryReverse = object (self) + inherit nopCilVisitor + + val mutable curSid = -1 + + method vstmt s = + (* now that checks and instructions can be mixed, + * the state has to be changed when an instruction is + * visited *) + let rec filterIl state il fl = + match il with + | [] -> List.rev fl + | i::rest -> begin + if !debug then ignore(E.log "filterIL: looking at %a in state %a\n" + d_instr i d_state state); + match instrToCheck i with + | Some c -> begin + let _, c' = flowOptimizeCheck c (state,[]) in + let new_state = flowHandleInstr state i in + match c' with + | [] -> begin + if !debug then ignore(E.log "fOV: in state %a, optimized %a out\n" + d_state state d_instr i); + filterIl new_state rest fl + end + | [nc] -> begin + let i' = checkToInstr nc in + if !debug then ignore(E.log "fOV: changed to %a out\n" d_instr i'); + filterIl new_state rest (i'::fl) + end + | _ -> begin + if !debug then ignore(E.log "fOV: didn't optimize %a out\n" d_instr i); + filterIl new_state rest (i::fl) + end + end + | None -> + let new_state = flowHandleInstr state i in + filterIl new_state rest (i::fl) + end + in + begin + try + curSid <- s.sid; + let state = IH.find stateMap s.sid in + if !debug then + E.log "Optimizing statement %d with state %a\n" s.sid d_state state; + begin + match s.skind with + | If(e, blk1, blk2, l) when isNonNull state e -> + if hasALabel blk2 then + s.skind <- If(Cil.one, blk1, blk2, l) + else + (* blk2 is unreachable *) + s.skind <- Block blk1 + | If(e, blk1, blk2, l) when isFalse state e -> + if hasALabel blk1 then + s.skind <- If(Cil.zero, blk1, blk2, l) + else + (* blk1 is unreachable *) + s.skind <- Block blk2 + | Instr il -> + if tryReverse then + let il' = filterIl state il [] in + let (pre, rst) = prefix is_check_instr il' in + let il'' = filterIl state (List.rev pre) [] in + s.skind <- Instr((List.rev il'')@rst) + else + s.skind <- Instr(filterIl state il []) + | _ -> () + end + with Not_found -> () (* stmt is unreachable *) + end; + DoChildren + + method vfunc fd = + curFunc := fd; + let cleanup x = + curFunc := dummyFunDec; + x + in + ChangeDoChildrenPost (fd, cleanup) + +end + + +(* lvh is a mapping from lvals to lval list refs *) +class lvalFamilyMakerClass lvh = object(self) + inherit nopCilVisitor + + val mutable singCondVar = None + + method private makeFamily ?(sing:bool=false) (ce: DCE.Can.t) = + (*if !debug then ignore(E.log "Making family for: %a\n" DCE.Can.d_t ce);*) + if sing then match ce.DCE.Can.cf with + | [(_, StartOf lv)] + | [(_, Lval lv)] -> singCondVar <- Some lv + | _ -> () + else + List.iter (fun (_,e1) -> + List.iter (fun (_,e2) -> + match e1, e2 with + | Lval lv1, Lval lv2 + | Lval lv1, StartOf lv2 + | Lval lv1, AddrOf lv2 + | StartOf lv1, Lval lv2 + | StartOf lv1, StartOf lv2 + | StartOf lv1, AddrOf lv2 + | AddrOf lv1, Lval lv2 + | AddrOf lv1, StartOf lv2 + | AddrOf lv1, AddrOf lv2 -> begin + match lv1, lv2 with + | (Var vi, NoOffset), _ when vi.vname = "__LOCATION__" -> () + | _, (Var vi, NoOffset) when vi.vname = "__LOCATION__" -> () + | _ -> begin + match singCondVar with + | None -> + lvh := LvUf.make_equal (!lvh) lv1 lv2 Ptrnode.mkRIdent + | Some lv -> + let tlvh = LvUf.make_equal (!lvh) lv1 lv Ptrnode.mkRIdent in + lvh := LvUf.make_equal tlvh lv1 lv2 Ptrnode.mkRIdent + end + end + | _, _ -> ()) ce.DCE.Can.cf) ce.DCE.Can.cf + + (* use the lvals we get from canonicalized expressions *) + method vexpr e = + let ce = DCE.canonExp Int64.one e in + self#makeFamily ce; + DoChildren + + method vinst i = + match i with + | Set(lv, e, _) -> begin + let ce = DCE.canonExp Int64.one e in + let lvce = DCE.canonExp Int64.one (Lval lv) in + let ce = {ce with DCE.Can.cf = ce.DCE.Can.cf@lvce.DCE.Can.cf} in + self#makeFamily ce; + DoChildren + end + | Call(Some lv, _, el, _) when is_deputy_instr i -> begin + let cel = List.map (DCE.canonExp Int64.one) el in + let cfll = List.map (fun ce -> ce.DCE.Can.cf) cel in + let cfl = List.concat cfll in + let ce = DCE.canonExp Int64.one (Lval lv) in + let ce = {ce with DCE.Can.cf = ce.DCE.Can.cf @ cfl} in + self#makeFamily ce; + DoChildren + end + | Call(_,_,el,_) when is_deputy_instr i -> begin + if el <> [] then + let cel = List.map (DCE.canonExp Int64.one) el in + let cfll = List.map (fun ce -> ce.DCE.Can.cf) cel in + let cfl = List.concat cfll in + let ce = DCE.canonExp Int64.one (List.hd el) in + let ce = {ce with DCE.Can.cf = ce.DCE.Can.cf @ cfl} in + self#makeFamily ce; + DoChildren + else DoChildren + end + | _ -> DoChildren + + method vstmt s = + match s.skind with + | If(e, _, _, _) -> begin + let e = simplifyBoolExp e in + match e with + | BinOp(_, e1, e2, t) when isIntOrPtrType (typeOf e1) -> + let ce1 = DCE.canonExp Int64.one e1 in + let ce2 = DCE.canonExp Int64.one e2 in + let d = DCE.Can.sub ce2 ce1 ILong in + self#makeFamily ~sing:false d; + DoChildren + | _ -> DoChildren + end + | _ -> DoChildren + +end + +let famListsToAbsState lvh : absState = + if !debug then ignore(E.log "famListsToAbsState: begin\n"); + let ssHash = LvHash.create 32 in + let sSrLstr = ref [] in + let lvlistlist = LvUf.eq_classes (!lvh) in + if !debug then ignore(E.log "famListsToAbsState: There are %d families\n" + (List.length lvlistlist)); + List.iter (fun lvl -> + if List.length lvl <= 1 then () else (* no singleton families *) + let newoct = O.universe (List.length lvl) in + let idHash = LvHash.create 10 in + let cr = ref 0 in + if !debug then ignore(E.log "Family: "); + List.iter (fun lv -> + if !debug then ignore(E.log "(%d, %a) " (!cr) d_lval lv); + LvHash.add idHash lv (!cr); + incr cr) lvl; + if !debug then ignore(E.log "\n"); + let newssr = ref {octagon = newoct; lvHash = idHash} in + sSrLstr := newssr :: (!sSrLstr); + List.iter (fun lv -> + LvHash.add ssHash lv newssr) + lvl) lvlistlist; + { lvState = ssHash; smallStates = !sSrLstr } + +let lvFamsCreate fd = + let lvh = ref LvUf.empty in + let vis = new lvalFamilyMakerClass lvh in + if !debug then ignore(E.log "making lv hash for %s\n" fd.svar.vname); + try + ignore(visitCilFunction vis fd); + if !debug then ignore(E.log "lvFamsCreate: finished making lvh\n"); + lvh + with x -> + ignore(E.log "lvFamsCreate: There was an exception in lvalFamilyMakerClass: %s\n" + (Printexc.to_string x)); + raise x + +let makeTop fd = + let lvh = lvFamsCreate fd in + if !debug then ignore(E.log "Making top for %s\n" fd.svar.vname); + famListsToAbsState lvh + +(** flow-sensitive octagon analysis *) +let doOctAnalysis ?(tryReverse : bool=false) + (fd : fundec) + (fdat : DPF.functionData) + : unit = + try + if !debug then ignore(E.log "OctAnalysis: analyzing %s\n" fd.svar.vname); + IH.clear stateMap; + fdato := (Some fdat); (* for flowHandleInstr *) + let fst = List.hd fd.sbody.bstmts in + let precs = + match IH.tryfind fdat.DPF.fdPCHash fd.svar.vid with + | None -> [] + | Some cl -> cl + in + let t = List.fold_left flowHandleInstr (makeTop fd) precs in + IH.add stateMap fst.sid t; + if !debug then ignore(E.log "running flow engine for %s\n" fd.svar.vname); + totalChecks := 0; + totalAssert := 0; + octoCheckInsuf := 0; + octoAssertInsuf := 0; + interAssertInsuf := 0; + interCheckInsuf := 0; + time "oct-compute" FlowEngine.compute [fst]; + if !debug then + E.log "%s: finished analysis; starting optimizations.\n" Flow.name; + ignore (time "oct-optim" (visitCilFunction (new flowOptimizeVisitor tryReverse)) fd); + IH.clear stateMap; + curStmt := -1; + () + with Failure "hd" -> () + +let reportStats() = () +(* ignore(E.log "totalChecks %d\n" (!totalChecks)); + ignore(E.log "totalAssert %d\n" (!totalAssert)); + ignore(E.log "interCheckInsuf %d\n" (!interCheckInsuf)); + ignore(E.log "interAssertInsuf %d\n" (!interAssertInsuf)); + ignore(E.log "octoCheckInsuf %d\n" (!octoCheckInsuf)); + ignore(E.log "octoAssertInsuf %d\n" (!octoAssertInsuf))*) diff --git a/src/optimizer/oct/mineOct/oct.h b/src/optimizer/oct/mineOct/oct.h new file mode 100644 index 0000000..628b37d --- /dev/null +++ b/src/optimizer/oct/mineOct/oct.h @@ -0,0 +1,575 @@ +/* oct.h + Public interface for the library. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ + +#ifndef OCT_H__ +#define OCT_H__ + +#ifdef __cplusplus +#ifndef OCT_HAS_BOOL +#define OCT_HAS_BOOL +#endif +#endif + +#include +#include +#include +#include +#include +#include + +#include + +#ifdef OCT_HAS_NEW_POLKA +#include +#endif + +#ifdef OCT_ENABLE_ASSERT +#include +#include +#endif + +/* zra */ +#define OCT_PREFIX CAT(octiag_ + +#define CAT(a,b) a##b +#define OCT_PROTO(s) OCT_PREFIX,s) + + +/************/ +/* Booleans */ +/************/ + +#ifndef OCT_HAS_NEW_POLKA /* booleans are already defined in New Polka */ + +/* true/false */ +#ifndef OCT_HAS_BOOL /* bool/true/false are defined in recent C++ compilers */ +typedef int bool; +#define true (int)1 +#define false (int)0 +#endif + +/* complete lattice: bot + +#ifdef __cplusplus +extern "C" { +#endif + + +/*************/ +/* Shortcuts */ +/*************/ + +#define oct_init OCT_PROTO(init) + +#define oct_mmalloc_new OCT_PROTO(mmalloc_new) +#define oct_mmalloc_print OCT_PROTO(mmalloc_print) +#define oct_mmalloc_use OCT_PROTO(mmalloc_use) +#define oct_mmalloc_get_current OCT_PROTO(mmalloc_get_current) +#define oct_mmalloc_reset OCT_PROTO(mmalloc_reset) +#define oct_mm_malloc OCT_PROTO(mm_malloc) +#define oct_mm_realloc OCT_PROTO(mm_realloc) +#define oct_mm_free OCT_PROTO(mm_free) +#define oct_empty OCT_PROTO(empty) +#define oct_universe OCT_PROTO(universe) +#define oct_copy OCT_PROTO(copy) +#define oct_free OCT_PROTO(free) + +#define oct_dimension OCT_PROTO(dimension) +#define oct_nbconstraints OCT_PROTO(nbconstraints) +#define oct_get_box OCT_PROTO(get_box) +#define oct_from_box OCT_PROTO(from_box) +#define oct_get_bounds OCT_PROTO(get_bounds) +#define oct_set_bounds OCT_PROTO(set_bounds) +#define oct_is_empty OCT_PROTO(is_empty) +#define oct_is_empty_lazy OCT_PROTO(is_empty_lazy) +#define oct_is_universe OCT_PROTO(is_universe) +#define oct_is_included_in OCT_PROTO(is_included_in) +#define oct_is_included_in_lazy OCT_PROTO(is_included_in_lazy) +#define oct_is_equal OCT_PROTO(is_equal) +#define oct_is_equal_lazy OCT_PROTO(is_equal_lazy) +#define oct_is_in OCT_PROTO(is_in) +#define oct_intersection OCT_PROTO(intersection) +#define oct_convex_hull OCT_PROTO(convex_hull) +#define oct_widening OCT_PROTO(widening) +#define oct_widening_steps OCT_PROTO(widening_steps) +#define oct_narrowing OCT_PROTO(narrowing) +#define oct_forget OCT_PROTO(forget) +#define oct_add_bin_constraints OCT_PROTO(add_bin_constraints) +#define oct_assign_variable OCT_PROTO(assign_variable) +#define oct_substitute_variable OCT_PROTO(substitute_variable) +#define oct_add_constraint OCT_PROTO(add_constraint) +#define oct_interv_assign_variable OCT_PROTO(interv_assign_variable) +#define oct_interv_add_constraint OCT_PROTO(interv_add_constraint) +#define oct_interv_substitute_variable OCT_PROTO(interv_substitute_variable) +#define oct_time_flow OCT_PROTO(time_flow) +#define oct_add_dimensions_and_embed OCT_PROTO(add_dimensions_and_embed) +#define oct_add_dimensions_and_project OCT_PROTO(add_dimensions_and_project) +#define oct_remove_dimensions OCT_PROTO(remove_dimensions) +#define oct_add_dimensions_and_embed_multi \ + OCT_PROTO(add_dimensions_and_embed_multi) +#define oct_add_dimensions_and_project_multi \ + OCT_PROTO(add_dimensions_and_project_multi) +#define oct_remove_dimensions_multi \ + OCT_PROTO(remove_dimensions_multi) +#define oct_add_permute_dimensions_and_embed \ + OCT_PROTO(add_permute_dimensions_and_embed) +#define oct_add_permute_dimensions_and_project \ + OCT_PROTO(add_permute_dimensions_and_project) +#define oct_permute_remove_dimensions \ + OCT_PROTO(permute_remove_dimensions) +#define oct_print OCT_PROTO(print) +#define oct_add_epsilon OCT_PROTO(add_epsilon) +#define oct_add_epsilon_max OCT_PROTO(add_epsilon_max) +#define oct_add_epsilon_bin OCT_PROTO(add_epsilon_bin) +#define oct_m_empty OCT_PROTO(m_empty) +#define oct_m_from_oct OCT_PROTO(m_from_oct) +#define oct_m_to_oct OCT_PROTO(m_to_oct) +#define oct_m_free OCT_PROTO(m_free) +#define oct_m_is_equal OCT_PROTO(m_is_equal) +#define oct_m_print OCT_PROTO(m_print) +#define oct_m_dimension OCT_PROTO(m_dimension) +#define oct_m_is_empty OCT_PROTO(m_is_empty) +#define oct_serialize OCT_PROTO(serialize) +#define oct_deserialize OCT_PROTO(deserialize) +#define oct_m_serialize OCT_PROTO(m_serialize) +#define oct_m_deserialize OCT_PROTO(m_deserialize) +#define oct_to_poly OCT_PROTO(to_poly) +#define oct_from_poly OCT_PROTO(from_poly) +#define oct_random_init OCT_PROTO(random_init) +#define oct_chrono_reset OCT_PROTO(chrono_reset) +#define oct_chrono_start OCT_PROTO(chrono_start) +#define oct_chrono_stop OCT_PROTO(chrono_stop) +#define oct_chrono_get OCT_PROTO(chrono_get) +#define oct_chrono_print OCT_PROTO(chrono_print) +#define oct_timing_enter OCT_PROTO(timing_enter) +#define oct_timing_exit OCT_PROTO(timing_exit) +#define oct_timing_print OCT_PROTO(timing_print) +#define oct_timing_print_all OCT_PROTO(timing_print_all) +#define oct_timing_reset OCT_PROTO(timing_reset) +#define oct_timing_reset_all OCT_PROTO(timing_reset_all) +#define oct_timing_clear OCT_PROTO(timing_clear) + + +/**********/ +/* Assert */ +/**********/ + +#ifdef OCT_ENABLE_ASSERT + +/* it is very convinient when debugging to make the program core dump at the + very place a check fails, this is why there is a kill(getpid(),SIGABRT) +*/ +#define OCT_ASSERT(t,s) if (!(t)) { fprintf(stderr,"Assert failure in file %s at line %i:\n%s (%s)\n",__FILE__,__LINE__,s,#t); fflush(stderr); kill(getpid(),SIGABRT); } + +#else + +#define OCT_ASSERT(t,s) ; + +#endif + + +/**********/ +/* Memory */ +/**********/ + +/* oct_mm_alloc as malloc + oct_mm_free as free + oct_mm_realloc as realloc + new_t(t) returns a pointer t* on a buffer of the size sizeof(t) + new_n(t,n) returns a pointer t* on a buffer of the size sizeof(t)*n + renew_n(c,t,n) like new_n, but call mm_realloc + + if ENABLE_MALLOC_MONITORING if defined, allows memory usage monitoring: + + . a monitor is allocated by mm=oct_mmalloc_new() + + . monitors count the number of oct_mm_malloc/oct_mm_realloc/oct_mm_free, + memory and max memory consumption + malloc, realloc and free are unchanged + + . after a oct_mmalloc_use(mm), all blocks mm_malloced belong to monitor mm + + . if you then oct_mm_realloc/oct_mm_free this block, it is monitored by + the same monitor used when it was oct_mm_malloced, not the current monitor + + . use oct_mmalloc_print(mm) to print infos + + . oct_mmalloc_reset(mm) resets counters to 0 and forget about all blocks it + monitored + + . monitors MUST NOT be deallocated (blocks may be still monitored by them !) + + . before any call to oct_mmalloc_use, a default global monitor is used, + use oct_mmalloc_get_current to get it + + if ENABLE_MALLOC_MONITORING is not defined, oct_mm_alloc, oct_mm_realloc + and oct_mm_free are simply malloc, realloc and free + + YOU SHOULD NOT MIX POINTERS USED BY malloc/realloc/free ANS THOSE USED BY + oct_mm_malloc/oct_mm_realloc/oct_mm_free/new_t/new_n/renew_n + + */ + +struct mmalloc_tt; +typedef struct mmalloc_tt mmalloc_t; + +/* monitor manipulation */ +mmalloc_t* OCT_PROTO(mmalloc_new) (void); +void OCT_PROTO(mmalloc_print) (mmalloc_t* mm); +void OCT_PROTO(mmalloc_use) (mmalloc_t* mm); +mmalloc_t* OCT_PROTO(mmalloc_get_current) (); +void OCT_PROTO(mmalloc_reset) (mmalloc_t* mm); + +#ifdef OCT_ENABLE_MALLOC_MONITORING +/* monitored malloc/realloc/free */ +void* OCT_PROTO(mm_malloc) (size_t t); +void* OCT_PROTO(mm_realloc) (void* p, size_t t); +void OCT_PROTO(mm_free) (void* p); +#else + +static inline void* OCT_PROTO(mm_malloc) (size_t t) +{ void* p = malloc(t); + OCT_ASSERT(p || !t, "mm_malloc returns NULL pointer"); + return p; } + +static inline void* OCT_PROTO(mm_realloc) (void* p, size_t t) +{ p = realloc(p,t); + OCT_ASSERT(p || !t, "mm_realloc returns NULL pointer"); + return p; } + +static inline void OCT_PROTO(mm_free) (void* p) { free(p); } + +#endif + +#define new_t(t) ((t*) oct_mm_malloc (sizeof(t))) +#define new_n(t,n) ((t*) oct_mm_malloc (sizeof(t)*(n))) +#define renew_n(c,t,n) ((t*) oct_mm_realloc (c,sizeof(t)*(n))) + + + +/************/ +/* Octagons */ +/************/ + +/* initialization */ +int OCT_PROTO(init) (); + + +struct oct_tt; +typedef struct oct_tt oct_t; + + +/* unary/binary constraint type */ +typedef enum { + px = 0, /* x <= c (y ignored) */ + mx = 1, /* -x <= c (y ignored) */ + pxpy = 2, /* x+y <= c */ + pxmy = 3, /* x-y <= c */ + mxpy = 4, /* -x+y <= c */ + mxmy = 5 /* -x-y <= c */ +} oct_cons_type; + +typedef struct { + var_t x; + var_t y; + num_t c; + oct_cons_type type; +} oct_cons; + +/* Bertrand Jeannet's way to specify insertion / deletion of dimensions, + not necessarily at the end + */ +#ifndef OCT_HAS_NEW_POLKA +typedef struct { + var_t pos; + var_t nbdims; +} dimsup_t; +#endif + +/* octagon creation/destruction */ +oct_t* OCT_PROTO(empty) (var_t n); /* empty domain, c not allocated */ +oct_t* OCT_PROTO(universe) (var_t n); /* full domain */ +oct_t* OCT_PROTO(copy) (oct_t* m); /* increase ref count */ +void OCT_PROTO(free) (oct_t* m); /* decrease ref count & free if 0 */ + +/* query functions */ +var_t OCT_PROTO(dimension) (oct_t* m); +size_t OCT_PROTO(nbconstraints) (oct_t* m); /* number of non infinitary constraints */ + +/* interval functions */ +num_t* OCT_PROTO(get_box) (oct_t* m); /* get bounds for all variables */ + +oct_t* OCT_PROTO(from_box) (var_t n, + const num_t* b); /* construct an octagon from a box */ + +void OCT_PROTO(get_bounds) (oct_t* m, var_t k, /* get bounds for one variable */ + num_t* up, num_t* down); + +oct_t* OCT_PROTO(set_bounds) (oct_t* m, var_t k, /* set bounds for one variable */ + const num_t* up, const num_t* down, + bool destructive); + + +/* tests */ +bool OCT_PROTO(is_empty ) (oct_t* m); +tbool OCT_PROTO(is_empty_lazy) (oct_t* m); +bool OCT_PROTO(is_universe) (oct_t* m); +bool OCT_PROTO(is_included_in) (oct_t* ma, oct_t* mb); +tbool OCT_PROTO(is_included_in_lazy) (oct_t* ma, oct_t* mb); +bool OCT_PROTO(is_equal) (oct_t* ma, oct_t* mb); +tbool OCT_PROTO(is_equal_lazy) (oct_t* ma, oct_t* mb); +bool OCT_PROTO(is_in) (oct_t* a, const num_t* v); + +/* operators */ +typedef enum +{ + OCT_WIDENING_FAST = 0, /* fast convergence, less precision */ + OCT_WIDENING_ZERO = 1, /* elements<0 are first set to 0 */ + OCT_WIDENING_UNIT = 2, /* elemets are set to -1, 0, and 1 before +oo */ + + /* Not a widening, but a degenerate hull (precisely, a hull without + closure of the left argument). + It is tantalizing to interleave widenings and hulls to improve the + precision of fix-point computations but, unfortunately, this destroys + the converge property and makes analyses loop forever. + The PRE_WIDENING is a middle-ground. + It does not ensure convergence by itself, but can be safely interleaved + with widenings. + As long as proper widenings occur infinitely often, the interleaved + sequence will converge. Also, it converges more slowly, and so, gives + a better precision. + */ + OCT_PRE_WIDENING = 3 +} oct_widening_type; + +oct_t* OCT_PROTO(intersection) (oct_t* ma, oct_t* mb, bool destructive); + +oct_t* OCT_PROTO(convex_hull) (oct_t* ma, oct_t* mb, bool destructive); + +oct_t* OCT_PROTO(widening) (oct_t* ma, oct_t* mb, bool destructive, + oct_widening_type type); + +oct_t* OCT_PROTO(widening_steps) (oct_t* ma, oct_t* mb, bool destructive, + int nb_steps, num_t* steps); + +oct_t* OCT_PROTO(narrowing) (oct_t* ma, oct_t* mb, bool destructive); + +/* transfer functions */ +oct_t* OCT_PROTO(forget) (oct_t* m, var_t k, bool destructive); + +oct_t* OCT_PROTO(add_bin_constraints) (oct_t* m, + unsigned int nb, + const oct_cons* cons, + bool destructive); + +oct_t* OCT_PROTO(assign_variable) (oct_t* m, + var_t x, + const num_t* tab, + bool destructive); + +oct_t* OCT_PROTO(substitute_variable) (oct_t* m, + var_t x, + const num_t* tab, + bool destructive); + +oct_t* OCT_PROTO(add_constraint) (oct_t* m, + const num_t* tab, + bool destructive); + + +oct_t* OCT_PROTO(interv_assign_variable) (oct_t* m, + var_t x, + const num_t* t, + bool destructive); + +oct_t* OCT_PROTO(interv_add_constraint) (oct_t* m, + const num_t* tab, + bool destructive); + + +oct_t* OCT_PROTO(interv_substitute_variable) (oct_t* m, + var_t x, + const num_t* t, + bool destructive); + +oct_t* OCT_PROTO(time_flow) (oct_t* m, + const num_t *nmin, + const num_t *nmax, + const num_t *tab, + bool destructive); + +/* change of dimensions */ +oct_t* OCT_PROTO(add_dimensions_and_embed) (oct_t* m, + var_t dimsup, + bool destructive); + +oct_t* OCT_PROTO(add_dimensions_and_project) (oct_t* m, + var_t dimsup, + bool destructive); + +oct_t* OCT_PROTO(remove_dimensions) (oct_t* m, + var_t dimsup, + bool destructive); + + +oct_t* OCT_PROTO(add_dimensions_and_embed_multi) (oct_t* m, + const dimsup_t* tab, + size_t size_tab, + bool destructive); + +oct_t* OCT_PROTO(add_dimensions_and_project_multi)(oct_t* m, + const dimsup_t* tab, + size_t size_tab, + bool destructive); + +oct_t* OCT_PROTO(remove_dimensions_multi) (oct_t* m, + const dimsup_t* tab, + size_t size_tab, + bool destructive); + +oct_t* OCT_PROTO(add_permute_dimensions_and_embed) (oct_t* m, + var_t dimsup, + const var_t* permutation, + bool destructive); + +oct_t* OCT_PROTO(add_permute_dimensions_and_project) (oct_t* m, + var_t dimsup, + const var_t* permutation, + bool destructive); + +oct_t* OCT_PROTO(permute_remove_dimensions) (oct_t* m, + var_t diminf, + const var_t* permutation, + bool destructive); + + +/* perturbation */ + +oct_t* OCT_PROTO(add_epsilon) (oct_t* m, + const num_t* epsilon, + bool destructive); + +oct_t* OCT_PROTO(add_epsilon_max) (oct_t* m, + const num_t* epsilon, + bool destructive); + +oct_t* OCT_PROTO(add_epsilon_bin) (oct_t* ma, + oct_t* mb, + const num_t* epsilon, + bool destructive); + + +/* utilities */ +void OCT_PROTO(print) (const oct_t* m); /* print in the form a constrain set */ + +/* minimal form */ + +struct moct_tt; +typedef struct moct_tt moct_t; + +moct_t* OCT_PROTO(m_empty) (var_t n); +moct_t* OCT_PROTO(m_from_oct) (oct_t* m); +oct_t* OCT_PROTO(m_to_oct) (moct_t* a); +void OCT_PROTO(m_free) (moct_t* a); + +bool OCT_PROTO(m_is_equal) (moct_t* ma, moct_t* mb); +void OCT_PROTO(m_print) (moct_t* m); +var_t OCT_PROTO(m_dimension) (moct_t* m); +bool OCT_PROTO(m_is_empty) (moct_t* m); + + +/* serialization */ +void* OCT_PROTO(serialize) (oct_t* m, size_t* size); +oct_t* OCT_PROTO(deserialize) (void* d); +void* OCT_PROTO(m_serialize) (moct_t* m, size_t* size); +moct_t* OCT_PROTO(m_deserialize) (void* d); + + + +/****************************/ +/* Interface with New Polka */ +/****************************/ +#ifdef OCT_HAS_NEW_POLKA + +poly_t* OCT_PROTO(to_poly) (oct_t* m); +oct_t* OCT_PROTO(from_poly) (poly_t* p); + +#endif + + + +/**********/ +/* Chrono */ +/**********/ + + +typedef struct +{ + struct timeval begin; + long usec; + long sec; + int start; +} chrono_t; + + +void OCT_PROTO(chrono_reset) (chrono_t* c); +void OCT_PROTO(chrono_start) (chrono_t* c); +void OCT_PROTO(chrono_stop) (chrono_t* c); +void OCT_PROTO(chrono_get) (chrono_t* c, + long* hour, long* min, long* sec, long* usec); +void OCT_PROTO(chrono_print) (chrono_t* c); + +/* if ENABLE_TIMING is enabled, each library function use the following macros + for basic profiling: number of calls and time elapsed in each function + + should not be used to + */ + + +#ifdef OCT_ENABLE_TIMING + +#define OCT_ENTER(s,k) oct_timing_enter(s,k) +#define OCT_EXIT(s,k) oct_timing_exit(s,k) + +#else + +#define OCT_ENTER(s,k) +#define OCT_EXIT(s,k) + +#endif + +void OCT_PROTO(timing_enter) (const char* name, unsigned key); +void OCT_PROTO(timing_exit) (const char* name, unsigned key); +void OCT_PROTO(timing_print) (const char* name); +void OCT_PROTO(timing_print_all) (void); +void OCT_PROTO(timing_reset) (const char* name); +void OCT_PROTO(timing_reset_all) (void); +void OCT_PROTO(timing_clear) (void); + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/src/optimizer/oct/mineOct/oct.ml b/src/optimizer/oct/mineOct/oct.ml new file mode 100644 index 0000000..e59f212 --- /dev/null +++ b/src/optimizer/oct/mineOct/oct.ml @@ -0,0 +1,376 @@ +(* oct_common.ml + Abstract semantics functions and OCaml pretty-printing. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 +*) + +(******************************) +(* This is from oct_common.ml *) +(******************************) + +(* initialization *) +external init: unit -> bool = "ocaml_oct_init" + + +(* numerical domain *) +type num +type vnum + +external num_of_int: int -> num = "ocaml_num_int" +external num_of_frac: int*int -> num = "ocaml_num_frac" +external num_of_float: float -> num = "ocaml_num_float" +external num_infty: unit -> num = "ocaml_num_infty" + +external vnum_of_int: int array -> vnum = "ocaml_vnum_int" +external vnum_of_frac: int*int array -> vnum = "ocaml_vnum_frac" +external vnum_of_float: float array -> vnum = "ocaml_vnum_float" + +external vnum_of_int_opt: int option array -> vnum = "ocaml_vnum_int_opt" +external vnum_of_frac_opt: int*int option array -> vnum = "ocaml_vnum_frac_opt" + +external string_of_num: num -> string = "ocaml_num_string" +external string_of_vnum: vnum -> int -> string = "ocaml_vnum_string" +external vnum_length: vnum -> int = "ocaml_vnum_length" + +external int_of_num: num -> int option = "ocaml_int_num" +external frac_of_num: num -> int*int option = "ocaml_frac_num" +external float_of_num: num -> float = "ocaml_float_num" + +external int_of_vnum: vnum -> int option array = "ocaml_int_vnum" +external frac_of_vnum: vnum -> int*int option array = "ocaml_frac_vnum" +external float_of_vnum: vnum -> float array = "ocaml_float_vnum" + +let fnumprinter f o = + Format.fprintf f "@[%s@]" (string_of_num o) + +let fvnumprinter f o = + let n = vnum_length o in + Format.fprintf f "@[[ @["; + for i=0 to n-1 do + if i=0 then Format.fprintf f "@[%s@]" (string_of_vnum o i) + else Format.fprintf f ", @[%s@]" (string_of_vnum o i) + done; + Format.fprintf f "@] ]@]" + +let numprinter = fnumprinter Format.std_formatter +let vnumprinter = fvnumprinter Format.std_formatter + + +(* boolean lattice *) +type tbool = Bottom | True | False | Top + +(* abstract types of regular & minimized octagons *) +type oct +type moct + +(* octagon creation *) +external empty: int -> oct = "ocaml_oct_empty" +external universe: int -> oct = "ocaml_oct_universe" + +(* query functions *) +external dim: oct -> int = "ocaml_oct_dim" +external nbconstraints: oct -> int = "ocaml_oct_nbconstraints" +external get_elem: oct -> int -> int -> num = "ocaml_oct_get_elem" + +(* tests *) +external is_empty: oct -> bool = "ocaml_oct_is_empty" +external is_empty_lazy: oct -> tbool= "ocaml_oct_is_empty_lazy" +external is_universe: oct -> bool= "ocaml_oct_is_universe" +external is_included_in: oct -> oct -> bool= "ocaml_oct_is_included_in" +external is_included_in_lazy: + oct -> oct -> tbool= "ocaml_oct_is_included_in_lazy" +external is_equal: oct -> oct -> bool= "ocaml_oct_is_equal" +external is_equal_lazy: oct -> oct -> tbool= "ocaml_oct_is_equal_lazy" +external is_in: oct -> vnum -> bool= "ocaml_oct_is_in" + +(* operators *) +type wident = WidenFast | WidenZero | WidenUnit | WidenSteps of vnum | PreWiden +external inter: oct -> oct -> oct = "ocaml_oct_inter" +external union: oct -> oct -> oct = "ocaml_oct_union" +external widening: oct -> oct -> wident -> oct = "ocaml_oct_widening" +external narrowing: oct -> oct -> oct = "ocaml_oct_narrowing" + +(* transfer function *) +type constr = + PX of int*num (* x <= c *) + | MX of int*num (* -x <= c *) + | PXPY of int*int*num (* x+y <= c *) + | PXMY of int*int*num (* x-y <= c *) + | MXPY of int*int*num (* -x+y <= c *) + | MXMY of int*int*num (* -x-y <= c *) +external forget: oct -> int -> oct = "ocaml_oct_forget" +external add_bin_constraints: + oct -> constr array -> oct = "ocaml_oct_add_bin_constraints" +external assign_var: oct -> int -> vnum -> oct = "ocaml_oct_assign_variable" +external substitute_var: + oct -> int -> vnum -> oct = "ocaml_oct_substitute_variable" +external add_constraint: + oct -> vnum -> oct = "ocaml_oct_add_constraint" +external interv_assign_var: + oct -> int -> vnum -> oct = "ocaml_oct_interv_assign_variable" +external interv_add_constraint: + oct -> vnum -> oct = "ocaml_oct_interv_add_constraint" +external interv_substitute_var: + oct -> int -> vnum -> oct = "ocaml_oct_interv_substitute_variable" +external time_flow: + oct -> num -> num -> vnum -> oct = "ocaml_oct_time_flow" + +(* change of dimensions *) +external add_dims_and_embed: + oct -> int -> oct = "ocaml_oct_add_dimensions_and_embed" +external add_dims_and_project: + oct -> int -> oct = "ocaml_oct_add_dimensions_and_project" +external del_dims: + oct -> int -> oct = "ocaml_oct_remove_dimensions" + +(* change of dimensions at arbitrary positions *) +type dimsup = { pos:int; nbdims:int; } +external add_dims_and_embed_multi: + oct -> dimsup array -> oct = "ocaml_oct_add_dimensions_and_embed_multi" +external add_dims_and_project_multi: + oct -> dimsup array -> oct = "ocaml_oct_add_dimensions_and_project_multi" +external del_dims_multi: + oct -> dimsup array -> oct = "ocaml_oct_remove_dimensions_multi" + +(* change of dimensions with permutation *) +external add_permute_dims_and_embed: + oct -> int -> int array -> oct = "ocaml_oct_add_permute_dimensions_and_embed" +external add_permute_dims_and_project: + oct -> int -> int array -> oct = "ocaml_oct_add_permute_dimensions_and_project" +external permute_del_dims: + oct -> int -> int array -> oct = "ocaml_oct_permute_remove_dimensions" + +(* normal form *) +external close: oct -> oct = "ocaml_oct_close" + +(* interval functions *) +external get_box: oct -> vnum = "ocaml_oct_get_box" +external from_box: vnum -> oct = "ocaml_oct_from_box" +external get_bounds: oct -> int -> num*num = "ocaml_oct_get_bounds" +external set_bounds: oct -> int -> num*num -> oct = "ocaml_oct_set_bounds" + +(* preturbation *) +external add_epsilon: oct -> num -> oct = "ocaml_oct_add_epsilon" +external add_epsilon_max: oct -> num -> oct = "ocaml_oct_add_epsilon_max" +external add_epsilon_bin: oct -> oct -> num -> oct ="ocaml_oct_add_epsilon_bin" + +(* utilities *) +external print: oct -> unit = "ocaml_oct_print" + +(* minimal form *) +external m_to_oct: moct -> oct = "ocaml_oct_m_to_oct" +external m_from_oct: oct -> moct = "ocaml_oct_m_from_oct" +external m_print: moct -> unit = "ocaml_oct_m_print" +external m_dim: moct -> int = "ocaml_oct_m_dim" +external m_is_empty: moct -> bool = "ocaml_oct_m_is_empty" +external m_is_equal: moct -> moct -> bool = "ocaml_oct_m_is_equal" +external m_get_elem: moct -> int -> int -> num = "ocaml_oct_m_get_elem" + +(* top-level prettry printers *) +external elem_to_string: + oct -> int -> int -> string option = "ocaml_oct_elem_to_string" +external elem_to_string2: + oct -> int -> int -> string -> string option = "ocaml_oct_elem_to_string2" +external get_state: oct -> int = "ocaml_oct_get_state" + +let foctprinter v f o = + if (get_state o) = 0 + then Format.fprintf f "@[(empty)@]" + else + begin + Format.fprintf f "@["; +(* if (get_state o) = 2 then Format.fprintf f "(closed)@ ";*) + Format.fprintf f "@[{@ "; + + let n = dim o in + let beg = ref true in + + for i=0 to n-1 do + (match (elem_to_string2 o (2*i+1) (2*i) (v i)) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()) + done; + + for i=0 to n-1 do + for j=0 to i-1 do + (match (elem_to_string2 o (2*j) (2*i) ((v i)^"-"^(v j))) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()); + (match (elem_to_string2 o (2*j+1) (2*i) ((v i)^"+"^(v j))) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()) + done + done; + + Format.fprintf f "@]@ }@]" + end + + +let octprinter v = foctprinter v Format.std_formatter + +(* this version only prints the new version of changed constraints *) +let foctnewprinter v f o p = + if dim o != dim p then failwith "oct_common.ml:foctnewprinter: incompatible octagon dimensions"; + if (get_state o) != (get_state p) then foctprinter v f p + else if (get_state p) == 0 then Format.fprintf f "{@ }" + else + begin + Format.fprintf f "@["; + Format.fprintf f "@[{@ "; + + let n = dim o in + let beg = ref true in + + for i=0 to n-1 do + if get_elem o (2*i+1) (2*i) <> get_elem p (2*i+1) (2*i) || + get_elem o (2*i) (2*i+1) <> get_elem p (2*i) (2*i+1) + then + (match (elem_to_string2 p (2*i+1) (2*i) (v i)) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()) + done; + + for i=0 to n-1 do + for j=0 to i-1 do + if get_elem o (2*j) (2*i) <> get_elem p (2*j) (2*i) || + get_elem o (2*i) (2*j) <> get_elem p (2*i) (2*j) + then + (match (elem_to_string2 p (2*j) (2*i) ((v i)^"-"^(v j))) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()); + + if get_elem o (2*j+1) (2*i) <> get_elem p (2*j+1) (2*i) || + get_elem o (2*i) (2*j+1) <> get_elem p (2*i) (2*j+1) + then + (match (elem_to_string2 p (2*j+1) (2*i) ((v i)^"+"^(v j))) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()) + done + done; + + Format.fprintf f "@]@ }@]" + end + +(** this version prints both the old and the new version of changed constraints + *) +let foctdiffprinter v f o p = + if dim o != dim p then failwith "oct_common.ml:foctdiffprinter: incompatible octagon dimensions"; + if (get_state o) != (get_state p) then Format.fprintf f "old:%a@ new:%a" + (foctprinter v) o (foctprinter v) p + else if (get_state p) == 0 then Format.fprintf f "{@ }" + else + begin + Format.fprintf f "@["; + Format.fprintf f "@[{@ "; + + let n = dim o in + let beg = ref true in + + let pp x y = match x,y with + Some a,Some b -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[old: %s@ new: %s@]" a b + | None,Some b -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[old: _@ new: %s@]" b + | Some a,None -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[old: %s@ new: _@]" a + | None,None -> () + in + + for i=0 to n-1 do + if get_elem o (2*i+1) (2*i) <> get_elem p (2*i+1) (2*i) || + get_elem o (2*i) (2*i+1) <> get_elem p (2*i) (2*i+1) + then + pp (elem_to_string2 o (2*i+1) (2*i) (v i)) + (elem_to_string2 p (2*i+1) (2*i) (v i)) + done; + + for i=0 to n-1 do + for j=0 to i-1 do + if get_elem o (2*j) (2*i) <> get_elem p (2*j) (2*i) || + get_elem o (2*i) (2*j) <> get_elem p (2*i) (2*j) + then + pp (elem_to_string2 o (2*j) (2*i) ((v i)^"-"^(v j))) + (elem_to_string2 p (2*j) (2*i) ((v i)^"-"^(v j))); + + if get_elem o (2*j+1) (2*i) <> get_elem p (2*j+1) (2*i) || + get_elem o (2*i) (2*j+1) <> get_elem p (2*i) (2*j+1) + then + pp (elem_to_string2 o (2*j+1) (2*i) ((v i)^"+"^(v j))) + (elem_to_string2 p (2*j+1) (2*i) ((v i)^"+"^(v j))) + done + done; + + Format.fprintf f "@]@ }@]" + end + +external melem_to_string: + moct -> int -> int -> string option = "ocaml_oct_melem_to_string" +external melem_to_string2: + moct -> int -> int -> string -> string option = "ocaml_oct_melem_to_string2" + +let fmoctprinter v f o = + if (m_is_empty o) + then Format.fprintf f "@[(empty)@]" + else + begin + Format.fprintf f "@["; + Format.fprintf f "@[{@ "; + + let n = m_dim o in + let beg = ref true in + + for i=0 to n-1 do + (match (melem_to_string2 o (2*i+1) (2*i) (v i)) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()) + done; + + for i=0 to n-1 do + for j=0 to i-1 do + (match (melem_to_string2 o (2*j) (2*i) ((v i)^"-"^(v j))) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()); + (match (melem_to_string2 o (2*j+1) (2*i) ((v i)^"+"^(v j))) with + Some a -> + if !beg then beg:=false else Format.fprintf f ",@ "; + Format.fprintf f "@[%s@]" a + | _ -> ()) + done + done; + + Format.fprintf f "@]@ }@]" + end + +let moctprinter v = fmoctprinter v Format.std_formatter + +(* utilities *) +external memprint: unit -> unit = "ocaml_oct_memprint" +external timeprint: unit -> unit = "ocaml_oct_timeprint" + +(* polyhedra <-> octagons conversion *) +(* 'a is used instead of Poly.t in case the Poly module is not defined *) +external from_poly: 'a -> oct = "ocaml_oct_from_poly" +external to_poly: oct -> 'a = "ocaml_oct_to_poly" diff --git a/src/optimizer/oct/mineOct/oct.mli b/src/optimizer/oct/mineOct/oct.mli new file mode 100644 index 0000000..8317d5f --- /dev/null +++ b/src/optimizer/oct/mineOct/oct.mli @@ -0,0 +1,176 @@ +(* oct_common.mli + Abstract semantics functions. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 +*) + + +(* initialization *) +external init: unit -> bool = "ocaml_oct_init" + + +(* numerical domain *) +type num +type vnum + +external num_of_int: int -> num = "ocaml_num_int" +external num_of_frac: int*int -> num = "ocaml_num_frac" +external num_of_float: float -> num = "ocaml_num_float" +external num_infty: unit -> num = "ocaml_num_infty" + +external vnum_of_int: int array -> vnum = "ocaml_vnum_int" +external vnum_of_frac: int*int array -> vnum = "ocaml_vnum_frac" +external vnum_of_float: float array -> vnum = "ocaml_vnum_float" + +external vnum_of_int_opt: int option array -> vnum = "ocaml_vnum_int_opt" +external vnum_of_frac_opt: int*int option array -> vnum = "ocaml_vnum_frac_opt" + +external string_of_num: num -> string = "ocaml_num_string" +external string_of_vnum: vnum -> int -> string = "ocaml_vnum_string" +external vnum_length: vnum -> int = "ocaml_vnum_length" + +external int_of_num: num -> int option = "ocaml_int_num" +external frac_of_num: num -> int*int option = "ocaml_frac_num" +external float_of_num: num -> float = "ocaml_float_num" + +external int_of_vnum: vnum -> int option array = "ocaml_int_vnum" +external frac_of_vnum: vnum -> int*int option array = "ocaml_frac_vnum" +external float_of_vnum: vnum -> float array = "ocaml_float_vnum" + +val fnumprinter: Format.formatter -> num -> unit +val fvnumprinter: Format.formatter -> vnum -> unit +val numprinter: num -> unit +val vnumprinter: vnum -> unit + +(* boolean lattice *) +type tbool = Bottom | True | False | Top + +(* abstract types of regular & minimized octagons *) +type oct +type moct + +(* octagon creation *) +external empty: int -> oct = "ocaml_oct_empty" +external universe: int -> oct = "ocaml_oct_universe" + +(* query functions *) +external dim: oct -> int = "ocaml_oct_dim" +external nbconstraints: oct -> int = "ocaml_oct_nbconstraints" +external get_elem: oct -> int -> int -> num = "ocaml_oct_get_elem" + +(* tests *) +external is_empty: oct -> bool = "ocaml_oct_is_empty" +external is_empty_lazy: oct -> tbool= "ocaml_oct_is_empty_lazy" +external is_universe: oct -> bool= "ocaml_oct_is_universe" +external is_included_in: oct -> oct -> bool= "ocaml_oct_is_included_in" +external is_included_in_lazy: + oct -> oct -> tbool= "ocaml_oct_is_included_in_lazy" +external is_equal: oct -> oct -> bool= "ocaml_oct_is_equal" +external is_equal_lazy: oct -> oct -> tbool= "ocaml_oct_is_equal_lazy" +external is_in: oct -> vnum -> bool= "ocaml_oct_is_in" + +(* operators *) +type wident = WidenFast | WidenZero | WidenUnit | WidenSteps of vnum | PreWiden +external inter: oct -> oct -> oct = "ocaml_oct_inter" +external union: oct -> oct -> oct = "ocaml_oct_union" +external widening: oct -> oct -> wident -> oct = "ocaml_oct_widening" +external narrowing: oct -> oct -> oct = "ocaml_oct_narrowing" + +(* transfer function *) +type constr = + PX of int*num (* x <= c *) + | MX of int*num (* -x <= c *) + | PXPY of int*int*num (* x+y <= c *) + | PXMY of int*int*num (* x-y <= c *) + | MXPY of int*int*num (* -x+y <= c *) + | MXMY of int*int*num (* -x-y <= c *) +external forget: oct -> int -> oct = "ocaml_oct_forget" +external add_bin_constraints: oct -> constr array -> oct = "ocaml_oct_add_bin_constraints" +external assign_var: + oct -> int -> vnum -> oct = "ocaml_oct_assign_variable" +external substitute_var: + oct -> int -> vnum -> oct = "ocaml_oct_substitute_variable" +external add_constraint: oct -> vnum -> oct = "ocaml_oct_add_constraint" +external interv_assign_var: + oct -> int -> vnum -> oct = "ocaml_oct_interv_assign_variable" +external interv_add_constraint: + oct -> vnum -> oct = "ocaml_oct_interv_add_constraint" +external interv_substitute_var: + oct -> int -> vnum -> oct = "ocaml_oct_interv_substitute_variable" +external time_flow: + oct -> num -> num -> vnum -> oct = "ocaml_oct_time_flow" + +(* change of dimensions *) +external add_dims_and_embed: + oct -> int -> oct = "ocaml_oct_add_dimensions_and_embed" +external add_dims_and_project: + oct -> int -> oct = "ocaml_oct_add_dimensions_and_project" +external del_dims: oct -> int -> oct = "ocaml_oct_remove_dimensions" + +(* change of dimensions at arbitrary positions *) +type dimsup = { pos:int; nbdims:int; } +external add_dims_and_embed_multi: + oct -> dimsup array -> oct = "ocaml_oct_add_dimensions_and_embed_multi" +external add_dims_and_project_multi: + oct -> dimsup array -> oct = "ocaml_oct_add_dimensions_and_project_multi" +external del_dims_multi: + oct -> dimsup array -> oct = "ocaml_oct_remove_dimensions_multi" + +(* change of dimensions with permutation *) +external add_permute_dims_and_embed: + oct -> int -> int array -> oct = "ocaml_oct_add_permute_dimensions_and_embed" +external add_permute_dims_and_project: + oct -> int -> int array -> oct = "ocaml_oct_add_permute_dimensions_and_project" +external permute_del_dims: + oct -> int -> int array -> oct = "ocaml_oct_permute_remove_dimensions" + +(* normal form *) +external close: oct -> oct = "ocaml_oct_close" + +(* interval functions *) +external get_box: oct -> vnum = "ocaml_oct_get_box" +external from_box: vnum -> oct = "ocaml_oct_from_box" +external get_bounds: oct -> int -> num*num = "ocaml_oct_get_bounds" +external set_bounds: oct -> int -> num*num -> oct = "ocaml_oct_set_bounds" + +(* preturbation *) +external add_epsilon: oct -> num -> oct = "ocaml_oct_add_epsilon" +external add_epsilon_max: oct -> num -> oct = "ocaml_oct_add_epsilon_max" +external add_epsilon_bin: oct -> oct -> num -> oct ="ocaml_oct_add_epsilon_bin" + +(* utilities *) +external print: oct -> unit = "ocaml_oct_print" + +(* minimal form *) +external m_to_oct: moct -> oct = "ocaml_oct_m_to_oct" +external m_from_oct: oct -> moct = "ocaml_oct_m_from_oct" +external m_print: moct -> unit = "ocaml_oct_m_print" +external m_dim: moct -> int = "ocaml_oct_m_dim" +external m_is_empty: moct -> bool = "ocaml_oct_m_is_empty" +external m_is_equal: moct -> moct -> bool = "ocaml_oct_m_is_equal" +external m_get_elem: moct -> int -> int -> num = "ocaml_oct_m_get_elem" + +(* top-level prettry_printers *) + +val foctprinter: (int -> string) -> Format.formatter -> oct -> unit +val octprinter: (int -> string) -> oct -> unit +val fmoctprinter: (int -> string) -> Format.formatter -> moct -> unit +val moctprinter: (int -> string) -> moct -> unit + +(* prints only constraints that differ between two two octagons *) + +(* only prints _new_ constraints in the difference *) +val foctnewprinter: (int -> string) -> Format.formatter -> oct -> oct -> unit + +(* prints both old and new constraints in the difference *) +val foctdiffprinter: (int -> string) -> Format.formatter -> oct -> oct -> unit + + +(* utilities *) +external memprint: unit -> unit = "ocaml_oct_memprint" +external timeprint: unit -> unit = "ocaml_oct_timeprint" + diff --git a/src/optimizer/oct/mineOct/oct_config.h b/src/optimizer/oct/mineOct/oct_config.h new file mode 100644 index 0000000..ff35325 --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_config.h @@ -0,0 +1,16 @@ +/* oct_config.h. Generated by configure. */ +/* Define if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define if your processor stores words with the most significant + byte first (like Motorola and SPARC, unlike Intel and VAX). */ +/* #undef WORDS_BIGENDIAN */ + +/* Define if you have the header file. */ +#define HAVE_DLFCN_H 1 + +/* Define if you have the m library (-lm). */ +#define HAVE_LIBM 1 + +typedef unsigned int var_t; +static const var_t max_index = 1<<(sizeof(int)*8-2); diff --git a/src/optimizer/oct/mineOct/oct_config_2.h b/src/optimizer/oct/mineOct/oct_config_2.h new file mode 100644 index 0000000..bc763a1 --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_config_2.h @@ -0,0 +1,35 @@ +#ifndef OCT_CONFIG_H__ +#define OCT_CONFIG_H__ + +#ifdef __cplusplus +extern "C" { +#endif + +/* oct_config.h. Generated by configure. */ +/* Define if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define if your processor stores words with the most significant + byte first (like Motorola and SPARC, unlike Intel and VAX). */ +/* #undef WORDS_BIGENDIAN */ + +/* Define if you have the header file. */ +#define HAVE_DLFCN_H 1 + +/* Define if you have the m library (-lm). */ +#define HAVE_LIBM 1 + +typedef unsigned int var_t; +static const var_t max_index = 1<<(sizeof(int)*8-2); + +#ifndef __cplusplus +#undef OCT_HAS_BOOL +#else +#define OCT_HAS_BOOL +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* OCT_CONFIG_H__ */ diff --git a/src/optimizer/oct/mineOct/oct_num.h b/src/optimizer/oct/mineOct/oct_num.h new file mode 100644 index 0000000..9b27d28 --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_num.h @@ -0,0 +1,1636 @@ +/* oct_num.h + Defines all underlying numerical domains as macros / inline functions. + This is automatically included by oct.h. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ + +#ifndef OCT_NUM_H__ +#define OCT_NUM_H__ + +#include +#include +#include +#include + +#ifdef OCT_HAS_GMP +#include +#endif + +#ifdef OCT_HAS_MPFR +#include +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/* zra */ +#define OCT_NUM_INT 1 + +/* here, exactely one of the following must be defined */ +/* OCT_NUM_INT un-saturated integers (int) */ +/* OCT_NUM_FLOAT floats (double) */ +/* OCT_NUM_LONGDOUBLE floats (long double) */ +/* OCT_NUM_FRAC rationals */ +/* OCT_NUM_GMP_INT GMP integers */ +/* OCT_NUM_GMP_FRAC GMP fractions */ +/* OCT_NUM_MPFR_FLOAT MPFR floats */ + + +/* All numerical types suppose perfect numbers: no treatement of modulo + arithmetic or overflow-as-error is done. + + Numerical types are *sound approximations* of perfect numbers: + a number that cannont be exactely represented is approximated by a + number this is greater, a number that cannot be overapproximated by + a finite number is approximated by +oo. + + Tests are either correct (integer, fractionnals) or semi-correct (floats). + In the later case, true means "really true" and "false" means "maybee + not true". If this is the case, operators on octagons are also + semi-correct. +*/ + + +/* WARNING + + the GMP / MPFR types has not been tested much + especially, conversion functions may not be correct! + +*/ + +typedef enum { + OCT_DOMAIN_INT = 0, /* numbers represent integers */ + OCT_DOMAIN_FRAC = 1, /* numbers represent rationals */ + OCT_DOMAIN_REAL = 2 /* numbers rerpesent reals */ +} num_domain_t; + +static const char* oct_domain_string[] = {"integers","rationals","reals"}; + + +/* generic functions */ + +#ifdef WORDS_BIGENDIAN + +static inline void swap_word(void* dst, const void* src, size_t t) +{ + unsigned char *s = (unsigned char*)src+t-1, *d = (unsigned char*) dst; + size_t i; + for (i=0;i>8)&0xff; + c[1] = i&0xff; +} + +static inline unsigned undump16(const unsigned char * c) +{ + return (unsigned)c[1]+(((unsigned)c[0])<<8); +} + +static inline void dump32(unsigned char * c, unsigned long i) +{ + c[0] = (i>>24)&0xff; + c[1] = (i>>16)&0xff; + c[2] = (i>>8)&0xff; + c[3] = i&0xff; +} + +static inline unsigned long undump32(const unsigned char * c) +{ + return (unsigned long)c[3]+(((unsigned long)c[2])<<8)+ + (((unsigned long)c[1])<<16)+(((unsigned long)c[0])<<24); +} + + + +/********************/ +/* Machine-integers */ +/********************/ + +/* unsafe in case of an overflow */ + +#ifdef OCT_NUM_INT + +#ifdef OCT_NUM +#error "only one OCT_NUM_ must be defined in oct_num.h" +#endif +#define OCT_NUM + +#define OCT_DOMAIN OCT_DOMAIN_INT +#define OCT_IMPLEMENTATION_STRING "long" + +typedef long num_t; + +static const num_t num__infty = (unsigned)(1<<(sizeof(num_t)*8-1))-1; + +/* constructors */ + +#define num_init(a) +#define num_init_n(a,n) +#define num_init_set(a,b) num_set((a),(b)) +#define num_init_set_n(a,b,n) num_set_n((a),(b),(n)) +#define num_init_set_int(a,b) num_set_int((a),(b)) +#define num_init_set_float(a,b) num_set_float((a),(b)) +#define num_init_set_frac(a,b,c) num_set_frac((a),(b),(c)) +#define num_init_set_infty(a) num_set_infty((a)) + +/* copy / update */ + +#define num_set(a,b) *(a) = *(b) +#define num_set_n(a,b,n) memcpy((a),(b),sizeof(num_t)*(n)); + +static inline void num_set_int(num_t* a, long i) +{ *a = (i<-num__infty || i>num__infty) ? num__infty : i; } + +static inline void num_set_float(num_t* a, double k) +{ k = ceil(k); *a = (k<-num__infty || k>num__infty) ? num__infty : (num_t)k; } + +#define num_set_frac(a,i,j) num_set_float((a),((double)(i))/((double)(j))) +#define num_set_infty(a) *(a) = num__infty + +/* destructors */ + +#define num_clear(a) +#define num_clear_n(a,n) + +/* conversions */ + +#define num_fits_int(a) (*(a) != num__infty) +#define num_fits_float(a) (*(a) != num__infty) +#define num_fits_frac(a) (*(a) != num__infty) + +#define num_get_int(a) ((long)*(a)) +#define num_get_float(a) ((double)*(a)) +#define num_get_num(a) ((long)*(a)) +#define num_get_den(a) (1L) + +/* tests */ + +#define num_infty(a) (*(a)==num__infty) + +static inline int num_cmp(const num_t* a, const num_t *b) +{ return (*a==*b)?0:(*a>*b)?1:-1; } + +static inline int num_cmp_int(const num_t* a, long b) +{ return (*a==b)?0:((*a>b)?1:-1); } + +static inline int num_cmp_zero(const num_t* a) +{ return (*a==0)?0:((*a>0)?1:-1); } + +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a>=*b) ? *a : *b; } + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a<=*b) ? *a : *b; } + +static inline void num_add(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a==num__infty || *b==num__infty) ? num__infty : *a + *b; } + +static inline void num_sub(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a==num__infty || *b==num__infty) ? num__infty : *a - *b; } + +static inline void num_mul(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a==num__infty || *b==num__infty) ? num__infty : *a * *b; } + +static inline void num_mul_by_2(num_t* r, const num_t* a) +{ *r = (*a==num__infty) ? num__infty : *a * 2; } + +static inline void num_div_by_2(num_t* r, const num_t* a) +{ *r = (*a==num__infty) ? num__infty : (*a>=0) ? (*a+1)/2 : *a/2; } + +static inline void num_neg(num_t* r, const num_t* a) +{ *r = (*a==num__infty) ? num__infty : -(*a); } + +/* printing */ + +static inline void num_print(const num_t* a) +{ if (*a!=num__infty) printf("%li",(long)*a); else printf("+oo"); } + +static inline void num_snprint(char* s, size_t n, const num_t* a) +{ if (*a!=num__infty) snprintf(s,n,"%li",(long)*a); else snprintf(s,n,"+oo"); } + +/* GMP conversion */ + +#ifdef OCT_HAS_GMP + +static inline void num_set_mpz(num_t* a, const mpz_t b) +{ + if (mpz_fits_slong_p(b)) num_set_int(a,mpz_get_si(b)); + else num_set_infty(a); +} + +#define num_get_mpz(a,b) mpz_set_si((a),*(b)) + +#define num_set_mpq(a,b) num_set_float((a),ceil(mpq_get_d((b)))) /* is it sound ? */ + +#define num_get_mpq(a,b) mpq_set_si((a),*(b),1) + +#endif + +#ifdef OCT_HAS_MPFR + +static inline void num_set_mpfr(num_t* a, const mpfr_t b) +{ + mpfr_t m; + mpfr_init(m); + mpfr_ceil(m,b); + num_set_float(a,mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpfr_clear(m); +} + +#define num_get_mpfr(a,b) mpfr_set_si((a),*(b),GMP_RNDU) + +#endif + + +#undef OCT_NUM_CLOSED +#undef OCT_NUM_EXACT + +/* serialization */ + +#define OCT_NUM_SERIALIZE + +static const int num_serialize_id = 0x1000+sizeof(num_t); + +static inline size_t num_serialize(const num_t* a, void* c) +{ swap_word(c,a,sizeof(num_t)); return sizeof(num_t); } + +static inline size_t num_deserialize(num_t* a, const void* c) +{ swap_word(a,c,sizeof(num_t)); return sizeof(num_t); } + +static inline size_t num_serialize_size(num_t* a) +{ return sizeof(num_t); } + + +#endif + + + +/******************/ +/* Machine-floats */ +/******************/ + + +/* define OCT_DEBUG_NAN if you want to check that there is no NaN in the + library +*/ + +#if defined(OCT_NUM_FLOAT) || defined(OCT_NUM_LONGDOUBLE) + +#ifdef OCT_NUM +#error "only one OCT_NUM_ must be defined in oct_num.h" +#endif +#define OCT_NUM + +#define OCT_DOMAIN OCT_DOMAIN_REAL + +#ifdef OCT_NUM_LONGDOUBLE +#define OCT_IMPLEMENTATION_STRING "long double" +typedef long double num_t; +#else +#define OCT_IMPLEMENTATION_STRING "double" +typedef double num_t; +#endif + +#ifdef __INTEL_COMPILER +#define num__infty (1.0/0.0) +#else +static const num_t num__infty = ((num_t)1.0)/((num_t)0.0); +#endif +static const num_t max_long = (num_t) (((unsigned long)(-1))>>1); + +/* constructors */ + +#define num_init(a) +#define num_init_n(a,n) +#define num_init_set(a,b) num_set((a),(b)) +#define num_init_set_n(a,b,n) num_set_n((a),(b),(n)) +#define num_init_set_int(a,b) num_set_int((a),(b)) +#define num_init_set_float(a,b) num_set_float((a),(b)) +#define num_init_set_frac(a,b,c) num_set_frac((a),(b),(c)) +#define num_init_set_infty(a) num_set_infty((a)) + +/* copy / update */ + +#define num_set(a,b) *(a) = *(b) +#define num_set_n(a,b,n) memcpy((a),(b),sizeof(num_t)*(n)); + +#define num_set_int(a,i) *(a) = (num_t)(i) + +#ifdef OCT_DEBUG_NAN +#define num_set_float(a,k) do{ *(a) = (num_t)(k); OCT_ASSERT(!isnan(*(a)),"NaN in num_set_float"); }while(0) +#else +#define num_set_float(a,k) *(a) = (num_t)(k) +#endif + +#define num_set_frac(a,i,j) *(a) = ((num_t)(i))/((num_t)(j)) +#define num_set_infty(a) *(a) = num__infty + +/* destructors */ + +#define num_clear(a) +#define num_clear_n(a,n) + +/* conversions */ + +static inline bool num_fits_int(const num_t* a) +{ + num_t d = ceil(*a); + return d!=num__infty && d<=max_long && d>=-max_long; +} + +#define num_fits_float(a) (*(a) != num__infty) + +#define num_fits_frac(a) num_fits_int((a)) + +#define num_get_int(a) ((long)*(a)) +#define num_get_float(a) ((double)*(a)) +#define num_get_num(a) ((long)ceil(*(a))) +#define num_get_den(a) (1L) + +/* tests */ + +#define num_infty(a) (*(a)==num__infty) + +static inline int num_cmp(const num_t* a, const num_t *b) +{ return (*a==*b) ? 0 : (*a>*b) ? 1 : -1; } + +static inline int num_cmp_int(const num_t* a, long b) +{ num_t bb = (num_t)b; return (*a==bb) ? 0 : (*a>bb) ? 1 : -1; } + +static inline int num_cmp_zero(const num_t* a) +{ return (*a==0.)?0:((*a>0.)?1:-1); } + +/* operations */ + +#ifdef OLD_MIN_MAX +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a>=*b) ? *a : *b; } + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a<=*b) ? *a : *b; } + +#else + /* DM: this version compiles to minsd/maxsd on SSE + (the other version is not equivalent in general because of NaNs ) */ +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a > *b) ? *a : *b; } + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ *r = (*a < *b) ? *a : *b; } +#endif + +#ifdef OCT_DEBUG_NAN +#define num_add(r,a,b) do{ *(r) = *(a) + *(b); OCT_ASSERT(!isnan(*(r)),"NaN in num_add"); }while(0) +#define num_sub(r,a,b) do{ *(r) = *(a) - *(b); OCT_ASSERT(!isnan(*(r)),"NaN in num_sub"); }while(0) +#define num_mul(r,a,b) do{ *(r) = *(a) * *(b); OCT_ASSERT(!isnan(*(r)),"NaN in num_mul"); }while(0) +#define num_mul_by_2(r,a) do{ *(r) = *(a) * 2.; OCT_ASSERT(!isnan(*(r)),"NaN in num_mul_by_2"); }while(0) +#define num_div_by_2(r,a) do{ *(r) = *(a) / 2.; OCT_ASSERT(!isnan(*(r)),"NaN in num_div_by_2"); }while(0) +#define num_neg(r,a) do{ *(r) = - *(a); OCT_ASSERT(!isnan(*(r)),"NaN in num_neg"); }while(0) +#else +#define num_add(r,a,b) *(r) = *(a) + *(b) +#define num_sub(r,a,b) *(r) = *(a) - *(b) +#define num_mul(r,a,b) *(r) = *(a) * *(b) +#define num_mul_by_2(r,a) *(r) = *(a) * 2. +#define num_div_by_2(r,a) *(r) = *(a) / 2. +#define num_neg(r,a) *(r) = - *(a) +#endif + +/* printing */ + +#ifdef OCT_NUM_LONGDOUBLE + +static inline void num_print(const num_t* a) +{ if (*a!=num__infty) printf("%.20Lg",(long double)*a+0.); + else printf("+oo"); } + +static inline void num_snprint(char* s, size_t n, const num_t* a) +{ if (*a!=num__infty) snprintf(s,n,"%.20Lg",(long double)*a+0.); + else snprintf(s,n,"+oo");} + +#else + +static inline void num_print(const num_t* a) +{ if (*a!=num__infty) printf("%.20g",(double)*a+0.); + else printf("+oo"); } + +static inline void num_snprint(char* s, size_t n, const num_t* a) +{ if (*a!=num__infty) snprintf(s,n,"%.20g",(double)*a+0.); + else snprintf(s,n,"+oo");} + + +#endif + + +/* GMP conversion */ + +#ifdef OCT_HAS_GMP + +#define num_set_mpz(a,b) *(a)=mpz_get_d((b)) /* is this sound ? */ +#define num_get_mpz(a,b) mpz_set_d((a),ceil(*(b))) +#define num_set_mpq(a,b) *(a)=mpq_get_d((b)) /* is this sound ? */ +#define num_get_mpq(a,b) mpq_set_d((a),*(b)) + +#endif + +#ifdef OCT_HAS_MPFR + +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) +#define num_set_mpfr(a,b) *(a)=mpfr_get_d((b), GMP_RNDU) +#else +#define num_set_mpfr(a,b) *(a)=mpfr_get_d((b)) +#endif + +#define num_get_mpfr(a,b) mpfr_set_d((a),*(b),GMP_RNDU) + +#endif + + +#define OCT_NUM_CLOSED +#undef OCT_NUM_EXACT + + +/* serialization */ + +#define OCT_NUM_SERIALIZE + +static const int num_serialize_id = 0x1100+sizeof(num_t); + +static inline size_t num_serialize(const num_t* a, void* c) +{ swap_word(c,a,sizeof(num_t)); return sizeof(num_t); } + +static inline size_t num_deserialize(num_t* a, const void* c) +{ swap_word(a,c,sizeof(num_t)); return sizeof(num_t); } + +static inline size_t num_serialize_size(num_t* a) +{ return sizeof(num_t); } + +#endif + + +/********************************/ +/* Rationals using machine-ints */ +/********************************/ + +#ifdef OCT_NUM_FRAC + +#ifdef OCT_NUM +#error "only one OCT_NUM_ must be defined in oct_num.h" +#endif +#define OCT_NUM + +#define OCT_DOMAIN OCT_DOMAIN_FRAC +#define OCT_IMPLEMENTATION_STRING "long" + +typedef long coef_t; + +/* all rationals are kept in irreductible form */ +typedef struct { + coef_t n; /* numerator */ + coef_t d; /* denominator, >=0 */ +} num_t; + +static const num_t num__infty = { 1,0 }; + +static const coef_t coef_overflow = ((coef_t)1<<(sizeof(coef_t)*4-1))-1; + +static +inline +void +num_normalize (num_t* r) +{ + if (r->d) { + /* euclide */ + coef_t pgcd, b; + pgcd = (r->n<0) ? -r->n : r->n; + b = r->d; + while (b) { + coef_t r = pgcd%b; + pgcd = b; + b = r; + } + r->n /= pgcd; + r->d /= pgcd; + if (r->n<=-coef_overflow || r->n>=coef_overflow || r->d>=coef_overflow) + r->d = 0; + } +} + +/* constructors */ + +#define num_init(a) +#define num_init_n(a,n) +#define num_init_set(a,b) num_set((a),(b)) +#define num_init_set_n(a,b,n) num_set_n((a),(b),(n)) +#define num_init_set_int(a,b) num_set_int((a),(b)) +#define num_init_set_float(a,b) num_set_float((a),(b)) +#define num_init_set_frac(a,b,c) num_set_frac((a),(b),(c)) +#define num_init_set_infty(a) num_set_infty((a)) + +/* copy / update */ + +#define num_set(a,b) *(a) = *(b) +#define num_set_n(a,b,n) memcpy((a),(b),sizeof(num_t)*(n)); + +static inline void num_set_int(num_t* a, long i) +{ a->n = (coef_t)i; a->d = 1; num_normalize(a); } + +static inline void num_set_float(num_t* a, double k) +{ + k = ceil(k); + if (k<(double)-coef_overflow || k>(double)coef_overflow) *a = num__infty; + else { a->n = (coef_t)k; a->d = 1; num_normalize(a); } +} + +static inline void num_set_frac(num_t* a, long i, long j) +{ + if (j>=0) { a->n=(coef_t)i; a->d=(coef_t)j; } + else { a->n=(coef_t)-i; a->d=(coef_t)-j; } + num_normalize(a); +} + +#define num_set_infty(a) *(a) = num__infty + +/* destructors */ + +#define num_clear(a) +#define num_clear_n(a,n) + +/* conversions */ + +#define num_fits_int(a) ((a)->d!=0) +#define num_fits_float(a) ((a)->d!=0) +#define num_fits_frac(a) ((a)->d!=0) + +#define num_get_int(a) ((long)ceil(((double)((a)->n))/((double)((a)->d)))) +#define num_get_float(a) (((double)((a)->n))/((double)((a)->d))) +#define num_get_num(a) ((long)(a)->n) +#define num_get_den(a) ((long)(a)->d) + +/* tests */ + +#define num_infty(a) ((a)->d==0) + +static inline int num_cmp(const num_t* a, const num_t* b) +{ + if (!a->d) { + if (!b->d) return 0; + else return 1; + } + if (!b->d) return -1; + else { + const coef_t aa = a->n*b->d; + const coef_t bb = a->d*b->n; + if (aa==bb) return 0; + if (aa>bb) return 1; + return -1; + } +} + +static inline int num_cmp_int(const num_t* a, long b) +{ + if (!a->d) return 1; + else if (b<=-coef_overflow) return 1; + else if (b>= coef_overflow) return -1; + else { + const coef_t aa = a->n; + const coef_t bb = a->d*b; + if (aa==bb) return 0; + if (aa>bb) return 1; + return -1; + } +} + +static inline int num_cmp_zero(const num_t* a) +{ return (!a->d) ? 1 : ((a->n==0) ? 0 : ((a->n>0) ? 1 : -1)); } + +/* operations */ + +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ *r = (!a->d || !b->d) ? num__infty : (a->n*b->d>=b->n*a->d) ? *a : *b; } + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ *r = (!a->d) ? *b : (!b->d) ? *a : (a->n*b->d<=b->n*a->d) ? *a : *b; } + +static inline void num_add(num_t* r, const num_t* a, const num_t* b) +{ coef_t d=a->d*b->d; r->n=a->n*b->d+a->d*b->n; r->d=d; num_normalize(r); } + +static inline void num_sub(num_t* r, const num_t* a, const num_t* b) +{ coef_t d=a->d*b->d; r->n=a->n*b->d-a->d*b->n; r->d=d; num_normalize(r); } + +static inline void num_mul(num_t* r, const num_t* a, const num_t* b) +{ r->n = a->n*b->n; r->d = a->d*b->d; num_normalize(r); } + +static inline void num_mul_by_2(num_t* r, const num_t* a) +{ + *r = *a; + if (r->d & 1) { + r->n *= 2; + if (r->n<=-coef_overflow || r->n>=coef_overflow) r->d = 0; + } + else r->d /= 2; +} + +static inline void num_div_by_2(num_t* r, const num_t* a) +{ + *r = *a; + if (r->n & 1) { r->d *= 2; if (r->d>=coef_overflow) r->d = 0; } + else r->n /= 2; +} + +static inline void num_neg(num_t* r, const num_t* a) +{ r->n = -a->n; r->d = a->d; } + +/* printing */ + +static +inline +void +num_print(const num_t* a) +{ + if (a->d) + if (!a->n) printf("0"); + else if (a->d==1) printf("%li",(long)a->n); + else printf("%li/%li",(long)a->n,(long)a->d); + else printf("+oo"); +} + +static +inline +void +num_snprint(char* s, size_t n, const num_t* a) +{ + if (a->d) + if (!a->n) snprintf(s,n,"0"); + else if (a->d==1) snprintf(s,n,"%li",(long)a->n); + else snprintf(s,n,"%li/%li",(long)a->n,(long)a->d); + else snprintf(s,n,"+oo"); +} + +/* GMP conversion */ + +#ifdef OCT_HAS_GMP + +static inline void num_set_mpz(num_t* a, const mpz_t b) +{ + if (mpz_fits_slong_p(b)) num_set_int(a,mpz_get_si(b)); + else num_set_infty(a); +} + +#define num_get_mpz(a,b) mpz_set_si((a),num_get_int((b))) + +static inline void num_set_mpq(num_t* a, const mpq_t b) +{ + if (mpz_fits_slong_p(mpq_numref(b)) && + mpz_fits_slong_p(mpq_denref(b))) + num_set_frac(a,mpz_get_si(mpq_numref(b)),mpz_get_si(mpq_denref(b))); + else num_set_infty(a); +} + +#define num_get_mpq(a,b) mpq_set_si((a),(b)->n,(b)->d) + +#endif + +#ifdef OCT_HAS_MPFR + +static inline void num_set_mpfr(num_t* a, const mpfr_t b) +{ + mpfr_t m; + mpfr_init(m); + mpfr_ceil(m,b); + num_set_float(a,mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpfr_clear(m); +} + +static inline void num_get_mpfr(mpfr_t a, const num_t* b) +{ mpfr_set_si(a,b->n,GMP_RNDU); mpfr_div_ui(a,a,b->d,GMP_RNDU); } + +#endif + +#define OCT_NUM_CLOSED +#define OCT_NUM_EXACT + +/* serialization */ + +#define OCT_NUM_SERIALIZE + +static const int num_serialize_id = 0x1200+sizeof(coef_t); + +static inline size_t num_serialize(const num_t* a, void* c) +{ + swap_word(c,&a->n,sizeof(coef_t)); + swap_word((char*)c+sizeof(coef_t),&a->d,sizeof(coef_t)); + return 2*sizeof(coef_t); +} + +static inline size_t num_deserialize(num_t* a, const void* c) +{ + swap_word(&a->n,c,sizeof(coef_t)); + swap_word(&a->d,(char*)c+sizeof(coef_t),sizeof(coef_t)); + return 2*sizeof(coef_t); +} + +static inline size_t num_serialize_size(num_t* a) +{ return 2*sizeof(coef_t); } + + +#endif + + +/****************/ +/* GMP Integers */ +/****************/ + +#ifdef OCT_NUM_GMP_INT + +#ifndef OCT_HAS_GMP +#error "the gmpint numerical type requires the GMP library" +#endif + +#ifdef OCT_NUM +#error "only one OCT_NUM_ must be defined in oct_num.h" +#endif +#define OCT_NUM + +#define OCT_DOMAIN OCT_DOMAIN_INT +#define OCT_IMPLEMENTATION_STRING "GMP mpz" + + +typedef struct { + mpz_t num; /* always allocated, even if inf=1 */ + char inf; /* 1 => +oo; 0 => <+oo */ +} num_t; + +static const double double_infty = ((double)1.0)/((double)0.0); +static const double double_minfty = -((double)1.0)/((double)0.0); + +/* constructors */ + +#define num_init(a) mpz_init((a)->num) + + +static inline void num_init_n(num_t* a, size_t n) +{ size_t i; for (i=0;iinf=b->inf; if (a->inf) mpz_init(a->num); else mpz_init_set(a->num,b->num); } + +static inline void num_init_set_n(num_t* a, const num_t* b, size_t n) +{ size_t i; for (i=0;iinf=0; mpz_init_set_si(a->num,i); } + +static inline void num_init_set_float(num_t* a, double d) +{ a->inf=0; mpz_init_set_d(a->num,ceil(d)); } + +#define num_init_set_frac(a,i,j) num_init_set_float((a),((double)(i))/((double)(j))) + +static inline void num_init_set_infty(num_t* a) { a->inf=1; mpz_init(a->num); } + +/* copy / update */ + +static inline void num_set(num_t* a, const num_t* b) +{ a->inf=b->inf; if (!a->inf) mpz_set(a->num,b->num); } + +static inline void num_set_n(num_t* a, const num_t* b, size_t n) +{ size_t i; for (i=0;iinf=0; mpz_set_si(a->num,i); } + +static inline void num_set_float(num_t* a, double d) +{ a->inf=0; mpz_set_d(a->num,ceil(d)); } + +#define num_set_frac(a,i,j) num_set_float((a),((double)(i))/((double)(j))) + +#define num_set_infty(a) (a)->inf=1 + +/* destructors */ + +#define num_clear(a) mpz_clear((a)->num) + +static inline void num_clear_n(num_t* a, size_t n) +{ size_t i; for (i=0;iinf && mpz_fits_slong_p(a->num); } + +static inline bool num_fits_float(const num_t* a) +{ + double d = mpz_get_d(a->num); + return !a->inf && d!=double_infty && d!=double_minfty; +} + +#define num_fits_frac(a) num_fits_int(a) + +#define num_get_int(a) mpz_get_si((a)->num) +#define num_get_float(a) mpz_get_d((a)->num) +#define num_get_num(a) mpz_get_si((a)->num) +#define num_get_den(a) (1L) + + +/* GMP conversion */ + +#define num_get_mpz(a,b) mpz_set((a),(b)->num) +#define num_get_mpq(a,b) mpq_set_z((a),(b)->num) + +static inline void num_set_mpz(num_t *a, const mpz_t b) +{ mpz_set(a->num,b); a->inf=0; } + +static inline void num_set_mpq(num_t *a, const mpq_t b) +{ mpz_cdiv_q(a->num, mpq_numref(b), mpq_denref(b)); } + + +#ifdef OCT_HAS_MPFR + +#define num_get_mpfr(a,b) mpfr_set_z((a),(b)->num,GMP_RNDU) + +static inline void num_set_mpfr(num_t *a, const mpfr_t b) +{ + mpfr_t m; + mpfr_init(m); + mpfr_ceil(m,b); + num_set_float(a,mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpfr_clear(m); +} + +#endif + +/* tests */ + +#define num_infty(a) ((a)->inf!=0) + +static inline int num_cmp(const num_t* a, const num_t* b) +{ + if (a->inf) { + if (b->inf) return 0; + else return 1; + } + if (b->inf) return -1; + return mpz_cmp(a->num,b->num); +} + +static inline int num_cmp_int(const num_t* a, long i) +{ if (a->inf) return 1; return mpz_cmp_si(a->num,i); } + +static inline int num_cmp_zero(const num_t* a) +{ return num_cmp_int(a,0); } + +/* operations */ + +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpz_set(r->num,mpz_cmp(a->num,b->num)>0?a->num:b->num); } +} + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf) + if (b->inf) r->inf=1; + else { r->inf=0; mpz_set(r->num,b->num); } + else if (b->inf) { r->inf=0; mpz_set(r->num,a->num); } + else { r->inf=0; mpz_set(r->num,mpz_cmp(a->num,b->num)<0?a->num:b->num); } +} + +static inline void num_add(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpz_add(r->num,a->num,b->num); } +} + +static inline void num_sub(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpz_sub(r->num,a->num,b->num); } +} + +static inline void num_mul(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpz_mul(r->num,a->num,b->num); } +} + +static inline void num_mul_by_2(num_t* r, const num_t* a) +{ + if (a->inf) r->inf=1; + else { r->inf=0; mpz_mul_2exp(r->num,a->num,1); } +} + +static inline void num_div_by_2(num_t* r, const num_t* a) +{ + if (a->inf) r->inf=1; + else { r->inf=0; mpz_cdiv_q_2exp(r->num,a->num,1); } +} + +static inline void num_neg(num_t* r, const num_t* a) +{ + if (a->inf) r->inf=1; + else { r->inf=0; mpz_neg(r->num,a->num); } +} + +/* printing */ + +static inline void num_print(const num_t* a) +{ + if (a->inf) printf("+oo"); + else mpz_out_str(stdout,10,a->num); +} + +static inline void num_snprint(char* s, size_t n, const num_t* a) +{ + if (a->inf) snprintf(s,n,"+oo"); + else if (mpz_sizeinbase(a->num,10)+2>n) + if (mpz_sgn(a->num)>0) snprintf(s,n,"+BIG"); + else snprintf(s,n,"-BIG"); + else mpz_get_str(s,10,a->num); +} + +#undef OCT_NUM_CLOSED +#undef OCT_NUM_EXACT + + +/* serialization */ + +#define OCT_NUM_SERIALIZE + +static const int num_serialize_id = 0x1300; + +static inline size_t num_serialize(const num_t* a, void* c) +{ + size_t count; + *((char*)c) = a->inf; + if (a->inf) return 1; + *((char*)c+1) = mpz_sgn(a->num); + mpz_export((char*)c+6,&count,1,1,1,0,a->num); + dump32((unsigned char*)c+2,count); + return count+6; +} + +static inline size_t num_deserialize(num_t* a, const void* c) +{ + size_t count; + a->inf = *(char*)c; + if (a->inf) return 1; + count = undump32((unsigned char*)c+2); + mpz_import(a->num,count,1,1,1,0,(char*)c+6); + if (*((char*)c+1)<0) { + mpz_neg(a->num,a->num); + } + return count+6; +} + +/* note: this does not give the exact size of serialized data, but a sound + overapproximation +*/ +static inline size_t num_serialize_size(num_t* a) +{ + if (a->inf) return 1; + return mpz_sizeinbase(a->num,2)/8+6+sizeof(mp_limb_t); +} + + +#endif + + + + +/*****************/ +/* GMP Rationals */ +/*****************/ + +#ifdef OCT_NUM_GMP_FRAC + +#ifndef OCT_HAS_GMP +#error "the gmpfrac numerical type requires the GMP library" +#endif + +#ifdef OCT_NUM +#error "only one OCT_NUM_ must be defined in oct_num.h" +#endif +#define OCT_NUM + +#define OCT_DOMAIN OCT_DOMAIN_FRAC +#define OCT_IMPLEMENTATION_STRING "GMP mpq" + +typedef struct { + mpq_t num; /* always allocated, even if inf=1 */ + char inf; /* 1 => +oo; 0 => <+oo */ +} num_t; + +static const double double_infty = ((double)1.0)/((double)0.0); +static const double double_minfty = -((double)1.0)/((double)0.0); +static const double max_long = (double) (((unsigned long)(-1))>>1); + +/* constructors */ + +#define num_init(a) mpq_init((a)->num) + +static inline void num_init_n(num_t* a, size_t n) +{ size_t i; for (i=0;iinf=b->inf; mpq_init(a->num); if (!a->inf) mpq_set(a->num,b->num); } + +static inline void num_init_set_n(num_t* a, const num_t* b, size_t n) +{ size_t i; for (i=0;iinf=0; mpq_init(a->num); mpq_set_si(a->num,i,1); } + +static inline void num_init_set_float(num_t* a, double d) +{ a->inf=0; mpq_init(a->num); mpq_set_d(a->num,d); } + +static inline void num_init_set_frac(num_t* a, long i, long j) +{ + if (j<0) { i=-i; j=-j; } + a->inf=0; mpq_init(a->num); mpq_set_si(a->num,i,j); + mpq_canonicalize(a->num); +} + +static inline void num_init_set_infty(num_t* a) +{ a->inf=1; mpq_init(a->num); } + +/* copy / update */ + +static inline void num_set(num_t* a, const num_t* b) +{ a->inf=b->inf; if (!a->inf) mpq_set(a->num,b->num); } + +static inline void num_set_n(num_t* a, const num_t* b, size_t n) +{ size_t i; for (i=0;iinf=0; mpq_set_si(a->num,i,1); } + +static inline void num_set_float(num_t* a, double d) +{ a->inf=0; mpq_set_d(a->num,d); } + +static inline void num_set_frac(num_t* a, long i, long j) +{ + if (j<0) { i=-i; j=-j; } + a->inf=0; mpq_set_si(a->num,i,j); + mpq_canonicalize(a->num); +} + +#define num_set_infty(a) (a)->inf=1 + +/* destructors */ + +#define num_clear(a) mpq_clear((a)->num) + +static inline void num_clear_n(num_t* a, size_t n) +{ size_t i; for (i=0;iinf) return false; + d = ceil(mpq_get_d(a->num)); + return d<=max_long && d>=-max_long; +} + +static inline bool num_fits_float(const num_t* a) +{ + double d = mpq_get_d(a->num); + return !a->inf && d!=double_infty && d!=double_minfty; +} + +static inline bool num_fits_frac(const num_t* a) +{ return !a->inf && mpz_fits_slong_p(mpq_numref(a->num)) + && mpz_fits_slong_p(mpq_denref(a->num)); } + + +static inline long num_get_int(const num_t* a) +{ return (long)ceil(mpq_get_d(a->num)); /* Bad... */ } + +#define num_get_float(a) mpq_get_d((a)->num) +#define num_get_num(a) mpz_get_si(mpq_numref((a)->num)) +#define num_get_den(a) mpz_get_si(mpq_denref((a)->num)) + + +/* GMP conversion */ + +#define num_get_mpq(a,b) mpq_set((a),(b)->num) + +static inline void num_set_mpq(num_t *a, const mpq_t b) +{ mpq_set(a->num,b); a->inf=0; } + +static inline void num_set_mpz(num_t *a, const mpz_t b) +{ mpq_set_z(a->num,b); a->inf=0; } + +static inline void num_get_mpz(mpz_t a, const num_t* b) +{ mpz_cdiv_q(a, mpq_numref(b->num), mpq_denref(b->num)); } + + + +#ifdef OCT_HAS_MPFR + +#define num_get_mpfr(a,b) mpfr_set_q((a),(b)->num,GMP_RNDU) + +static inline void num_set_mpfr(num_t *a, const mpfr_t b) +{ + mpfr_t m; + mpfr_init(m); + mpfr_ceil(m,b); + num_set_float(a,mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpfr_clear(m); +} + + +#endif + + +/* tests */ + +#define num_infty(a) ((a)->inf!=0) + +static inline int num_cmp(const num_t* a, const num_t* b) +{ + if (a->inf) { + if (b->inf) return 0; + else return 1; + } + if (b->inf) return -1; + return mpq_cmp(a->num,b->num); +} + +static inline int num_cmp_int(const num_t* a, long i) +{ if (a->inf) return 1; return mpq_cmp_si(a->num,i,1); } + +static inline int num_cmp_zero(const num_t* a) +{ return num_cmp_int(a,0); } + +/* operations */ + +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpq_set(r->num,mpq_cmp(a->num,b->num)>0?a->num:b->num); } +} + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf) + if (b->inf) r->inf=1; + else { r->inf=0; mpq_set(r->num,b->num); } + else if (b->inf) { r->inf=0; mpq_set(r->num,a->num); } + else { r->inf=0; mpq_set(r->num,mpq_cmp(a->num,b->num)<0?a->num:b->num); } +} + +static inline void num_add(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpq_add(r->num,a->num,b->num); } +} + +static inline void num_sub(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpq_sub(r->num,a->num,b->num); } +} + +static inline void num_mul(num_t* r, const num_t* a, const num_t* b) +{ + if (a->inf || b->inf) r->inf=1; + else { r->inf=0; mpq_mul(r->num,a->num,b->num); } +} + +static inline void num_mul_by_2(num_t* r, const num_t* a) +{ + if (a->inf) r->inf=1; + else { r->inf=0; mpq_mul_2exp(r->num,a->num,1); } +} + +static inline void num_div_by_2(num_t* r, const num_t* a) +{ + if (a->inf) r->inf=1; + else { r->inf=0; mpq_div_2exp(r->num,a->num,1); } +} + +static inline void num_neg(num_t* r, const num_t* a) +{ + if (a->inf) r->inf=1; + else { r->inf=0; mpq_neg(r->num,a->num); } +} + +/* printing */ + +static inline void num_print(const num_t* a) +{ + if (a->inf) printf("+oo"); + else if (!mpz_cmp_si(mpq_denref(a->num),1)) + mpz_out_str(stdout,10,mpq_numref(a->num)); + else mpq_out_str(stdout,10,a->num); +} + +static inline void num_snprint(char* s, size_t n, const num_t* a) +{ + if (a->inf) snprintf(s,n,"+oo"); + else if (mpz_sizeinbase(mpq_numref(a->num),10)+ + mpz_sizeinbase(mpq_denref(a->num),10)+3>n) + if (mpq_sgn(a->num)>0) snprintf(s,n,"+BIG"); + else snprintf(s,n,"-BIG"); + else + if (!mpz_cmp_si(mpq_denref(a->num),1)) + mpz_get_str(s,10,mpq_numref(a->num)); + else { + mpz_get_str(s,10,mpq_numref(a->num)); + strcat(s,"/"); + mpz_get_str(s+strlen(s),10,mpq_denref(a->num)); + } +} + + +#define OCT_NUM_CLOSED +#define OCT_NUM_EXACT + + +/* serialization */ + +#define OCT_NUM_SERIALIZE + +static const int num_serialize_id = 0x1400; + +static inline size_t num_serialize(const num_t* a, void* c) +{ + size_t count1,count2; + *((char*)c) = a->inf; + if (a->inf) return 1; + *((char*)c+1) = mpq_sgn(a->num); + mpz_export((char*)c+10,&count1,1,1,1,0,mpq_numref(a->num)); + mpz_export((char*)c+10+count1,&count2,1,1,1,0,mpq_denref(a->num)); + dump32((unsigned char*)c+2,count1); + dump32((unsigned char*)c+6,count2); + return count1+count2+10; +} + +static inline size_t num_deserialize(num_t* a, const void* c) +{ + size_t count1,count2; + a->inf = *(char*)c; + if (a->inf) return 1; + count1 = undump32((unsigned char*)c+2); + count2 = undump32((unsigned char*)c+6); + mpz_import(mpq_numref(a->num),count1,1,1,1,0,(char*)c+10); + mpz_import(mpq_denref(a->num),count2,1,1,1,0,(char*)c+10+count1); + if (*((char*)c+1)<0) { + mpq_neg(a->num,a->num); + } + return count1+count2+10; +} + +/* note: this does not give the exact size of serialized data, but a sound + overapproximation +*/ +static inline size_t num_serialize_size(num_t* a) +{ + if (a->inf) return 1; + return + (mpz_sizeinbase(mpq_numref(a->num),2)+ + mpz_sizeinbase(mpq_denref(a->num),2))/8+10+2*sizeof(mp_limb_t); +} + + +#endif + + + +/***************/ +/* MPFR Floats */ +/***************/ + +#ifdef OCT_NUM_MPFR_FLOAT + +#ifndef OCT_HAS_GMP +#error "the mpfrfloat numerical type requires the GMP library" +#endif + +#ifndef OCT_HAS_MPFR +#error "the mpfrfloat numerical type requires the MPFR library" +#endif + +#ifdef OCT_NUM +#error "only one OCT_NUM_ must be defined in oct_num.h" +#endif +#define OCT_NUM + +#define OCT_DOMAIN OCT_DOMAIN_REAL +#define OCT_IMPLEMENTATION_STRING "GMP mpfr" + +typedef struct { + mpfr_t num; +} num_t; + +static const double double_infty = ((double)1.0)/((double)0.0); +static const double double_minfty = -((double)1.0)/((double)0.0); +static const double max_long = (double) (((unsigned long)(-1))>>1); + +/* constructors */ + +#define num_init(a) mpfr_init((a)->num) + +static inline void num_init_n(num_t* a, size_t n) +{ size_t i; for (i=0;inum,(b)->num,GMP_RNDU) + +static inline void num_init_set_n(num_t* a, const num_t* b, size_t n) +{ size_t i; for (i=0;inum,(i),GMP_RNDU) +#define num_init_set_float(a,d) mpfr_init_set_d ((a)->num,(d),GMP_RNDU) + +static inline void num_init_set_frac(num_t* a, long i, long j) +{ + if (j<0) { i=-i; j=-j; } + mpfr_init_set_si(a->num,i,GMP_RNDU); + mpfr_div_ui(a->num,a->num,j,GMP_RNDU); +} + +#define num_init_set_infty(a) mpfr_init_set_d((a)->num,double_infty,GMP_RNDU) + +/* copy / update */ + +#define num_set(a,b) mpfr_set((a)->num,(b)->num,GMP_RNDU) + +static inline void num_set_n(num_t* a, const num_t* b, size_t n) +{ size_t i; for (i=0;inum,(i),GMP_RNDU) +#define num_set_float(a,d) mpfr_set_d ((a)->num,(d),GMP_RNDU) + +static inline void num_set_frac(num_t* a, long i, long j) +{ + if (j<0) { i=-i; j=-j; } + mpfr_set_si(a->num,i,GMP_RNDU); + mpfr_div_ui(a->num,a->num,j,GMP_RNDU); +} + +#define num_set_infty(a) mpfr_set_d((a)->num,double_infty,GMP_RNDU) + +/* destructors */ + +#define num_clear(a) mpfr_clear((a)->num) + +static inline void num_clear_n(num_t* a, size_t n) +{ size_t i; for (i=0;inum)) return false; + mpfr_init(m); + mpfr_ceil(m,a->num); + d = mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + ); + b = d<=max_long && d>=-max_long; + mpfr_clear(m); + return b; +} + +static inline bool num_fits_float(const num_t* a) +{ + double d = mpfr_get_d(a->num +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + ); + return d!=double_infty && d!=double_minfty; +} + +#define num_fits_frac(a) num_fits_int(a) + +static inline long num_get_int(const num_t* a) +{ + mpfr_t m; + long l; + mpfr_init(m); + mpfr_ceil(m,a->num); + l = (long)ceil(mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpfr_clear(m); + return l; +} + +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) +#define num_get_float(a) mpfr_get_d((a)->num, GMP_RNDU) +#else +#define num_get_float(a) mpfr_get_d((a)->num) +#endif + +#define num_get_num(a) num_get_int(a) +#define num_get_den(a) (1L) + + +/* GMP conversion */ + +#define num_set_mpz(a,b) mpfr_set_z((a)->num,(b),GMP_RNDU) +#define num_set_mpq(a,b) mpfr_set_q((a)->num,(b),GMP_RNDU) +#define num_set_mpfr(a,b) mpfr_set((a)->num,(b),GMP_RNDU) + +#define num_get_mpfr(a,b) mpfr_set((a),(b)->num,GMP_RNDU) + +static inline void num_get_mpz(mpz_t b, const num_t* a) +{ + mpfr_t m; + long l; + mpfr_init(m); + mpfr_ceil(m,a->num); + l = (long)ceil(mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpz_set_si(b,l); + mpfr_clear(m); +} + +static inline void num_get_mpq(mpq_t b, const num_t* a) +{ + mpfr_t m; + long l; + mpfr_init(m); + mpfr_ceil(m,a->num); + l = (long)ceil(mpfr_get_d(m +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + mpq_set_si(b,l,1); + mpfr_clear(m); +} + + + +/* tests */ + +#define num_infty(a) mpfr_inf_p((a)->num) +#define num_cmp(a,b) mpfr_cmp((a)->num,(b)->num) +#define num_cmp_int(a,b) mpfr_cmp_si((a)->num,(b)) +#define num_cmp_zero(a) mpfr_cmp_si((a)->num,0) + +/* operations */ + +static inline void num_max(num_t* r, const num_t* a, const num_t* b) +{ mpfr_set(r->num,mpfr_cmp(a->num,b->num)>0?a->num:b->num,GMP_RNDU); } + +static inline void num_min(num_t* r, const num_t* a, const num_t* b) +{ mpfr_set(r->num,mpfr_cmp(a->num,b->num)<0?a->num:b->num,GMP_RNDU); } + +#define num_add(r,a,b) mpfr_add((r)->num,(a)->num,(b)->num,GMP_RNDU) +#define num_sub(r,a,b) mpfr_sub((r)->num,(a)->num,(b)->num,GMP_RNDU) +#define num_mul(r,a,b) mpfr_mul((r)->num,(a)->num,(b)->num,GMP_RNDU) +#define num_mul_by_2(r,a) mpfr_mul_2exp((r)->num,(a)->num,1,GMP_RNDU) +#define num_div_by_2(r,a) mpfr_div_2exp((r)->num,(a)->num,1,GMP_RNDU) +#define num_neg(r,a) mpfr_neg((r)->num,(a)->num,GMP_RNDU) + +/* printing */ + +static inline void num_print(const num_t* a) +{ mpfr_out_str(stdout,10,6,a->num,GMP_RNDU); } + +static inline void num_snprint(char*s, size_t n, const num_t* a) +{ + char buf[100]; + mp_exp_t ex; + if (mpfr_inf_p(a->num)) snprintf(s,n,"+oo"); + else { + /* mpfr_get_str(buf,&ex,10,(sizeof(buf)>=n)?n:sizeof(buf)-1,a->num,GMP_RNDU); + if (ex) snprintf(s,n,"%c.%se%li",buf[0],buf+1,(long)ex); + else snprintf(s,n,"%c.%s",buf[0],buf+1); */ + snprintf(s,n,"%f", mpfr_get_d(a->num +#if (__GNU_MP_VERSION >= 4) && (__GNU_MP_VERSION_MINOR >= 1) + , GMP_RNDU +#endif + )); + } +} + + +#define OCT_NUM_CLOSED +#undef OCT_NUM_EXACT + + +/* serialization */ + +/* there is currently no _export / _import functions in MPFR + => we designed our own functions, not very portable and relying on + the internal encoding... + */ + +#define OCT_NUM_SERIALIZE + +static const int num_serialize_id = + 0x150000 + + sizeof(mpfr_prec_t) + 16*sizeof(mp_exp_t) + 256*sizeof(mp_limb_t); + +static inline size_t num_serialize(const num_t* a, void* c) +{ + size_t i,count=0,bytes; + swap_word((char*)c+count,&a->num[0]._mpfr_prec,sizeof(mpfr_prec_t)); + count += sizeof(mpfr_prec_t); + *((char*)c+count) = a->num[0]._mpfr_sign; + count++; + swap_word((char*)c+count,&a->num[0]._mpfr_exp,sizeof(mp_exp_t)); + count += sizeof(mp_exp_t); + bytes = (a->num[0]._mpfr_prec+8*sizeof(mp_limb_t)-1)/(8*sizeof(mp_limb_t)); + for (i=0;inum[0]._mpfr_d[i],sizeof(mp_limb_t)); + return count; +} + +static inline size_t num_deserialize(num_t* a, const void* c) +{ + size_t i,count=0,bytes; + mpfr_prec_t p; + mp_exp_t e; + char s; + swap_word(&p,(char*)c+count,sizeof(mpfr_prec_t)); + count += sizeof(mpfr_prec_t); + s = *((char*)c+count); + count++; + swap_word(&e,(char*)c+count,sizeof(mp_exp_t)); + count += sizeof(mp_exp_t); + bytes = (p+8*sizeof(mp_limb_t)-1)/(8*sizeof(mp_limb_t)); + mpfr_set_prec(a->num,p); + for (i=0;inum[0]._mpfr_d[i],(char*)c+count,sizeof(mp_limb_t)); + a->num[0]._mpfr_sign = s; + a->num[0]._mpfr_exp = e; + return count; +} + + +/* note: this does not give the exact size of serialized data, but a sound + overapproximation +*/ +static inline size_t num_serialize_size(num_t* a) +{ + return + sizeof(mpfr_prec_t)+1+sizeof(mp_exp_t)+ + (a->num[0]._mpfr_prec/8)+sizeof(mp_limb_t); +} + + +#endif + + + +#ifdef __cplusplus +} +#endif + +#ifndef OCT_NUM +#error "one OCT_NUM_ must be defined in oct_num.h" +#endif + + +#endif diff --git a/src/optimizer/oct/mineOct/oct_ocaml.c b/src/optimizer/oct/mineOct/oct_ocaml.c new file mode 100644 index 0000000..d210195 --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_ocaml.c @@ -0,0 +1,1693 @@ +/* oct_ocaml.c + OCaml binding for all library functions. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* define to 1 if you want octagons to be marshalized in minimized form */ +#define OCAML_SERIALIZE_COMPRESS 1 + +/* num/vnum -> num_t */ + +void ocaml_num_finalize (value o) +{ + num_clear(Num_val(o)); +} + +int +ocaml_num_compare (value a, value b) +{ + return num_cmp(Num_val(a),Num_val(b)); +} + +void ocaml_vnum_finalize (value o) +{ + num_clear_n(Vnum_val(o)->n,Vnum_val(o)->nb); + oct_mm_free(Vnum_val(o)->n); +} + +#ifdef OCT_NUM_SERIALIZE + +void ocaml_num_serialize (value a, unsigned long * w32, unsigned long * w64) +{ + num_t* n = Num_val(a); + unsigned size = num_serialize_size(n); + char* data = new_n(char,size); + num_serialize(n,data); + serialize_int_4(num_serialize_id); + serialize_int_4(size); + serialize_block_1(data,size); + *w32=size; + *w64=size; + oct_mm_free(data); +} + +unsigned long ocaml_num_deserialize (void * dst) +{ + int id = deserialize_sint_4(); + unsigned size; + char* data; + if (id!=num_serialize_id) + failwith ("ocaml_num_deserialize: incompatible serialized num"); + size = deserialize_uint_4(); + data = new_n(char,size); + deserialize_block_1(data,size); + num_init((num_t*)dst); + num_deserialize((num_t*)dst,data); + oct_mm_free(data); + return(size); +} + +void ocaml_vnum_serialize (value a, unsigned long * w32, unsigned long * w64) +{ + vnum_t* v = Vnum_val(a); + unsigned size,i; + char* data, *d; + for (i=0,size=0;inb;i++) + size += num_serialize_size(v->n+i); + + data = new_n(char,size); + for (i=0,d=data;inb;i++) + d += num_serialize(v->n+i,d); + + serialize_int_4(num_serialize_id); + serialize_int_4(size); + serialize_int_4(v->nb); + serialize_block_1(data,size); + *w32=4*2; + *w64=8*2; + oct_mm_free(data); +} + +unsigned long ocaml_vnum_deserialize (void * dst) +{ + int id = deserialize_sint_4(); + unsigned size, nb, i; + char* data, *d; + if (id!=num_serialize_id) + failwith ("ocaml_vnum_deserialize: incompatible serialized vnum"); + size = deserialize_uint_4(); + nb = deserialize_uint_4(); + data = new_n(char,size); + deserialize_block_1(data,size); + + ((vnum_t*)dst)-> nb = nb; + ((vnum_t*)dst)->n = new_n(num_t,nb); + num_init_n(((vnum_t*)dst)->n, nb); + for (i=0,d=data;in+i,d); + + oct_mm_free(data); + return(sizeof(vnum_t)); +} + +#endif + +static struct custom_operations ocaml_num_custom = { + "o_n@1", + ocaml_num_finalize, + ocaml_num_compare, + custom_hash_default, +#ifdef OCT_NUM_SERIALIZE + ocaml_num_serialize, + ocaml_num_deserialize +#else + custom_serialize_default, + custom_deserialize_default +#endif +}; + +static struct custom_operations ocaml_vnum_custom = { + "o_v@1", + ocaml_vnum_finalize , + custom_compare_default, + custom_hash_default, +#ifdef OCT_NUM_SERIALIZE + ocaml_vnum_serialize, + ocaml_vnum_deserialize +#else + custom_serialize_default, + custom_deserialize_default +#endif +}; + +CAMLprim value +ocaml_num_infty (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init_set_infty(Num_val(r)); + CAMLreturn(r); +} + +CAMLprim value +ocaml_num_int (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init_set_int(Num_val(r),Int_val(v)); + CAMLreturn(r); +} + +CAMLprim value +ocaml_num_frac (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init_set_frac(Num_val(r),Int_val(Field(v,0)),Int_val(Field(v,1))); + CAMLreturn(r); +} + +CAMLprim value +ocaml_num_float (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init_set_float(Num_val(r),Double_val(v)); + CAMLreturn(r); +} + +CAMLprim value +ocaml_vnum_int (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + size_t i, n = Wosize_val(v); + num_t* k = new_n(num_t,n); + r = alloc_custom(&ocaml_vnum_custom,sizeof(vnum_t),0,1); + Vnum_val(r)->nb = n; + Vnum_val(r)->n = k; + for (i=0;inb = n; + Vnum_val(r)->n = k; + for (i=0;inb = n; + Vnum_val(r)->n = k; + for (i=0;inb = n; + Vnum_val(r)->n = k; + for (i=0;inb = n; + Vnum_val(r)->n = k; + for (i=0;i=-(1<<30)) { + r = alloc_tuple(1); + Store_field (r,0,Val_int(i)); + } + else r = Val_int(0); + } + CAMLreturn(r); +} + +CAMLprim value +ocaml_frac_num (value v) +{ + long i,j; + CAMLparam1(v); + CAMLlocal1(r); + if (!num_fits_frac(Num_val(v))) r = Val_int(0); + else { + i = num_get_num(Num_val(v)); + j = num_get_den(Num_val(v)); + if (i<(1<<30) && i>=-(1<<30) && j<(1<<30)) { + r = alloc_tuple(2); + Store_field (r,0,Val_int(i)); + Store_field (r,1,Val_int(j)); + } + else r = Val_int(0); + } + CAMLreturn(r); +} + +CAMLprim value +ocaml_float_num (value v) +{ + double d; + CAMLparam1(v); + CAMLlocal1(r); + if (!num_fits_float(Num_val(v))) r = copy_double(1./0.); + else r = copy_double(num_get_float(Num_val(v))); + CAMLreturn(r); +} + + +CAMLprim value +ocaml_int_vnum (value v) +{ + size_t i,n; + vnum_t* k; + CAMLparam1(v); + CAMLlocal2(r,s); + k = Vnum_val(v); + r = alloc_tuple(k->nb); + for (i=0;inb;i++) { + if (!num_fits_int(k->n+i)) s = Val_int(0); + else { + long a = num_get_int(k->n+i); + if (a<(1<<30) && a>=-(1<<30)) { + s = alloc_tuple(1); + Store_field (s,0,Val_int(a)); + } + else s = Val_int(0); + } + Store_field (r,i,s); + } + CAMLreturn(r); +} + +CAMLprim value +ocaml_frac_vnum (value v) +{ + size_t i,n; + vnum_t* k; + CAMLparam1(v); + CAMLlocal2(r,s); + k = Vnum_val(v); + r = alloc_tuple(k->nb); + for (i=0;inb;i++) { + if (!num_fits_frac(k->n+i)) s = Val_int(0); + else { + long a = num_get_num(k->n+i); + long b = num_get_den(k->n+i); + if (a<(1<<30) && a>=-(1<<30) && b<(1<<30)) { + s = alloc_tuple(2); + Store_field (s,0,Val_int(a)); + Store_field (s,1,Val_int(b)); + } + else s = Val_int(0); + } + Store_field (r,i,s); + } + CAMLreturn(r); +} + +CAMLprim value +ocaml_float_vnum (value v) +{ + size_t i,n; + vnum_t* k; + CAMLparam1(v); + CAMLlocal2(r,s); + k = Vnum_val(v); + r = alloc(k->nb*Double_wosize,Double_array_tag); + for (i=0;inb;i++) { + if (!num_fits_float(k->n+i)) Store_double_field(r,i,1./0.); + else Store_double_field(r,i,num_get_float(k->n+i)); +} + CAMLreturn(r); +} + + +#if defined(OCT_HAS_GMP) && defined(OCT_HAS_OCAML_GMP) + +#include + +extern struct custom_operations _mlgmp_custom_z; +extern struct custom_operations _mlgmp_custom_q; + +CAMLprim value +ocaml_num_mpz (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init(Num_val(r)); + num_set_mpz(Num_val(r),*((mpz_t*)(Data_custom_val(v)))); + CAMLreturn(r); +} + +CAMLprim value +ocaml_num_mpq (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init(Num_val(r)); + num_set_mpq(Num_val(r),*((mpq_t*)(Data_custom_val(v)))); + CAMLreturn(r); +} + +CAMLprim value +ocaml_vnum_mpz (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + size_t i, n = Wosize_val(v); + num_t* k = new_n(num_t,n); + r = alloc_custom(&ocaml_vnum_custom,sizeof(vnum_t),0,1); + Vnum_val(r)->nb = n; + Vnum_val(r)->n = k; + num_init_n(k,n); + for (i=0;inb = n; + Vnum_val(r)->n = k; + num_init_n(k,n); + for (i=0;inb = n; + Vnum_val(r)->n = k; + num_init_n(k,n); + for (i=0;inb = n; + Vnum_val(r)->n = k; + num_init_n(k,n); + for (i=0;inb); + for (i=0;inb;i++) { + if (!num_infty(k->n+i)) s = Val_int(0); + else { + s = alloc_custom(&_mlgmp_custom_z,sizeof(mpz_t),0,1); + num_get_mpz (*((mpz_t*)Data_custom_val(s)), k->n+i); + } + Store_field (r,i,s); + } + CAMLreturn(r); +} + +CAMLprim value +ocaml_mpq_vnum (value v) +{ + size_t i,n; + vnum_t* k; + CAMLparam1(v); + CAMLlocal2(r,s); + k = Vnum_val(v); + r = alloc_tuple(k->nb); + for (i=0;inb;i++) { + if (!num_infty(k->n+i)) s = Val_int(0); + else { + s = alloc_custom(&_mlgmp_custom_q,sizeof(mpq_t),0,1); + num_get_mpq (*((mpq_t*)Data_custom_val(s)), k->n+i); + } + Store_field (r,i,s); + } + CAMLreturn(r); +} + +#else + +CAMLprim void +ocaml_num_mpz (value v) +{ + CAMLparam1(v); + failwith ("ocaml_num_mpz: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_num_mpq (value v) +{ + CAMLparam1(v); + failwith ("ocaml_num_mpq: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_vnum_mpz (value v) +{ + CAMLparam1(v); + failwith ("ocaml_vnum_mpz: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_vnum_mpq (value v) +{ + CAMLparam1(v); + failwith ("ocaml_vnum_mpq: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_vnum_mpz_opt (value v) +{ + CAMLparam1(v); + failwith ("ocaml_vnum_mpz_opt: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_vnum_mpq_opt (value v) +{ + CAMLparam1(v); + failwith ("ocaml_vnum_mpq_opt: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_mpz_num (value v) +{ + CAMLparam1(v); + failwith ("ocaml_mpz_num: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_mpq_num (value v) +{ + CAMLparam1(v); + failwith ("ocaml_mpq_num: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_mpz_vnum (value v) +{ + CAMLparam1(v); + failwith ("ocaml_mpz_vnum: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_mpq_vnum (value v) +{ + CAMLparam1(v); + failwith ("ocaml_mpq_vnum: GMP support not enabled"); + CAMLreturn0; +} + +#endif + +#if defined(OCT_HAS_MPFR) && defined(OCT_HAS_OCAML_GMP) + +#include + +extern struct custom_operations _mlgmp_custom_fr; + +CAMLprim value +ocaml_num_mpfr (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init(Num_val(r)); + num_set_mpfr(Num_val(r),*((mpfr_t*)(Data_custom_val(v)))); + CAMLreturn(r); +} + +CAMLprim value +ocaml_vnum_mpfr (value v) +{ + CAMLparam1(v); + CAMLlocal1(r); + size_t i, n = Wosize_val(v); + num_t* k = new_n(num_t,n); + r = alloc_custom(&ocaml_vnum_custom,sizeof(vnum_t),0,1); + Vnum_val(r)->nb = n; + Vnum_val(r)->n = k; + num_init_n(k,n); + for (i=0;inb = n; + Vnum_val(r)->n = k; + num_init_n(k,n); + for (i=0;inb); + for (i=0;inb;i++) { + if (!num_infty(k->n+i)) s = Val_int(0); + else { + s = alloc_custom(&_mlgmp_custom_fr,sizeof(mpfr_t),0,1); + num_get_mpfr (*((mpfr_t*)Data_custom_val(s)), k->n+i); + } + Store_field (r,i,s); + } + CAMLreturn(r); +} + +#else + +CAMLprim void +ocaml_num_mpfr (value v) +{ + CAMLparam1(v); + failwith ("ocaml_num_mpfr: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_vnum_mpfr (value v) +{ + CAMLparam1(v); + failwith ("ocaml_vnum_mpfr: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_vnum_mpfr_opt (value v) +{ + CAMLparam1(v); + failwith ("ocaml_vnum_mpfr_opt: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_mpfr_num (value v) +{ + CAMLparam1(v); + failwith ("ocaml_mpfr_num: GMP support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_mpfr_vnum (value v) +{ + CAMLparam1(v); + failwith ("ocaml_mpfr_vnum: GMP support not enabled"); + CAMLreturn0; +} + +#endif + + +CAMLprim value +ocaml_num_string(value m) +{ + char buf[4096]; + CAMLparam1(m); + num_snprint(buf,4095,Num_val(m)); + CAMLreturn(copy_string(buf)); +} + + +CAMLprim value +ocaml_vnum_string(value m, value i) +{ + char buf[4096]; + int j; + CAMLparam2(m,i); + j = Int_val(i); + if (j<0 || j>=Vnum_val(m)->nb) + failwith("ocaml_vnum_string: invalid index"); + num_snprint(buf,4095,Vnum_val(m)->n+j); + CAMLreturn(copy_string(buf)); +} + +CAMLprim value +ocaml_vnum_length(value m) +{ + CAMLparam1(m); + CAMLreturn(Val_int(Vnum_val(m)->nb)); +} + +/* octagons management */ + +void +ocaml_oct_finalize (value o) +{ + oct_free(Oct_val(o)); +} + +void +ocaml_oct_serialize (value a, unsigned long * w32, unsigned long * w64) +{ + size_t size; + char* data; +#if OCAML_SERIALIZE_COMPRESS + moct_t* m = oct_m_from_oct (Oct_val(a)); + data = oct_m_serialize(m,&size); + oct_m_free(m); +#else + data = oct_serialize(Oct_val(a),&size); +#endif + serialize_int_8(size); + serialize_block_1(data,size); + *w32=4; + *w64=8; + oct_mm_free(data); +} + +unsigned long +ocaml_oct_deserialize (void * dst) +{ + size_t size; + void* data; + size = deserialize_uint_8() & 0xFFFFFFFFUL; /* DM kludge */ + data = new_n(char, size); + deserialize_block_1(data,size); +#if OCAML_SERIALIZE_COMPRESS + { + moct_t* m = oct_m_deserialize(data); + *((oct_t**)dst) = oct_m_to_oct(m); + oct_m_free(m); + } +#else + *((oct_t**)dst) = oct_deserialize(data); +#endif + oct_mm_free(data); + return(sizeof(oct_t*)); +} + +static struct custom_operations ocaml_oct_custom = { + "o_o@1", + ocaml_oct_finalize , + custom_compare_default, + custom_hash_default, + ocaml_oct_serialize, + ocaml_oct_deserialize +}; + +inline +CAMLprim value +Val_oct (const oct_t* o) +{ + CAMLparam0(); + CAMLlocal1(v); + v = alloc_custom(&ocaml_oct_custom,sizeof(oct_t*),0,1); + Oct_val(v) = (oct_t*)o; + CAMLreturn(v); +} + + +/* functions wrappers */ + +CAMLprim value +ocaml_oct_empty (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_oct(oct_empty(Int_val(n)))); +} + +CAMLprim value +ocaml_oct_universe (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_oct(oct_universe(Int_val(n)))); +} + +CAMLprim value +ocaml_oct_dim (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_int(oct_dimension(Oct_val(n))));; +} + +CAMLprim value +ocaml_oct_nbconstraints (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_int(oct_nbconstraints(Oct_val(n)))); +} + +CAMLprim value +ocaml_oct_get_elem (value m, value i, value j) +{ + CAMLparam3(m,i,j); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init_set(Num_val(r),oct_elem(Oct_val(m),Int_val(i),Int_val(j))); + CAMLreturn(r); +} + +CAMLprim value +ocaml_oct_is_empty (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_bool(oct_is_empty(Oct_val(n)))); +} + +CAMLprim value +ocaml_oct_is_empty_lazy (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_int(oct_is_empty_lazy(Oct_val(n)))); +} + +CAMLprim value +ocaml_oct_is_universe (value n) +{ + CAMLparam1(n); + CAMLreturn(Val_bool(oct_is_universe(Oct_val(n)))); +} + +CAMLprim value +ocaml_oct_is_included_in (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_bool(oct_is_included_in(Oct_val(n),Oct_val(m)))); +} + +CAMLprim value +ocaml_oct_is_included_in_lazy (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_int(oct_is_included_in_lazy(Oct_val(n),Oct_val(m)))); +} + +CAMLprim value +ocaml_oct_is_equal (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_bool(oct_is_equal(Oct_val(n),Oct_val(m)))); +} + +CAMLprim value +ocaml_oct_is_equal_lazy (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_int(oct_is_equal_lazy(Oct_val(n),Oct_val(m)))); +} + +CAMLprim value +ocaml_oct_is_in (value n, value m) +{ + CAMLparam2(n,m); + if (Vnum_val(m)->nb!=Oct_val(n)->n) + failwith("ocaml_oct_is_in: incompatible dimensions"); + CAMLreturn(Val_bool(oct_is_in (Oct_val(n),Vnum_val(m)->n))); +} + +CAMLprim value +ocaml_oct_inter (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_intersection(Oct_val(n),Oct_val(m),false))); +} + +CAMLprim value +ocaml_oct_union (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_convex_hull(Oct_val(n),Oct_val(m),false))); +} + +CAMLprim value +ocaml_oct_widening (value n, value m, value t) +{ + oct_t* r; + CAMLparam3(n,m,t); + if (Is_block(t)) r = oct_widening_steps(Oct_val(n),Oct_val(m),false, + Vnum_val(Field(t,0))->nb, + Vnum_val(Field(t,0))->n); + else { + oct_widening_type w; + switch (Int_val(t)) { + case 0: w = OCT_WIDENING_FAST; break; + case 1: w = OCT_WIDENING_ZERO; break; + case 2: w = OCT_WIDENING_UNIT; break; + case 3: w = OCT_PRE_WIDENING; break; + default: w = OCT_WIDENING_FAST; + } + r = oct_widening(Oct_val(n),Oct_val(m),false,w); + } + CAMLreturn(Val_oct(r)); +} + +CAMLprim value +ocaml_oct_narrowing (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_narrowing(Oct_val(n),Oct_val(m),false))); +} + +CAMLprim value +ocaml_oct_forget (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_forget(Oct_val(n),Int_val(m),false))); +} + +CAMLprim value +ocaml_oct_add_bin_constraints (value n, value m) +{ + int i, nb; + oct_t* r; + oct_cons* c; + CAMLparam2(n,m); + CAMLlocal1(l); + nb = Wosize_val(m); + c = new_n(oct_cons,nb); + for (i=0;inb!=Oct_val(n)->n+1) + failwith("ocaml_oct_assign_variable: incompatible dimensions"); + CAMLreturn(Val_oct(oct_assign_variable(Oct_val(n),Int_val(m), + Vnum_val(o)->n,false))); +} + +CAMLprim value +ocaml_oct_substitute_variable (value n, value m, value o) +{ + CAMLparam3(n,m,o); + if (Vnum_val(o)->nb!=Oct_val(n)->n+1) + failwith("ocaml_oct_substitute_variable: incompatible dimensions"); + CAMLreturn(Val_oct(oct_substitute_variable(Oct_val(n),Int_val(m), + Vnum_val(o)->n,false))); +} + +CAMLprim value +ocaml_oct_add_constraint (value n, value o) +{ + CAMLparam2(n,o); + if (Vnum_val(o)->nb!=Oct_val(n)->n+1) + failwith("ocaml_oct_add_constraint: incompatible dimensions"); + CAMLreturn(Val_oct(oct_add_constraint (Oct_val(n),Vnum_val(o)->n,false))); +} + +CAMLprim value +ocaml_oct_interv_assign_variable (value n, value m, value o) +{ + CAMLparam3(n,m,o); + if (Vnum_val(o)->nb!=2*(Oct_val(n)->n+1)) + failwith("ocaml_oct_interv_assign_variable: incompatible dimensions"); + CAMLreturn(Val_oct(oct_interv_assign_variable(Oct_val(n),Int_val(m), + Vnum_val(o)->n,false))); +} + +CAMLprim value +ocaml_oct_interv_add_constraint (value n, value o) +{ + CAMLparam2(n,o); + if (Vnum_val(o)->nb!=2*(Oct_val(n)->n+1)) + failwith("ocaml_oct_interv_add_constraint: incompatible dimensions"); + CAMLreturn(Val_oct(oct_interv_add_constraint (Oct_val(n),Vnum_val(o)->n,false))); +} + +CAMLprim value +ocaml_oct_interv_substitute_variable (value n, value m, value o) +{ + CAMLparam3(n,m,o); + if (Vnum_val(o)->nb!=2*(Oct_val(n)->n+1)) + failwith("ocaml_oct_interv_substitute_variable: incompatible dimensions"); + CAMLreturn(Val_oct(oct_interv_substitute_variable(Oct_val(n),Int_val(m), + Vnum_val(o)->n,false))); +} + + +CAMLprim value +ocaml_oct_add_dimensions_and_embed (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_add_dimensions_and_embed(Oct_val(n),Int_val(m),false))); +} + +CAMLprim value +ocaml_oct_add_dimensions_and_project (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_add_dimensions_and_project(Oct_val(n),Int_val(m),false))); +} + +CAMLprim value +ocaml_oct_remove_dimensions (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_oct(oct_remove_dimensions(Oct_val(n),Int_val(m),false))); +} + +static dimsup_t* +get_dimsup (value tab) +{ + size_t i,n = Wosize_val(tab); + dimsup_t* d = new_n(dimsup_t,n); + for (i=0;in+Int_val(m)!=sz) + failwith("ocaml_oct_add_permute_dimensions_and_embed: invalid permutation dimension"); + tt = new_n(var_t,sz); + for (i=0;in+Int_val(m)!=sz) + failwith("ocaml_oct_add_permute_dimensions_and_project: invalid permutation dimension"); + tt = new_n(var_t,sz); + for (i=0;in!=sz) + failwith("ocaml_oct_permute_remove_dimensions: invalid permutation dimension"); + tt = new_n(var_t,sz); + for (i=0;inb/2,Vnum_val(m)->n))); +} + +CAMLprim value +ocaml_oct_get_box (value m) +{ + CAMLparam1(m); + CAMLlocal1(r); + r = alloc_custom(&ocaml_vnum_custom,sizeof(vnum_t),0,1); + Vnum_val(r)->nb = Oct_val(m)->n*2; + Vnum_val(r)->n = oct_get_box (Oct_val(m));; + CAMLreturn(r); +} + +CAMLprim value +ocaml_oct_set_bounds (value m, value i, value t) +{ + CAMLparam3(m,i,t); + CAMLreturn(Val_oct(oct_set_bounds(Oct_val(m),Int_val(i), + Num_val(Field(t,0)), Num_val(Field(t,1)), + false))); +} + +CAMLprim value +ocaml_oct_get_bounds (value m, value i) +{ + CAMLparam2(m,i); + CAMLlocal1(r); + r = alloc_tuple(2); + Store_field(r,0,alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1)); + Store_field(r,1,alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1)); + num_init(Num_val(Field(r,0))); num_init(Num_val(Field(r,1))); + oct_get_bounds(Oct_val(m),Int_val(i), + Num_val(Field(r,0)),Num_val(Field(r,1))); + CAMLreturn(r); +} + + +CAMLprim value +ocaml_oct_add_epsilon (value m, value n) +{ + CAMLparam2(m,n); + CAMLreturn(Val_oct(oct_add_epsilon(Oct_val(m),Num_val(n),false))); +} + +CAMLprim value +ocaml_oct_add_epsilon_max (value m, value n) +{ + CAMLparam2(m,n); + CAMLreturn(Val_oct(oct_add_epsilon_max(Oct_val(m),Num_val(n),false))); +} + +CAMLprim value +ocaml_oct_add_epsilon_bin (value m, value n, value o) +{ + CAMLparam3(m,n,o); + CAMLreturn(Val_oct(oct_add_epsilon_bin(Oct_val(m),Oct_val(n),Num_val(o), + false))); +} + + +CAMLprim value ocaml_oct_time_flow (value m, value min, value max, + value tab) +{ + CAMLparam4(m,min,max,tab); + if (Vnum_val(tab)->nb!=2*Oct_val(m)->n) + failwith("ocaml_oct_time_flow: incompatible dimensions"); + CAMLreturn(Val_oct(oct_time_flow(Oct_val(m),Num_val(min),Num_val(max), + Vnum_val(tab)->n,false))); +} + + +/* minimized octagons management */ + +void +ocaml_oct_m_finalize (value o) +{ + oct_m_free(Moct_val(o)); +} + +void +ocaml_oct_m_serialize (value a, unsigned long * w32, unsigned long * w64) +{ + size_t size; + char* data = oct_m_serialize(Moct_val(a),&size); + serialize_int_8(size); + serialize_block_1(data,size); + *w32=4; + *w64=8; + oct_mm_free(data); +} + +unsigned long +ocaml_oct_m_deserialize (void * dst) +{ + size_t size; + void* data; + size = deserialize_uint_8(); + data = new_n(char,size); + deserialize_block_1(data,size); + *((moct_t**)dst) = oct_m_deserialize(data); + oct_mm_free(data); + return(sizeof(moct_t*)); +} + +struct custom_operations ocaml_moct_custom = { + "o_m@1", + ocaml_oct_m_finalize , + custom_compare_default, + custom_hash_default, + ocaml_oct_m_serialize, + ocaml_oct_m_deserialize +}; + +inline +CAMLprim value +Val_moct (const moct_t* o) +{ + CAMLparam0(); + CAMLlocal1(v); + v = alloc_custom(&ocaml_moct_custom,sizeof(moct_t*),0,1); + Moct_val(v) = (moct_t*)o; + CAMLreturn(v); +} + +/* functions */ + + +CAMLprim value +ocaml_oct_m_from_oct (value m) +{ + CAMLparam1(m); + CAMLreturn(Val_moct(oct_m_from_oct(Oct_val(m)))); +} + +CAMLprim value +ocaml_oct_m_to_oct (value m) +{ + CAMLparam1(m); + CAMLreturn(Val_oct(oct_m_to_oct(Moct_val(m)))); +} + +CAMLprim value +ocaml_oct_m_print (value m) +{ + CAMLparam1(m); + fflush(stdout); + oct_m_print(Moct_val(m)); + fflush(stdout); + CAMLreturn(Val_unit); +} + +CAMLprim value +ocaml_oct_m_dim (value m) +{ + CAMLparam1(m); + CAMLreturn(Val_int(oct_m_dimension(Moct_val(m)))); +} + +CAMLprim value +ocaml_oct_m_is_empty (value m) +{ + CAMLparam1(m); + CAMLreturn(Val_bool(oct_m_is_empty(Moct_val(m)))); +} + +CAMLprim value +ocaml_oct_m_is_equal (value n, value m) +{ + CAMLparam2(n,m); + CAMLreturn(Val_bool(oct_m_is_equal(Moct_val(n),Moct_val(m)))); +} + +CAMLprim value +ocaml_oct_m_get_elem (value m, value i, value j) +{ + CAMLparam3(m,i,j); + CAMLlocal1(r); + r = alloc_custom(&ocaml_num_custom,sizeof(num_t),0,1); + num_init_set(Num_val(r),oct_m_elem(Moct_val(m),Int_val(i),Int_val(j))); + CAMLreturn(r); +} + + +/* used pretty-printing, not intended for the user, only for octprinter */ + +CAMLprim value +ocaml_oct_elem_to_string (value m, value i, value j) +{ + char buf[4096]; + int ii,jj; + num_t* c; + CAMLparam3(m,i,j); + CAMLlocal1(r); + ii = Int_val(i); + jj = Int_val(j); + c = oct_elem(Oct_val(m),ii,jj); + if (num_infty(c)) r = Val_int(0); + else { + r = alloc_tuple(1); + num_snprint (buf,4095,c); + Store_field (r,0,copy_string (buf)); + } + CAMLreturn(r); +} + +CAMLprim value +ocaml_oct_elem_to_string2 (value m, value i, value j, value s) +{ + char buf[4096*3+20]; + int ii,jj; + num_t *cp, *cm; + num_t c; + CAMLparam4(m,i,j,s); + CAMLlocal1(r); + ii = Int_val(i); + jj = Int_val(j); + cp = oct_elem(Oct_val(m),ii,jj); + cm = oct_elem(Oct_val(m),jj,ii); + num_init(&c); + if (num_infty(cp) && num_infty(cm)) r = Val_int(0); + else if (num_infty(cm)) { + strncpy(buf,String_val(s),4096); + strcat(buf," <= "); + if ((ii^1)==jj) num_div_by_2(&c,cp); else num_set(&c,cp); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + else if (num_infty(cp)) { + strncpy(buf,String_val(s),4096); + strcat(buf," >= "); + num_neg(&c,cm); + if ((ii^1)==jj) num_div_by_2(&c,&c); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + else { + num_neg(&c,cm); + if (!num_cmp(&c,cp)) { + strncpy(buf,String_val(s),4096); + strcat(buf," = "); + if ((ii^1)==jj) num_div_by_2(&c,cp); else num_set(&c,cp); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + else { + num_neg(&c,cm); + if ((ii^1)==jj) num_div_by_2(&c,&c); + num_snprint (buf,4096,&c); + strcat(buf," <= "); + strncat(buf,String_val(s),4096); + strcat(buf," <= "); + if ((ii^1)==jj) num_div_by_2(&c,cp); else num_set(&c,cp); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + } + num_clear (&c); + CAMLreturn(r); +} + +CAMLprim value +ocaml_oct_get_state (value m) +{ + CAMLparam1(m); + CAMLreturn(Val_int(Oct_val(m)->state)); +} + +CAMLprim value +ocaml_oct_melem_to_string (value m, value i, value j) +{ + char buf[4096]; + int ii,jj; + num_t* c; + CAMLparam3(m,i,j); + CAMLlocal1(r); + ii = Int_val(i); + jj = Int_val(j); + c = oct_m_elem(Moct_val(m),ii,jj); + if (!c || num_infty(c)) r = Val_int(0); + else { + r = alloc_tuple(1); + num_snprint (buf,4095,c); + Store_field (r,0,copy_string (buf)); + } + CAMLreturn(r); +} + + +CAMLprim value +ocaml_oct_melem_to_string2 (value m, value i, value j, value s) +{ + char buf[4096*3+20]; + int ii,jj; + num_t *cp,*cm; + num_t c; + CAMLparam4(m,i,j,s); + CAMLlocal1(r); + ii = Int_val(i); + jj = Int_val(j); + cp = oct_m_elem(Moct_val(m),ii,jj); + cm = oct_m_elem(Moct_val(m),jj,ii); + num_init(&c); + if ((!cp || num_infty(cp)) && (!cm || num_infty(cm))) r = Val_int(0); + else if (!cm || num_infty(cm)) { + strncpy(buf,String_val(s),4096); + strcat(buf," <= "); + if ((ii^1)==jj) num_div_by_2(&c,cp); else num_set(&c,cp); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + else if (!cp || num_infty(cp)) { + strncpy(buf,String_val(s),4096); + strcat(buf," >= "); + num_neg(&c,cm); + if ((ii^1)==jj) num_div_by_2(&c,&c); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + else { + num_neg(&c,cm); + if (!num_cmp(&c,cp)) { + strncpy(buf,String_val(s),4096); + strcat(buf," = "); + if ((ii^1)==jj) num_div_by_2(&c,cp); else num_set(&c,cp); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + else { + num_neg(&c,cm); + if ((ii^1)==jj) num_div_by_2(&c,&c); + num_snprint (buf,4096,&c); + strcat(buf," <= "); + strncat(buf,String_val(s),4096); + strcat(buf," <= "); + if ((ii^1)==jj) num_div_by_2(&c,cp); else num_set(&c,cp); + num_snprint (buf+strlen(buf),4096,&c); + r = alloc_tuple(1); + Store_field (r,0,copy_string (buf)); + } + } + num_clear (&c); + CAMLreturn(r); +} + +CAMLprim value +ocaml_oct_memprint (value v) +{ + CAMLparam1(v); + oct_mmalloc_print(oct_mmalloc_get_current()); + CAMLreturn(Val_unit); +} + + +CAMLprim value +ocaml_oct_timeprint (value v) +{ + CAMLparam1(v); + oct_timing_print_all (); + CAMLreturn(Val_unit); +} + +/* New Polka interface */ + +#ifdef OCT_HAS_OCAML_NEW_POLKA + +#include + +CAMLprim value +ocaml_oct_from_poly (value v) +{ + CAMLparam1(v); + poly_t* p; + camlidl_polka_poly_ml2c(v,&p); + CAMLreturn(Val_oct(oct_from_poly(p))); +} + +CAMLprim value +ocaml_oct_to_poly (value v) +{ + CAMLparam1(v); + poly_t* p = oct_to_poly(Oct_val(v)); + CAMLreturn(camlidl_polka_poly_c2ml(&p)); +} + +#else + +CAMLprim void +ocaml_oct_from_poly (value v) +{ + CAMLparam1(v); + failwith ("ocaml_oct_from_poly: New Polka library support not enabled"); + CAMLreturn0; +} + +CAMLprim void +ocaml_oct_to_poly (value v) +{ + CAMLparam1(v); + failwith ("ocaml_oct_to_poly: New Polka library support not enabled"); + CAMLreturn0; +} + +#endif + + + +CAMLprim value +ocaml_oct_init (value dummy) +{ + CAMLparam1(dummy); +#ifdef OCT_NUM_SERIALIZE + register_custom_operations(&ocaml_num_custom); + register_custom_operations(&ocaml_vnum_custom); + register_custom_operations(&ocaml_oct_custom); + register_custom_operations(&ocaml_moct_custom); +#endif + CAMLreturn(oct_init() ? Val_int(1) : Val_int(0)); +} diff --git a/src/optimizer/oct/mineOct/oct_ocaml.h b/src/optimizer/oct/mineOct/oct_ocaml.h new file mode 100644 index 0000000..2ce4a44 --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_ocaml.h @@ -0,0 +1,56 @@ +/* oct_ocaml.h + Include this to access to OCaml wrappers for the C library data-structures. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ + +#ifndef OCT_OCAMLH__ +#define OCT_OCAMLH__ + +#include +#include +#include +#include + +#include +#include + +#ifdef __cplusplus +extern "C" { +#endif + +/* value <-> num_t conversion */ + +typedef struct /* array of num_t */ +{ + size_t nb; + num_t* n; +} vnum_t; + +#define Num_val(v) ((num_t*)Data_custom_val(v)) /* v: Oct.num */ +#define Vnum_val(v) ((vnum_t*)Data_custom_val(v)) /* v: Oct.vnum */ + +/* value <-> oct_t conversion */ +#define Oct_val(v) (*((oct_t**)Data_custom_val(v))) /* v: Oct.oct */ +value Val_oct (const oct_t* o); /* Return a *new* value containing o */ + +/* value <-> moct_t conversion */ +#define Moct_val(v) (*((moct_t**)Data_custom_val(v))) /* v: Oct.moct */ +value Val_moct (const moct_t* o); /* Return a *new* value containing o */ + +/* Use Int_val / Val_int to convert objects of type + tbool_t / Oct.tbool, + oct_widening_type / Oct.wident +*/ + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/src/optimizer/oct/mineOct/oct_private.h b/src/optimizer/oct/mineOct/oct_private.h new file mode 100644 index 0000000..b48c30f --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_private.h @@ -0,0 +1,187 @@ +/* oct_private.h + Include this in order to access to low-level octagon data structures. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ +#ifndef OCT_PRIVATE_H__ +#define OCT_PRIVATE_H__ + +#include + +#ifdef __cplusplus +extern "C" { +#endif + + +/* Shortcuts */ +/* --------- */ + +#define oct_alloc OCT_PROTO(alloc) +#define oct_full_copy OCT_PROTO(full_copy) +#define oct_close OCT_PROTO(close) +#define oct_is_closed OCT_PROTO(is_closed) +#define oct_close_lazy OCT_PROTO(close_lazy) +#define oct_check_closed OCT_PROTO(check_closed) +#define oct_m_elem OCT_PROTO(m_elem) +#define oct_close_incremental OCT_PROTO(close_incremental) + + +/************/ +/* Octagons */ +/************/ + +/* + Unlike the presentation of the article "The Octagonal Abstract Domain", + there is no redundancy in the internal representation of the invariants. + This is achevied by storing m[i][j] only if i>=j or i=j^1. + There is no loss of information because, by coherence, m[j^1][i^1]=m[i][j]. + In memory, the matrix has approximately the form of a triangle: + + j -> 0 1 2 3 4 5 + ___ + 0 |_|_| + 1 |_|_|___ + i -> 2 |_|_|_|_| + 3 |_|_|_|_|___ + 4 |_|_|_|_|_|_| + 5 |_|_|_|_|_|_| + + In the following we will use the term 'matrix' even if the representation + no longer has a matrix form. + The elements are stored in a flat array with m[i][j] beeing stored in + c[j+((i+1)*(i+1))/2]. + + There is no longer an emptyness test as emptyness is tested during the + closure. + + Memory managment is a little complex in order to avoid unnecessary copy, + closure or emptyness checking. + All operators come in 2 forms: a copy form that protects all arguments, + and a in-place form that destroys the arguments and is more efficient. + There is also reference counting so that copy versions of operators can + return the one of the argument without having to copy it (union when one + argument is empty, for example). + This results in a lazy copy-on-write policy saying that we must perform + an actual copy only when modifing in-place a matrix that have a + reference count > 1. + The last mechanism is remembering of closure form. When the argument of + an operator must be closed, but must stay accessible in its original form + (either we use the copy form of the operator, or the argument has a + reference count > 1); we keep the closed form in memory and add a pointer + from the original unchanged argument to its closed form we just computed. + If the arguement is used again with an operator requiring the normal form, + the stored form is reused and no extra closure algorithm is performed. + (this mechanism can be turned off manually if we are short of memory, + this can result in time inefficiency). + +*/ + +/* nb of elements in a matrix with n variables */ +#define matsize(n) (2*(size_t)(n)*((size_t)(n)+1)) + +/* xj - xi <= m->c[matpos(i,j)], if j/2 <= i/2 */ +#define matpos(i,j) ((size_t)(j)+(((size_t)(i)+1)*((size_t)(i)+1))/2) + +/* xj - xi <= m->c[matpos2(i,j)] for all i,j */ +#define matpos2(i,j) ((j)>(i)?matpos(((j)^1),((i)^1)):matpos(i,j)) + +/* state of a matrix representing an octagon */ +typedef enum { + OCT_EMPTY = 0, /* empty domain */ + OCT_NORMAL = 1, + OCT_CLOSED = 2 +} oct_state; + + +/* octagon data structure */ +struct oct_tt { + var_t n; /* number of variables, aka dimension */ + + int ref; /* reference counting */ + + oct_state state; /* is it empty, closed, etc. ? */ + struct oct_tt* closed; /* pointer to the closed version, or NULL */ + + num_t* c; /* the matrix, contains matsize(n) elements */ +}; + +/* private because not really useful for user */ +oct_t* OCT_PROTO(alloc) (var_t n); /* c allocated but not initialized */ +oct_t* OCT_PROTO(full_copy) (oct_t* m); /* new copy with ref=1 */ + +/* strong closure */ +oct_t* OCT_PROTO(close) (oct_t* m, bool destructive, bool cache); +bool OCT_PROTO(is_closed) (oct_t* m); +oct_t* OCT_PROTO(close_lazy) (oct_t* m, bool destructive); + +bool OCT_PROTO(check_closed) (const oct_t* m, bool quiet); /* for debugging purpose */ +void OCT_PROTO(close_incremental) (oct_t* m, var_t v); + + +/* low-level access to an element + get the element m[i][j] */ +static inline +num_t* +oct_elem (oct_t* m, + var_t i, + var_t j) +{ + OCT_ASSERT(m->c,"matrix not allocated in oct_elem"); + OCT_ASSERT(i<2*m->n && j<2*m->n,"invalid index in oct_elem"); + return m->c+matpos2(i,j); +} + + +/* Octagon in hollow form, + cannot be modified in-place ! +*/ + +struct moct_tt { + var_t n; /* number of variables */ + + size_t* bol; /* begin-of-line indices, array of n*2+1 indices */ + var_t* col; /* column indices, array of bol[n*2] elements */ + num_t* data; /* constraint array of bol[n*2] elements */ + /* data[i] contains the original matrix element at position + col[i], + line l, such that bol[l] <= i < bol[l+1] + */ + /* all fields are NULL if the octagon is empty */ +}; + + +/* no direct access, O(log n) time cost */ +num_t* OCT_PROTO(m_elem) (moct_t* a, var_t i, var_t j); + + +/**********/ +/* Memory */ +/**********/ + +/* a memory monitor */ +struct mmalloc_tt +{ + int id; /* incremented after a reset */ + + int nb_alloc; /* nb of calls to malloc */ + int nb_realloc; /* nb of calls to realloc */ + int nb_free; /* nb of calls to free */ + + size_t rem; /* memory consumption */ + size_t max; /* max memory consumption */ + size_t tot; /* total allocated */ + +}; + + + + +#ifdef __cplusplus +} +#endif + +#endif diff --git a/src/optimizer/oct/mineOct/oct_sem.c b/src/optimizer/oct/mineOct/oct_sem.c new file mode 100644 index 0000000..9f09fbd --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_sem.c @@ -0,0 +1,4009 @@ +/* oct_sem.c + Semantics abstract functions. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ + +#include +#include + +/* define to use simplified closure / incremental closure */ +#undef BHMZ05 + +/*******************/ +/* Initialization */ +/*******************/ + + +#if defined(__FreeBSD__) || defined(sun) + +#include +static int init_fpu() +{ fpsetround(FP_RP); /*fpsetmask(fpgetmask()|FP_X_INV); */ return 1; } + +#elif defined(linux) + +#include +static int init_fpu() +{ return !fesetround(FE_UPWARD) /*&& feenableexcept(FE_INVALID)!=-1*/; } + +#elif defined(__ppc__) + +static int init_fpu() { + asm volatile ("mtfsfi 7,2"); + /* asm volatile ("mtfsb1 24"); */ + return 1; +} + +#else + +static int init_fpu() { fprintf(stderr,"Octagon Library Warning: don't know how top set the FPU rounding mode.\n"); return 0; } + +#endif + + + +int +OCT_PROTO(init) () +{ +#if defined(OCT_NUM_FLOAT) || defined(OCT_NUM_LONGDOUBLE) + return init_fpu(); +#else + return 1; +#endif +} + + +/********************************/ +/* Octagon Creation/Destruction */ +/********************************/ + +/* empty domain, c is not allocated */ +inline +oct_t* +OCT_PROTO(empty) (const var_t n) +{ + oct_t* m; + OCT_ENTER("oct_empty",3); + m = new_t(oct_t); + m->n = n; + m->ref = 1; + m->state = OCT_EMPTY; + m->closed = (oct_t*)NULL; + m->c = (num_t*)NULL; + OCT_EXIT("oct_empty",3); + return m; +} + +/* constraints not initialized, it returns an INVALID matrix */ +inline +oct_t* +OCT_PROTO(alloc) (const var_t n) +{ + size_t nn = matsize(n); + oct_t* m; + m = oct_empty(n); + m->c = new_n(num_t,nn); + num_init_n(m->c,nn); + m->state = OCT_NORMAL; + m->closed = (oct_t*)NULL; + return m; +} + +/* all constraints are set to +infty, (except m[i][i]=0) */ +inline +oct_t* +OCT_PROTO(universe) (const var_t n) +{ + oct_t* m; + size_t i, nn = matsize(n); + OCT_ENTER("oct_universe",4); + m = oct_alloc(n); + for (i=0;ic+i); + for (i=0;i<2*n;i++) num_set_int(m->c+matpos(i,i),0); + m->state = OCT_CLOSED; + OCT_EXIT("oct_universe",4); + return m; +} + +/* full copy, except new ref is 1 (oct_copy is preferred for lazy copy) */ +inline +oct_t* +OCT_PROTO(full_copy) (oct_t* mm) +{ + oct_t* m; + OCT_ENTER("oct_full_copy",5); + m = oct_empty(mm->n); + m->state = mm->state; + m->closed = mm->closed; + if (m->closed) m->closed->ref++; + if (mm->c) { + const size_t nn = matsize(mm->n); + m->c = new_n(num_t,nn); + num_init_set_n(m->c,mm->c,nn); + } + else m->c = (num_t*)NULL; + OCT_EXIT("oct_full_copy",5); + return m; +} + +/* just add one to ref count */ +inline +oct_t* +OCT_PROTO(copy) (oct_t* m) +{ + m->ref++; + return m; +} + +/* really free if ref count reaches 0 */ +inline +void +OCT_PROTO(free) (oct_t* m) +{ + m->ref--; + if (!m->ref) { + if (m->closed) { + m->closed->ref--; + if (!m->closed->ref) { /* free cached closed version */ + if (m->closed->c) + { num_clear_n(m->closed->c,matsize(m->n)); oct_mm_free(m->closed->c); } + oct_mm_free(m->closed); + } + } + if (m->c) { num_clear_n(m->c,matsize(m->n)); oct_mm_free(m->c); } + oct_mm_free(m); + } +} + + +/*******************/ +/* Query Functions */ +/*******************/ + +/* number of variables */ +inline +var_t +OCT_PROTO(dimension) (oct_t* m) +{ + return m->n; +} + +size_t +OCT_PROTO(nbconstraints) (oct_t* m) +{ + const size_t nn = matsize(m->n); + size_t i; + size_t n = 0; + num_t* c = m->c; + OCT_ENTER("oct_nbconstraints",6); + if (m->state==OCT_EMPTY) return 0; + for (i=0;in; /* remove the 2n constraints of the form x_i-x_i<=0 */ +} + + +/******************/ +/* Strong Closure */ +/******************/ + + +/* + strong closure algorithm. + returns either a CLOSED matrix, or an EMPTY matrix + if destructive!=0, the argument is freed and may not be used anymore + the closure is cached in m->cached if cache=1 + O(n^3) time complexity + O(n) space complexity (no temporary matrix created!) +*/ + + +#ifndef BHMZ05 /* original version */ + +oct_t* +OCT_PROTO(close) (oct_t* m, + bool destructive, + bool cache) +{ + var_t i,j,k; + oct_t* mm; + const var_t n2 = m->n*2; + num_t *buf1, *buf2; + num_t kk1,kk2,ik1,ik2,ij1,ij2,ij3,ij4; + + OCT_ENTER("oct_close",48); + /* already closed or empty, we have nothing to do */ + if (m->state==OCT_CLOSED || m->state==OCT_EMPTY) { + if (destructive) mm=m; else mm = oct_copy(m); + goto end2; + } + + /* closed form is cached, we have nothing to do */ + if (m->closed) { + mm = oct_copy(m->closed); + if (destructive) oct_free(m); + goto end2; + } + + if (destructive) + if (m->ref==1) mm = m; + else { mm = oct_full_copy(m); m->ref--; } + else mm = oct_full_copy(m); + if (cache && m!=mm) m->closed = oct_copy(mm); + + OCT_ENTER("oct_really_close",49); + /* these buffers avoid a temporary matrix to be created + they can also speed up the computation if they stay in the CPU cache! + */ + buf1 = new_n(num_t,n2); buf2 = new_n(num_t,n2); + num_init_n(buf1,n2); num_init_n(buf2,n2); + num_init(&kk1); num_init(&kk2); + num_init(&ik1); num_init(&ik2); + num_init(&ij1); num_init(&ij2); num_init(&ij3); num_init(&ij4); + + for (k=0;kc; /* xj-xi */ + num_set(&kk1,mm->c+matpos(k+1,k)); /* xk+xk */ + num_set(&kk2,mm->c+matpos(k,k+1)); /* -xk-xk */ + + /* (TO BE LINEARIZED TO AVOID MULTIPLICATION) */ + for (i=0;i<=k;i+=2) { + num_set(buf1+i ,mm->c+matpos(k+1,i+1)); /* -xi+xk */ + num_set(buf2+i ,mm->c+matpos(k ,i+1)); /* -xi-xk */ + num_set(buf1+i+1,mm->c+matpos(k+1,i )); /* xi+xk */ + num_set(buf2+i+1,mm->c+matpos(k ,i )); /* xi-xk */ + } + for (;ic+matpos(i ,k )); /* xk-xi */ + num_set(buf2+i ,mm->c+matpos(i ,k+1)); /* -xk-xi */ + num_set(buf1+i+1,mm->c+matpos(i+1,k )); /* xk+xi */ + num_set(buf2+i+1,mm->c+matpos(i+1,k+1)); /* -xk+xi */ + } + + for (i=0;ic; /* xj-xi */ + /* (TO BE LINEARIZED TO AVOID MULTIPLICATION) */ + + for (i=0;ic+matpos(i+1,i)); /* ( xi+xi)/2 */ + num_div_by_2(buf1+i+1,mm->c+matpos(i,i+1)); /* (-xi-xi)/2 */ + } + + for (i=0;ic+matpos(i,i))<0) { + mm->state = OCT_EMPTY; + num_clear_n(mm->c,matsize(mm->n)); + oct_mm_free(mm->c); mm->c = (num_t*)NULL; + goto end; + } + } + + mm->state = OCT_CLOSED; + end: + num_clear(&kk1); num_clear(&kk2); + num_clear(&ik1); num_clear(&ik2); + num_clear(&ij1); num_clear(&ij2); num_clear(&ij3); num_clear(&ij4); + num_clear_n(buf1,n2); num_clear_n(buf2,n2); + oct_mm_free(buf1); oct_mm_free(buf2); + OCT_EXIT("oct_really_close",49); + end2: + OCT_EXIT("oct_close",48); + return mm; +} + +#else /* optimized algorithm from BHMZ05 (constant factor improvement) */ + +oct_t* +OCT_PROTO(close) (oct_t* m, + bool destructive, + bool cache) +{ + var_t i,j,k; + oct_t* mm; + const var_t n2 = m->n*2; + num_t *c,ik,ik2,ij; + + OCT_ENTER("oct_close",48); + /* already closed or empty, we have nothing to do */ + if (m->state==OCT_CLOSED || m->state==OCT_EMPTY) { + if (destructive) mm=m; else mm = oct_copy(m); + goto end2; + } + + /* closed form is cached, we have nothing to do */ + if (m->closed) { + mm = oct_copy(m->closed); + if (destructive) oct_free(m); + goto end2; + } + + if (destructive) + if (m->ref==1) mm = m; + else { mm = oct_full_copy(m); m->ref--; } + else mm = oct_full_copy(m); + if (cache && m!=mm) m->closed = oct_copy(mm); + + OCT_ENTER("oct_really_close_BHMZ05",49); + + num_init(&ik); num_init(&ik2); num_init(&ij); + + /* Floyd-Warshall */ + for (k=0;kc; + for (i=0;ic+matpos2(i,k)); + num_set(&ik2,mm->c+matpos2(i,k2)); + for (j=0;j<=br;j++,c++) { + num_add(&ij,&ik,mm->c+matpos(k,j)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,mm->c+matpos(k2,j)); /* ik2+k2j */ + num_min(c,c,&ij); + } + for (;j<=i2;j++,c++) { + num_add(&ij,&ik,mm->c+matpos(j^1,k2)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,mm->c+matpos(j^1,k)); /* ik2+k2j */ + num_min(c,c,&ij); + } + } + + } + + /* lone S step */ + c = mm->c; + for (i=0;ic+matpos(i,i^1)); + for (j=0;j<=i2;j++,c++) { + num_div_by_2(&ik,mm->c+matpos(j^1,j)); /* (ii2+j2j)/2 */ + num_add(&ik,&ik,&ij); + num_min(c,c,&ik); + } + } + + /* emptyness checking */ + for (i=0;ic+matpos(i,i); + if (num_cmp_zero(c)<0) { + mm->state = OCT_EMPTY; + num_clear_n(mm->c,matsize(mm->n)); + oct_mm_free(mm->c); mm->c = (num_t*)NULL; + goto end; + } + else num_set_int(c,0); + } + + mm->state = OCT_CLOSED; + end: + num_clear(&ik); num_clear(&ik2); num_clear(&ij); + OCT_EXIT("oct_really_close_BHMZ05",49); + end2: + OCT_EXIT("oct_close",48); + return mm; +} + +#endif + + +/* returns the closure of m if it is available without computation, + and m elsewhere + null cost +*/ +inline +oct_t* +OCT_PROTO(close_lazy) (oct_t* m, + bool destructive) +{ + oct_t* r; + OCT_ENTER("oct_close_lazy",8); + if (m->closed) { + r = oct_copy(m->closed); + if (destructive) oct_free(m); + } + else if (destructive) r = m; + else r = oct_copy(m); + OCT_EXIT("oct_close_lazy",8); + return r; +} + +inline +bool +OCT_PROTO(is_closed) (oct_t* m) +{ + return (m->state==OCT_CLOSED || m->state==OCT_EMPTY)?true:false; +} + + +/* + incremental version of the closure + the argument matrix must be almost closed, ie, it must be a closed + matrix except the constraints involving variable v + always destructive, modify its argument in-place + O(n^2) time complexity +*/ + +#ifndef BHMZ05 /* original version */ + +inline +void +OCT_PROTO(close_incremental) (oct_t* m, + var_t v) +{ + var_t i,j,k; + const var_t n2 = m->n*2; + const var_t v2 = v*2; + num_t *buf1, *buf2; + num_t kk1,kk2,ik1,ik2,ij1,ij2,ij3,ij4; + + OCT_ENTER("oct_close_incremental",9); + OCT_ASSERT(vn,"variable index greater than the number of variables in oct_close_incremental"); + if (m->state==OCT_EMPTY) goto end2; + + buf1 = new_n(num_t,n2); buf2 = new_n(num_t,n2); + num_init_n(buf1,n2); num_init_n(buf2,n2); + num_init(&kk1); num_init(&kk2); + num_init(&ik1); num_init(&ik2); + num_init(&ij1); num_init(&ij2); num_init(&ij3); num_init(&ij4); + + /* try to reduce xv coefficients using xk coefficients */ + OCT_ENTER("oct_close_incremental_1",10); + { + num_t* pvpv = m->c+matpos(v2+1,v2); /* xv+xv */ + num_t* mvmv = m->c+matpos(v2,v2+1); /* -xv-xv */ + + for (k=0;kc+matpos (k+1,k); /* xk+xk */ + num_t* mkmk = m->c+matpos (k,k+1); /* -xk-xk */ + num_t* pkpv = m->c+matpos2(v2+1,k ); + num_t* mkpv = m->c+matpos2(v2+1,k+1); + num_t* pkmv = m->c+matpos2(v2 ,k ); + num_t* mkmv = m->c+matpos2(v2 ,k+1); + for (i=0;ic + matpos2(v2 ,i); /* xi-xv */ + num_t* ipv = m->c + matpos2(v2+1,i); /* xi+xv */ + num_t* imk = m->c + matpos2(k ,i); /* xi-xk */ + num_t* ipk = m->c + matpos2(k+1 ,i); /* xi+xk */ + num_add(&ij1,imk,pkpv); + num_add(&ij2,ipk,mkpv); + num_add(&ij3,imk,pkpk); num_add(&ij3,&ij3,mkpv); + num_add(&ij4,ipk,mkmk); num_add(&ij4,&ij4,pkpv); + num_min(&ij1,&ij1,&ij2); num_min(&ij3,&ij3,&ij4); + num_min(&ij1,&ij1,&ij3); + num_min(ipv,ipv,&ij1); + + num_add(&ij1,imk,pkmv); + num_add(&ij2,ipk,mkmv); + num_add(&ij3,imk,pkpk); num_add(&ij3,&ij3,mkmv); + num_add(&ij4,ipk,mkmk); num_add(&ij4,&ij4,pkmv); + num_min(&ij1,&ij1,&ij2); num_min(&ij3,&ij3,&ij4); + num_min(&ij1,&ij1,&ij3); + num_min(imv,imv,&ij1); + } + + /* S step */ + for (i=0;ic + matpos(v2 ,i); /* xi-xv */ + num_t* ipv = m->c + matpos(v2+1,i); /* xi+xv */ + num_t* ii = m->c + matpos(i^1,i); /* xi+xi */ + num_add(&ij1,ii,pvpv); num_div_by_2(&ij1,&ij1); num_min(ipv,ipv,&ij1); + num_add(&ij2,ii,mvmv); num_div_by_2(&ij2,&ij2); num_min(imv,imv,&ij2); + } + for (;ic + matpos(i, v2+1); /* -xi-xv */ + num_t* ipv = m->c + matpos(i, v2 ); /* -xi+xv */ + num_t* ii = m->c + matpos(i,i^1); /* -xi-xi */ + num_add(&ij1,ii,pvpv); num_div_by_2(&ij1,&ij1); num_min(ipv,ipv,&ij1); + num_add(&ij2,ii,mvmv); num_div_by_2(&ij2,&ij2); num_min(imv,imv,&ij2); + } + + /* emptyness checking */ + if (num_cmp_zero(m->c+matpos(v,v))<0) { + m->state=OCT_EMPTY; + num_clear_n(m->c,matsize(m->n)); + oct_mm_free(m->c); m->c = (num_t*)NULL; + OCT_EXIT("oct_close_incremental_1",10); + goto end; + } + } + } + OCT_EXIT("oct_close_incremental_1",10); + + /* try to reduce xk coefficients using xv coefficients */ + OCT_ENTER("oct_close_incremental_2",11); + { + num_t* d = m->c; /* xj-xi */ + k = v2; + + /* Ck step */ + + num_set(&kk1,m->c+matpos(k+1,k)); /* xk+xk */ + num_set(&kk2,m->c+matpos(k,k+1)); /* -xk-xk */ + + /* (TO BE LINEARIZED TO AVOID MULTIPLICATION) */ + for (i=0;i<=k;i+=2) { + num_set(buf1+i ,m->c+matpos(k+1,i+1)); /* -xi+xk */ + num_set(buf2+i ,m->c+matpos(k ,i+1)); /* -xi-xk */ + num_set(buf1+i+1,m->c+matpos(k+1,i )); /* xi+xk */ + num_set(buf2+i+1,m->c+matpos(k ,i )); /* xi-xk */ + } + for (;ic+matpos(i ,k )); /* xk-xi */ + num_set(buf2+i ,m->c+matpos(i ,k+1)); /* -xk-xi */ + num_set(buf1+i+1,m->c+matpos(i+1,k )); /* xk+xi */ + num_set(buf2+i+1,m->c+matpos(i+1,k+1)); /* -xk+xi */ + } + + for (i=0;ic; /* xj-xi */ + /* (TO BE LINEARIZED TO AVOID MULTIPLICATION) */ + + for (i=0;ic+matpos(i+1,i)); /* ( xi+xi)/2 */ + num_div_by_2(buf1+i+1,m->c+matpos(i,i+1)); /* (-xi-xi)/2 */ + } + + for (i=0;ic+matpos(i,i))<0) { + m->state=OCT_EMPTY; + num_clear_n(m->c,matsize(m->n)); + oct_mm_free(m->c); m->c = (num_t*)NULL; + OCT_EXIT("oct_close_incremental_2",11); + goto end; + } + + } + OCT_EXIT("oct_close_incremental_2",11); + m->state = OCT_CLOSED; + end: + num_clear(&kk1); num_clear(&kk2); + num_clear(&ik1); num_clear(&ik2); + num_clear(&ij1); num_clear(&ij2); num_clear(&ij3); num_clear(&ij4); + num_clear_n(buf1,n2); num_clear_n(buf2,n2); + oct_mm_free(buf1); oct_mm_free(buf2); + end2: + OCT_EXIT("oct_close_incremental",9); +} + +#else /* optimized algorithm from BHMZ05 (constant factor improvement) */ + + +inline +void +OCT_PROTO(close_incremental) (oct_t* m, + var_t v) +{ + var_t i,j,k; + const var_t n2 = m->n*2; + const var_t v2 = v*2; + num_t *c; + num_t ij,ik,ik2; + + OCT_ENTER("oct_close_incremental",9); + OCT_ASSERT(vn,"variable index greater than the number of variables in oct_close_incremental"); + if (m->state==OCT_EMPTY) goto end2; + + num_init(&ik); num_init(&ik2); num_init(&ij); + + /* incremental Floyd-Warshall : v in end-point position */ + for (k=0;kc+matpos(i,0); + num_set(&ik,m->c+matpos2(i,k)); + num_set(&ik2,m->c+matpos2(i,kk)); + for (j=0;j<=br;j++,c++) { + num_add(&ij,&ik,m->c+matpos(k,j)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,m->c+matpos(kk,j)); /* ik2+k2j */ + num_min(c,c,&ij); + } + for (;j<=ii;j++,c++) { + num_add(&ij,&ik,m->c+matpos(j^1,kk)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,m->c+matpos(j^1,k)); /* ik2+k2j */ + num_min(c,c,&ij); + } + /* v in second end-point position */ + num_set(&ik,m->c+matpos2(k,i)); + num_set(&ik2,m->c+matpos2(kk,i)); + for (j=i;jc+matpos(j,i); + num_add(&ij,&ik,m->c+matpos(kk,j^1)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,m->c+matpos(k,j^1)); /* ik2+k2j */ + num_min(c,c,&ij); + } + for (;jc+matpos(j,i); + num_add(&ij,&ik,m->c+matpos(j,k)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,m->c+matpos(j,kk)); /* ik2+k2j */ + num_min(c,c,&ij); + } + } + } + + /* incremental Floyd-Warshall : v in pivot position */ + for (k=v2;kc; + for (i=0;ic+matpos2(i,k)); + num_set(&ik2,m->c+matpos2(i,kk)); + for (j=0;j<=br;j++,c++) { + num_add(&ij,&ik,m->c+matpos(k,j)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,m->c+matpos(kk,j)); /* ik2+k2j */ + num_min(c,c,&ij); + } + for (;j<=ii;j++,c++) { + num_add(&ij,&ik,m->c+matpos(j^1,kk)); /* ik+kj */ + num_min(c,c,&ij); + num_add(&ij,&ik2,m->c+matpos(j^1,k)); /* ik2+k2j */ + num_min(c,c,&ij); + } + } + } + + /* lone S step */ + c = m->c; + for (i=0;ic+matpos(i,i^1)); + for (j=0;j<=ii;j++,c++) { + num_div_by_2(&ik,m->c+matpos(j^1,j)); + num_add(&ik,&ik,&ij); + num_min(c,c,&ik); + } + } + + /* emptyness checking */ + for (i=0;ic+matpos(i,i); + if (num_cmp_zero(c)<0) { + m->state = OCT_EMPTY; + num_clear_n(m->c,matsize(m->n)); + oct_mm_free(m->c); m->c = (num_t*)NULL; + goto end; + } + else num_set_int(c,0); + } + + m->state = OCT_CLOSED; + end: + num_clear(&ik); num_clear(&ik2); num_clear(&ij); + end2: + OCT_EXIT("oct_close_incremental",9); +} + +#endif + + +/*********/ +/* Tests */ +/*********/ + +/* non-destructively computes the closure to check for emptiness + calls oct_close with cache=true, so subsequent calls + to oct_is_empty/oct_close will be very very fast + cost: the cost of the close operator +*/ +inline +bool +OCT_PROTO(is_empty) (oct_t* m) +{ + oct_t* mm; + bool r; + OCT_ENTER("oct_is_empty",12); + mm = oct_close(m, false, true); + r = (mm->state==OCT_EMPTY)?true:false; + oct_free(mm); + OCT_EXIT("oct_is_empty",12); + return r; +} + +/* can return tbool_top if a call to close would be required to answer + null cost + */ +inline +tbool +OCT_PROTO(is_empty_lazy) (oct_t* m) +{ + tbool r; + OCT_ENTER("oct_is_empty_lazy",13); + r = (m->state==OCT_EMPTY + || (m->closed && m->closed->state==OCT_EMPTY))?tbool_true: + ((m->state==OCT_CLOSED || m->closed)?tbool_false:tbool_top); + OCT_EXIT("oct_is_empty_lazy",13); + return r; +} + +/* calls oct_close with cache=true + O(n^2) time cost, on behalf of the cost of closure + */ +bool +OCT_PROTO(is_included_in) (oct_t* ma, + oct_t* mb) +{ + bool r; + OCT_ENTER("oct_is_included_in",14); + OCT_ASSERT(ma->n==mb->n,"oct_is_included_in must be called with two octagons of the same dimension."); + if (ma==mb) r = true; + else { + oct_t *ca = oct_close(ma, false, true); + if (ca->state==OCT_EMPTY) r = true; + else if (oct_is_empty_lazy(mb)==tbool_true) r = false; + else { + const size_t nn = matsize(ma->n); + size_t i; + num_t* a = ca->c; + num_t* b = mb->c; + r = true; + for (i=0;i0) { r=false; break; } + } + oct_free(ca); + } + OCT_EXIT("oct_is_included_in",14); + return r; +} + +/* can return tbool_top if a call to close would be required to answer + O(n^2) time cost +*/ +tbool +OCT_PROTO(is_included_in_lazy) (oct_t* ma, + oct_t* mb) +{ + tbool r; + OCT_ENTER("oct_is_included_in_lazy",15); + OCT_ASSERT(ma->n==mb->n,"oct_is_included_in_lazy must be called with two octagons of the same dimension."); + if (ma==mb) r = tbool_true; + else { + oct_t *ca = oct_close_lazy (ma, false); + if (ca->state==OCT_EMPTY) r = tbool_true; + else if (mb->state==OCT_EMPTY) r = tbool_false; + else { + const size_t nn = matsize(ma->n); + size_t i; + num_t* a = ca->c; + num_t* b = mb->c; + + r = tbool_true; + for (i=0;i0) { r=tbool_false; break; } + } + if (r==tbool_false && !oct_is_closed(ca)) r = tbool_top; + oct_free(ca); + } + OCT_EXIT("oct_is_included_in_lazy",15); + return r; +} + +/* calls oct_close with cache=true + O(n^2) time cost, on behalf of the cost of closure + */ +bool +OCT_PROTO(is_equal) (oct_t* ma, + oct_t* mb) +{ + bool r; + OCT_ENTER("oct_is_equal",16); + OCT_ASSERT(ma->n==mb->n,"oct_is_equal must be called with two octagons of the same dimension."); + if (ma==mb) r = true; + else { + oct_t *ca = oct_close(ma, false, true); + oct_t *cb = oct_close(mb, false, true); + if (ca->state==OCT_EMPTY && cb->state==OCT_EMPTY) r = true; + else if (ca->state==OCT_EMPTY || cb->state==OCT_EMPTY) r = false; + else { + const size_t nn = matsize(ma->n); + size_t i; + num_t* a = ca->c; + num_t* b = cb->c; + r = true; + for (i=0;in==mb->n,"oct_is_equal_lazy must be called with two octagons of the same dimension."); + if (ma==mb) r = tbool_true; + else { + oct_t *ca = oct_close_lazy (ma, false); + oct_t *cb = oct_close_lazy (mb, false); + if (ca->state==OCT_EMPTY && cb->state==OCT_EMPTY) r = tbool_true; + else if (ca->state==OCT_EMPTY || cb->state==OCT_EMPTY) r = tbool_false; + else { + const size_t nn = matsize(ma->n); + size_t i; + num_t* a = ca->c; + num_t* b = cb->c; + + r = tbool_true; + for (i=0;in;i++) + for (j=0;j<=i;j++) { + num_add(&w,v+i,a->c+matpos(2*i,2*j)); + if (num_cmp(v+j,&w)>0) { r = false; goto end; } + + num_add(&w,v+j,a->c+matpos(2*i+1,2*j+1)); + if (num_cmp(v+i,&w)>0){ r = false; goto end; } + + num_add(&w,v+i,v+j); + if (num_cmp(&w,a->c+matpos(2*i+1,2*j))>0) { r = false; goto end; } + + num_add(&w,v+i,v+j); num_add(&w,&w,a->c+matpos(2*i,2*j+1)); + if (num_cmp_zero(&w)<0) { r = false; goto end; } + } + end: + num_clear(&w); + end2: + OCT_EXIT("oct_is_in",18); + return r; +} + +/* return true if the octagon has a full domain + O(n^2) time cost +*/ +bool +OCT_PROTO(is_universe) (oct_t* m) +{ + bool r = true; + const var_t n2 = m->n*2; + var_t i,j; + num_t* c = m->c; + OCT_ENTER("oct_is_universe",19); + if (m->state==OCT_EMPTY) { r = false; goto end; } + for (i=0;in==mb->n,"oct_intersection must be called with two octagons of the same dimension."); + if (ma==mb) r = oct_copy(ma); + /* ma empty => intersection equals ma */ + else if (oct_is_empty_lazy(ma)==tbool_true) r = oct_copy(ma); + /* mb empty => intersection equals mb */ + else if (oct_is_empty_lazy(mb)==tbool_true) r = oct_copy(mb); + else { + const size_t nn = matsize(ma->n); + size_t i; + num_t* a = ma->c; + num_t* b = mb->c; + num_t* c; + /* result is computed in ma, or mb, or a new octagon */ + if (destructive) { + if (ma->ref==1) r = oct_copy(ma); + else if (mb->ref==1) r = oct_copy(mb); + else r = oct_alloc(ma->n); + } + else r = oct_alloc(ma->n); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + /* change the result matrix */ + c = r->c; + for (i=0;in==mb->n,"oct_convex_hull must be called with two octagons of the same dimension."); + if (ma==mb) { + if (destructive) { r = ma; oct_free(ma); } + else r = oct_copy(ma); + } + else { + oct_t* ca = oct_close(ma, destructive, true); + oct_t* cb = oct_close(mb, destructive, true); + /* ca empty => hull equals cb */ + if (ca->state==OCT_EMPTY) r = oct_copy(cb); + /* cb empty => hull equals ca */ + else if (cb->state==OCT_EMPTY) r = oct_copy(ca); + else { + const size_t nn = matsize(ca->n); + size_t i; + num_t* a = ca->c; + num_t* b = cb->c; + num_t* c; + /* result is computed in ca, or cb, or a new octagon */ + if (destructive) { + if (ca->ref==1) r = oct_copy(ca); + else if (cb->ref==1) r = oct_copy(cb); + else r = oct_alloc(ca->n); + } + else r = oct_alloc(ca->n); + r->state = OCT_CLOSED; + /* change the result matrix */ + c = r->c; + for (i=0;in==mb->n,"oct_widening must be called with two octagons of the same dimension."); + if (ma==mb) { + if (destructive) { r = ma; oct_free(ma); } + else r = oct_copy(ma); + } + /* ma empty => widening equals cb */ + else if (oct_is_empty_lazy(ma)==tbool_true) { + if (destructive) { r = mb; oct_free(ma); } + else r = oct_copy(mb); + } + else { + oct_t* cb = oct_close(mb, destructive, true); + /* cb empty => widening equals ma */ + if (cb->state==OCT_EMPTY) r = oct_copy(ma); + else { + const size_t nn = matsize(ma->n); + size_t i; + num_t* a = ma->c; + num_t* b = cb->c; + num_t* c; + /* result is computed in ma, or cb, or a new octagon */ + if (destructive) { + if (ma->ref==1) r = oct_copy(ma); + else if (cb->ref==1) r = oct_copy(cb); + else r = oct_alloc(ma->n); + } + else r = oct_alloc(ma->n); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + /* change the result matrix */ + c = r->c; + switch (type) { + + /* 0, +oo */ + case OCT_WIDENING_ZERO: + for (i=0;in==mb->n,"oct_widening_steps must be called with two octagons of the same dimension."); + if (ma==mb) { + if (destructive) { r = ma; oct_free(ma); } + else r = oct_copy(ma); + } + /* ma empty => widening equals cb */ + else if (oct_is_empty_lazy(ma)==tbool_true) { + if (destructive) { r = mb; oct_free(ma); } + else r = oct_copy(mb); + } + else { + oct_t* cb = oct_close(mb, destructive, true); + /* cb empty => widening equals ma */ + if (cb->state==OCT_EMPTY) r = oct_copy(ma); + else { + const size_t nn = matsize(ma->n); + size_t i; + int j; + num_t* a = ma->c; + num_t* b = cb->c; + num_t* c; + /* result is computed in ma, or cb, or a new octagon */ + if (destructive) { + if (ma->ref==1) r = oct_copy(ma); + else if (cb->ref==1) r = oct_copy(cb); + else r = oct_alloc(ma->n); + } + else r = oct_alloc(ma->n); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + /* change the result matrix */ + c = r->c; + for (i=0;in==mb->n,"oct_narrowing must be called with two octagons of the same dimension."); + if (ma==mb) { + if (destructive) { r = ma; oct_free(ma); } + else r = oct_copy(ma); + } + else { + oct_t* ca = oct_close(ma, destructive, true); + oct_t* cb = oct_close(mb, destructive, true); + /* ca empty => narrowing equals cb */ + if (ca->state==OCT_EMPTY) r = oct_copy(cb); + /* cb empty => narrowing equals ca */ + else if (cb->state==OCT_EMPTY) r = oct_copy(ca); + else { + const size_t nn = matsize(ca->n); + size_t i; + num_t* a = ca->c; + num_t* b = cb->c; + num_t* c; + /* result is computed in ca, or cb, or a new octagon */ + if (destructive) { + if (ca->ref==1) r = oct_copy(ca); + else if (cb->ref==1) r = oct_copy(cb); + else r = oct_alloc(ca->n); + } + else r = oct_alloc(ca->n); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* change the result matrix */ + c = r->c; + for (i=0;in; + var_t i; + OCT_ENTER("oct_forget",24); + mm = oct_close(m, destructive, true); + OCT_ASSERT(kn,"variable index greater than the number of variables in oct_forget"); + /* mm empty => return mm */ + if (mm->state==OCT_EMPTY) { r = mm; goto end; } + /* result is computed in mm, or in a new octagon */ + if (mm->ref==1) r = mm; + else { r = oct_full_copy(mm); mm->ref--; } + /* change the result matrix */ + for (i=0;ic+matpos(k2 ,i)); + num_set_infty(r->c+matpos(k2+1,i)); + } + for (i=k2+2;ic+matpos(i,k2 )); + num_set_infty(r->c+matpos(i,k2+1)); + } + num_set_infty(r->c+matpos(k2,k2+1)); + num_set_infty(r->c+matpos(k2+1,k2)); + end: + OCT_EXIT("oct_forget",24); + return r; +} + + +/* intersects the domain with constraints of the form + x<=c, -x<=c, x-y<=c, +x+y<=c or -x-y<=c + if the result is not empty, it is always a newly allocated matrix + that can be safely modified in-place + O(nb) time cost +*/ +inline +oct_t* +OCT_PROTO(add_bin_constraints) (oct_t* m, + unsigned int nb, + const oct_cons* cons, + bool destructive) +{ + oct_t* r; + unsigned int k; + num_t c; + var_t changed; + int nb_changed = 0; + OCT_ENTER("oct_add_bin_constraints",25); + /* m empty => return m */ + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end2; } + else { r = oct_copy(m); goto end2; } + /* result is computed in m, or in a new octagon */ + if (destructive) { + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + } + else r = oct_full_copy(m); + /* change the result matrix */ + num_init(&c); + for (k=0;kn,"variable index greater than the number of variables in oct_add_constraints"); + OCT_ASSERT(cons[k].type==mx || cons[k].type==px || cons[k].yn,"variable index greater than the number of variables in oct_add_constraints"); + switch (cons[k].type) { + case mx: + j=2*cons[k].x+1; i=2*cons[k].x; num_mul_by_2(&c,&cons[k].c); + if (num_cmp(&c,r->c+matpos2(i,j))<0) { + num_set(r->c+matpos2(i,j),&c); + if (nb_changed==0 ) { nb_changed=1; changed=cons[k].x; } + else if (changed!=cons[k].x) nb_changed++; + } + break; + + case px: + j=2*cons[k].x; i=2*cons[k].x+1; num_mul_by_2(&c,&cons[k].c); + if (num_cmp(&c,r->c+matpos2(i,j))<0) { + num_set(r->c+matpos2(i,j),&c); + if (nb_changed==0 ) { nb_changed=1; changed=cons[k].x; } + else if (changed!=cons[k].x) nb_changed++; + } + break; + + case mxmy: + j=2*cons[k].x+1; i=2*cons[k].y; num_set(&c,&cons[k].c); + if (num_cmp(&c,r->c+matpos2(i,j))<0) { + num_set(r->c+matpos2(i,j),&c); + if (nb_changed==0 ) { nb_changed=1; changed=cons[k].x; } + else if (changed!=cons[k].x && changed!=cons[k].y) nb_changed++; + } + break; + + case mxpy: + j=2*cons[k].x+1; i=2*cons[k].y+1; num_set(&c,&cons[k].c); + if (num_cmp(&c,r->c+matpos2(i,j))<0) { + num_set(r->c+matpos2(i,j),&c); + if (nb_changed==0 ) { nb_changed=1; changed=cons[k].x; } + else if (changed!=cons[k].x && changed!=cons[k].y) nb_changed++; + } + break; + + case pxmy: + j=2*cons[k].x; i=2*cons[k].y; num_set(&c,&cons[k].c); + if (num_cmp(&c,r->c+matpos2(i,j))<0) { + num_set(r->c+matpos2(i,j),&c); + if (nb_changed==0 ) { nb_changed=1; changed=cons[k].x; } + else if (changed!=cons[k].x && changed!=cons[k].y) nb_changed++; + } + break; + + case pxpy: + j=2*cons[k].x; i=2*cons[k].y+1; num_set(&c,&cons[k].c); + if (num_cmp(&c,r->c+matpos2(i,j))<0) { + num_set(r->c+matpos2(i,j),&c); + if (nb_changed==0 ) { nb_changed=1; changed=cons[k].x; } + else if (changed!=cons[k].x && changed!=cons[k].y) nb_changed++; + } + break; + + default: + OCT_ASSERT(false,"invalid constraint type in oct_add_constraints"); + } + } + if (nb_changed==1 && r->state==OCT_CLOSED) oct_close_incremental(r,changed); + else if (nb_changed>0) { + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + } + num_clear(&c); + end2: + OCT_EXIT("oct_add_bin_constraints",25); + return r; +} + + + +/* transfer funciton modeling forward semantics of assignment x <- e + e = tab[0]v0 + tab[1]v1 + ... + tab[N-1]v(N-1) + tab[N] + the operation is exact for assignments of the form + x <- c + x <- x + c + x <- -x + c + x <- y + c (x!=y) + x <- -y + c (x!=y) + + for other assignments x <- e, leads to the constraints m <= x <= M, where + m and M are computed using a simple interval arithmetic on e + if the coefficient of y in e is >= 1, then bounds for x-y are also derived + if the coefficient of y in e is <=-1, then bounds for x+y are also derived + + if the result is not empty, it is always a newly allocated matrix + that can be safely modified in-place + + often need to close its argument + returns a closed result whenever possible + */ +oct_t* +OCT_PROTO(assign_variable) (oct_t* m, + var_t x, + const num_t* tab, + bool destructive) +{ + oct_t* r; + var_t i, y, N = 0; + const var_t n = m->n; + const var_t n2 = n*2; + const var_t x2 = 2*x; + const num_t* c = tab+n; + OCT_ENTER("oct_assign_variable",26); + OCT_ASSERT(xn,"variable index greater than the number of variables in oct_assign_variable"); + + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + + if (num_infty(c)) { r = oct_forget (m, x, destructive); goto end; } + for (i=0;istate==OCT_EMPTY) goto end; + num_mul_by_2(r->c+matpos(x2+1,x2),c); + num_neg(r->c+matpos(x2,x2+1),r->c+matpos(x2+1,x2)); + /* the following is only here to ensure matrix closedness + with a O(n) cost; does it worth it ? */ + for (i=0;ic+matpos(x2,i); + num_t* i2 = r->c+matpos(x2+1,i); + const num_t* i3 = r->c+matpos(i^1,i); + num_div_by_2(i1,i3); num_sub(i1,i1,c); + num_div_by_2(i2,i3); num_add(i2,i2,c); + } + for (i=x2+2;ic+matpos(i,x2); + num_t* i2 = r->c+matpos(i,x2+1); + const num_t* i3 = r->c+matpos(i,i^1); + num_div_by_2(i1,i3); num_add(i1,i1,c); + num_div_by_2(i2,i3); num_sub(i2,i2,c); + } + } + + else if (N==1 && (!num_cmp_int(tab+y,1) || !num_cmp_int(tab+y,-1))) + /* x <- +/- y + c */ + + if (y!=x) { /* x <- +/- y + c, x!=y */ + r = oct_forget (m, x, destructive); + if (r->state==OCT_EMPTY) goto end; + if (!num_cmp_int(tab+y,1)) { /* x <- y + c, y!=x */ + num_set(r->c+matpos2(2*y,x2),c); + num_neg(r->c+matpos2(x2,2*y),c); + } + else { /* x <- -y + c, y!=x */ + num_set(r->c+matpos2(2*y+1,x2),c); + num_neg(r->c+matpos2(x2,2*y+1),c); + } + oct_close_incremental(r,x); + } + + else { /* x <- +/- x + c; respects closure */ + + m = oct_close_lazy(m,destructive); + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* modify the result matrix */ + if (!num_cmp_int(tab+x,-1)) { /* x <- -x + c */ + num_t w,ww; + num_init(&w); num_init(&ww); + num_mul_by_2(&ww,c); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_set(&w,xi); + num_sub(xi,ix,c); + num_add(ix,&w,c); + } + num_set(&w,r->c+matpos(x2,x2+1)); + num_sub(r->c+matpos(x2,x2+1),r->c+matpos(x2+1,x2),&ww); + num_add(r->c+matpos(x2+1,x2),&w ,&ww); + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_set(&w,xi); + num_sub(xi,ix,c); + num_add(ix,&w,c); + } + num_clear(&w); num_clear(&ww); + } + else { /* x <- x + c */ + num_t ww; + num_init(&ww); + num_mul_by_2(&ww,c); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_sub(xi,xi,c); + num_add(ix,ix,c); + } + num_add(r->c+matpos(x2+1,x2),r->c+matpos(x2+1,x2),&ww); + num_sub(r->c+matpos(x2,x2+1),r->c+matpos(x2,x2+1),&ww); + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_sub(xi,xi,c); + num_add(ix,ix,c); + } + num_clear(&ww); + } + } + + else { /* general case */ + var_t j; + num_t* buf; /* bounds for each variable */ + num_t Cb,cb; /* global upper / lower bounds */ + int Cinf, cinf; /* number of infinite coef in up/lw bounds */ + var_t Ci, ci; /* var leading to infinite coef in up/lw bounds */ + num_t w; + int changed = 0; + r = oct_close (m,destructive,false); + if (r->state==OCT_EMPTY) goto end; + buf = new_n(num_t,n2); + num_init(&Cb); num_init(&cb); num_init(&w); + num_mul_by_2(&Cb,c); num_neg(&cb,&Cb); + Cinf = cinf = 0; + for (i=0,j=0;ic+matpos(i+1,i); /* xj+xj */ + num_t* mx = r->c+matpos(i,i+1); /* -xj-xj */ + num_init_set(buf+i ,px); + num_init_set(buf+i+1,mx); + if (num_cmp_zero(tab+j)>0) { + if (num_infty(px)) { Cinf++; Ci = j; } + else { num_mul(&w,tab+j,px); num_add(&Cb,&Cb,&w); } + if (num_infty(mx)) { cinf++; ci = j; } + else { num_mul(&w,tab+j,mx); num_add(&cb,&cb,&w); } + } + else if (num_cmp_zero(tab+j)<0) { + if (num_infty(mx)) { Cinf++; Ci = j; } + else { num_neg(&w,tab+j); num_mul(&w,&w,mx); num_add(&Cb,&Cb,&w); } + if (num_infty(px)) { cinf++; ci = j; } + else { num_neg(&w,tab+j); num_mul(&w,&w,px); num_add(&cb,&cb,&w); } + } + } + r = oct_forget (r,x,true); + /* upper bounds */ + switch (Cinf) { + case 0: + /* bound is not infinite */ + num_set(r->c+matpos(x2+1,x2),&Cb); /* bound for x */ + for (i=0;i=0 && !num_infty(buf+2*i)) { + /* bound for x-y */ + num_sub(&w,&Cb,buf+2*i); + num_div_by_2(r->c+matpos2(2*i, x2),&w); + } + else if (num_cmp_int(tab+i,-1)<=0 && !num_infty(buf+2*i+1)) { + /* bound for x+y */ + num_sub(&w,&Cb,buf+2*i+1); + num_div_by_2(r->c+matpos2(2*i+1,x2),&w); + } + } + changed = 1; + break; + case 1: + /* bound has only one infinite coef, for var y of index Ci => + we may still have a finite bound for x-y, or x+y */ + if (Ci!=x) { + if (!num_cmp_int(tab+Ci,1)) num_div_by_2(r->c+matpos2(Ci*2 ,x2),&Cb); + else if (!num_cmp_int(tab+Ci,-1)) num_div_by_2(r->c+matpos2(Ci*2+1,x2),&Cb); + } + changed = 1; + break; + } + /* lower bounds */ + switch (cinf) { + case 0: + /* bound is not infinite */ + num_set(r->c+matpos(x2,x2+1),&cb); /* bound for -x */ + for (i=0;i=0 && !num_infty(buf+2*i+1)) { + /* bound for -x+y */ + num_sub(&w,&cb,buf+2*i+1); + num_div_by_2(r->c+matpos2(2*i+1,x2+1),&w); + } + else if (num_cmp_int(tab+i,-1)<=0 && !num_infty(buf+2*i)) { + /* bound for -x-y */ + num_sub(&w,&cb,buf+2*i); + num_div_by_2(r->c+matpos2(2*i, x2+1),&w); + } + } + changed = 1; + break; + case 1: + /* bound has only one infinite coef, for var y of index ci => + we may still have a finite bound for -x+y, or -x-y */ + if (ci!=x) { + if (!num_cmp_int(tab+ci,1)) num_div_by_2(r->c+matpos2(x2,ci*2 ),&cb); + else if (!num_cmp_int(tab+ci,-1)) num_div_by_2(r->c+matpos2(x2,ci*2+1),&cb); + } + changed = 1; + break; + } + num_clear_n(buf,n2); oct_mm_free (buf); + num_clear(&cb); num_clear(&Cb); num_clear(&w); + if (changed) oct_close_incremental(r,x); + } + end: + OCT_EXIT("oct_assign_variable",26); + return r; +} + + + +/* transfer function modeling backward semantics of assignment x -> e + e = tab[0]v0 + tab[1]v1 + ... + tab[N-1]v(N-1) + tab[N] + the operation is exact for assignments of the form + x -> c + x -> x + c + x -> -x + c + x -> y + c (x!=y) + x -> -y + c (x!=y) + for other assignments, this call is equivalent to oct_forget! + THE GENERAL CASE COULD BE IMPROVED + + if the result is not empty, it is always a newly allocated matrix + that can be safely modified in-place + + often need to close its argument + returns a closed result whenever possible + */ +oct_t* +OCT_PROTO(substitute_variable) (oct_t* m, + var_t x, + const num_t* tab, + bool destructive) +{ + oct_t* r; + var_t i, y, N = 0; + const var_t n2 = m->n*2; + const var_t x2 = 2*x; + const num_t* c = tab+m->n; + OCT_ENTER("oct_substitute_variable",27); + OCT_ASSERT(xn,"variable index greater than the number of variables in oct_substitute_variable"); + + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + + if (num_infty(c)) { r = oct_forget (m, x, destructive); goto end; } + for (i=0;in;i++) + if (num_infty(tab+i)) { r = oct_forget (m, x, destructive); goto end; } + else if (num_cmp_zero(tab+i)) { y=i; N++; } + + if (N==0) { /* x -> c */ + oct_t* mm; + num_t w1,w2; + mm = oct_close (m,destructive,false); + num_init(&w1); num_init(&w2); + /* result is empty */ + if (mm->state==OCT_EMPTY) { r = mm; goto end0; } + num_mul_by_2(&w1,c); + num_neg(&w2,&w1); + if (num_cmp(&w1,mm->c+matpos(x2+1,x2))>0 || + num_cmp(&w2,mm->c+matpos(x2,x2+1))>0) + { r = oct_empty(mm->n); oct_free(mm); goto end0; } + /* result is computed in mm, or in a new octagon */ + if (mm->ref==1) r = mm; + else { r = oct_full_copy(mm); mm->ref--; } + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* change the result matrix */ + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_t* ii = r->c+matpos(i^1,i); + num_add(&w1,xi,c); + num_sub(&w2,ix,c); + num_min(&w1,&w1,&w2); + num_mul_by_2(&w1,&w1); + num_min(ii,ii,&w1); + num_set_infty(xi); + num_set_infty(ix); + } + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_t* ii = r->c+matpos(i,i^1); + num_add(&w1,xi,c); + num_sub(&w2,ix,c); + num_min(&w1,&w1,&w2); + num_mul_by_2(&w1,&w1); + num_min(ii,ii,&w1); + num_set_infty(xi); + num_set_infty(ix); + } + num_set_infty(r->c+matpos(x2,x2+1)); + num_set_infty(r->c+matpos(x2+1,x2)); + end0: + num_clear(&w1); num_clear(&w2); + } + + else if (N==1 && (!num_cmp_int(tab+y,1) || !num_cmp_int(tab+y,-1))) + if (y!=x) { /* x -> +/- y + c, x!=y */ + var_t yy, yy1; + oct_t* mm; + num_t w; + num_init(&w); + mm = oct_close (m,destructive,false); + if (!num_cmp_int(tab+y,-1)) yy = 2*y+1; else yy = 2*y; + yy1 = yy^1; + /* result is empty */ + if (mm->state==OCT_EMPTY) { r = mm; goto end1; } + num_neg(&w,c); + if (num_cmp(c ,mm->c+matpos2(yy,x2))>0 || + num_cmp(&w,mm->c+matpos2(x2,yy))>0) + { r = oct_empty(mm->n); oct_free(mm); goto end1; } + /* result is computed in mm, or in a new octagon */ + if (mm->ref==1) r = mm; + else { r = oct_full_copy(mm); mm->ref--; } + /* change the result matrix */ + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_t* yi = r->c+matpos2(yy ,i); + num_t* iy = r->c+matpos2(yy1,i); + num_add(xi,xi,c); num_min(yi,yi,xi); num_set_infty(xi); + num_sub(ix,ix,c); num_min(iy,iy,ix); num_set_infty(ix); + } + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_t* yi = r->c+matpos2(i,yy1); + num_t* iy = r->c+matpos2(i,yy ); + num_add(xi,xi,c); num_min(yi,yi,xi); num_set_infty(xi); + num_sub(ix,ix,c); num_min(iy,iy,ix); num_set_infty(ix); + } + { + num_t* xi = r->c+matpos(x2 ,x2+1); + num_t* ix = r->c+matpos(x2+1,x2 ); + num_t* yi = r->c+matpos2(yy ,yy1); + num_t* iy = r->c+matpos2(yy1,yy ); + num_mul_by_2(&w,c); + num_add(xi,xi,&w); num_min(yi,yi,xi); num_set_infty(xi); + num_sub(ix,ix,&w); num_min(iy,iy,ix); num_set_infty(ix); + } + oct_close_incremental(r,x); + end1: + num_clear(&w); + } + else { + /* x -> x + c is equivalent to x <- x - c + x -> -x + c is equivalent to x <- -x + c + they respect closure + */ + + /* result is computed in m, or in a new octagon */ + m = oct_close_lazy(m,destructive); + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* modify the result matrix */ + if (!num_cmp_int(tab+x,-1)) { /* x -> -x + c */ + num_t w,ww; + num_init(&w); num_init(&ww); + num_mul_by_2(&ww,c); + for (i=0;ic+matpos(x2+1,i); + num_t* ix = r->c+matpos(x2 ,i); + num_set(&w,xi); + num_add(xi,ix,c); + num_sub(ix,&w,c); + } + { + num_t* xi = r->c+matpos(x2+1,x2 ); + num_t* ix = r->c+matpos(x2 ,x2+1); + num_set(&w,xi); + num_add(xi,ix,&ww); + num_sub(ix,&w,&ww); + } + for (i=x2+2;ic+matpos(i,x2 ); + num_t* ix = r->c+matpos(i,x2+1); + num_set(&w,xi); + num_add(xi,ix,c); + num_sub(ix,&w,c); + } + num_clear(&w); num_clear(&ww); + } + else { /* x -> x + c */ + num_t ww; + num_init(&ww); + num_mul_by_2(&ww,c); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_add(xi,xi,c); + num_sub(ix,ix,c); + } + { + num_t* xi = r->c+matpos(x2 ,x2+1); + num_t* ix = r->c+matpos(x2+1,x2 ); + num_add(xi,xi,&ww); + num_sub(ix,ix,&ww); + } + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_add(xi,xi,c); + num_sub(ix,ix,c); + } + num_clear(&ww); + } + + } + + else { /* general case */ + r = oct_forget (m, x, destructive); + } + end: + OCT_EXIT("oct_substitute_variable",27); + return r; +} + + + + + +/* intersects the domain with a linear constraint + tab[0]v0 + tab[1]v1 + ... + tab[N-1]v(N-1) + tab[N] >= 0 + + if the result is not empty, it is always a newly allocated matrix + that can be safely modified in-place + */ +oct_t* +OCT_PROTO(add_constraint) (oct_t* m, + const num_t* tab, + bool destructive) +{ + oct_t* r; + var_t i, n = 0; + oct_cons c; + OCT_ENTER("oct_add_constraint",28); + + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + + for (i=0;in;i++) + if (num_cmp_zero(tab+i)) { c.x=i; n=1; break; } + for (i++;in;i++) + if (num_cmp_zero(tab+i)) { c.y=i; n++; } + + if (n==0) { + if (num_cmp_zero(tab+m->n)>=0) r = oct_copy(m); + else r = oct_empty (m->n); + if (destructive) oct_free (m); + } + + else if (n==1 && !num_cmp_int(tab+c.x,1)) { + c.type = mx; + num_init_set(&c.c,tab+m->n); + r = oct_add_bin_constraints (m, 1, &c, destructive); + } + + else if (n==1 && !num_cmp_int(tab+c.x,-1)) { + c.type = px; + num_init_set(&c.c,tab+m->n); + r = oct_add_bin_constraints (m, 1, &c, destructive); + } + + else if (n==2 && !num_cmp_int(tab+c.x,1) && !num_cmp_int(tab+c.y,1)) { + c.type = mxmy; + num_init_set(&c.c,tab+m->n); + r = oct_add_bin_constraints (m, 1, &c, destructive); + } + + else if (n==2 && !num_cmp_int(tab+c.x,1) && !num_cmp_int(tab+c.y,-1)) { + c.type = mxpy; + num_init_set(&c.c,tab+m->n); + r = oct_add_bin_constraints (m, 1, &c, destructive); + } + + else if (n==2 && !num_cmp_int(tab+c.x,-1) && !num_cmp_int(tab+c.y,1)) { + c.type = pxmy; + num_init_set(&c.c,tab+m->n); + r = oct_add_bin_constraints (m, 1, &c, destructive); + } + + else if (n==2 && !num_cmp_int(tab+c.x,-1) && !num_cmp_int(tab+c.y,-1)) { + c.type = pxpy; + num_init_set(&c.c,tab+m->n); + r = oct_add_bin_constraints (m, 1, &c, destructive); + } + + else + if (destructive) r = m; + else r = oct_copy (m); + end: + OCT_EXIT("oct_add_constraint",28); + return r; +} + + + +/**************************/ +/* Experimental operators */ +/**************************/ + + +/* as oct_assign_variable, but with interval instead of constant coefficients + e = [-t[1];t[0]]v0 + ... + [-t[2N-1];t[2N-2]v(N-1)] + [-t[2N+1;t[2N]] + + beware the sign inversion of the lower bound! + make sure the lower bound is less than or equal to the higher bound! + + the result is always closed (thanks to calls to oct_close_incremental) + */ +oct_t* +OCT_PROTO(interv_assign_variable) (oct_t* m, + var_t x, + const num_t* t, + bool destructive) +{ + oct_t* r; + var_t i, y, N = 0; + const var_t n = m->n; + const var_t n2 = n*2; + const var_t x2 = 2*x; + const num_t* c = t+n2; + num_t tmp; + OCT_ENTER("oct_interv_assign_variable",29); + OCT_ASSERT(xn,"variable index greater than the number of variables in oct_interv_assign_variable"); + + num_init(&tmp); + + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + + for (i=0;in); + if (destructive) oct_free(m); + goto end; + } + if (num_cmp_zero(t+2*i) || num_cmp_zero(t+2*i+1)) { y=i; N++; } + } + + num_add(&tmp,c,c+1); + if (num_cmp_zero(&tmp)<0) { + r = oct_empty(m->n); + if (destructive) oct_free(m); + goto end; + } + + if (N==0) /* x <- [-d,c] */ + r = oct_set_bounds (m, x,c,c+1,destructive); + + else if (N==1 && + ((!num_cmp_int(t+2*y, 1) && !num_cmp_int(t+2*y+1,-1)) || + (!num_cmp_int(t+2*y,-1) && !num_cmp_int(t+2*y+1, 1)))) + + /* x <- +/- y + [-d,c] */ + + if (y!=x) { /* x <- +/- y + [-d,c], x!=y */ + r = oct_forget (m, x, destructive); + if (r->state==OCT_EMPTY) goto end; + if (!num_cmp_int(t+2*y,1)) { /* x <- y + [-d,c], y!=x */ + num_set(r->c+matpos2(2*y,x2),c); + num_set(r->c+matpos2(x2,2*y),c+1); + } + else { /* x <- -y + [-d,c], y!=x */ + num_set(r->c+matpos2(2*y+1,x2),c); + num_set(r->c+matpos2(x2,2*y+1),c+1); + } + oct_close_incremental(r,x); + } + + else { /* x <- +/- x + [-d,c] respects closure */ + + /* result is computed in m, or in a new octagon */ + m = oct_close_lazy(m,destructive); + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* modify the result matrix */ + if (!num_cmp_int(t+2*x,-1)) { /* x <- -x + [-d,c] */ + num_t w,vv,ww; + num_init(&w); num_init(&vv); num_init(&ww); + num_mul_by_2(&vv,c); num_mul_by_2(&ww,c+1); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_set(&w,xi); + num_add(xi,ix,c+1); + num_add(ix,&w,c); + } + num_set(&w,r->c+matpos(x2,x2+1)); + num_add(r->c+matpos(x2,x2+1),r->c+matpos(x2+1,x2),&ww); + num_add(r->c+matpos(x2+1,x2),&w ,&vv); + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_set(&w,xi); + num_add(xi,ix,c+1); + num_add(ix,&w,c); + } + num_clear(&w); num_clear(&vv); num_clear(&ww); + } + else { /* x <- x + [-d,c] */ + num_t vv,ww; + num_init(&vv); num_init(&ww); + num_mul_by_2(&vv,c); num_mul_by_2(&ww,c+1); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_add(xi,xi,c+1); + num_add(ix,ix,c); + } + num_add(r->c+matpos(x2+1,x2),r->c+matpos(x2+1,x2),&vv); + num_add(r->c+matpos(x2,x2+1),r->c+matpos(x2,x2+1),&ww); + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_add(xi,xi,c+1); + num_add(ix,ix,c); + } + num_clear(&vv); num_clear(&ww); + } + } + + else { /* general case */ + num_t* buf; /* 2*bounds for each variable */ + num_t Cb,cb; /* 2*global upper / lower bound */ + int Cinf, cinf; /* number of infinite coef in up/lw bounds */ + var_t Ci, ci; /* var leading to infinite coef in up/lw bounds */ + num_t ka,kb,kc,kd; + int changed = 0; + r = oct_close (m,destructive,false); + if (r->state==OCT_EMPTY) goto end; + buf = new_n(num_t,n2); + num_init(&Cb); num_init(&cb); + num_init(&ka); num_init(&kb); num_init(&kc); num_init(&kd); + num_mul_by_2(&Cb,c); num_mul_by_2(&cb,c+1); + Cinf = cinf = 0; + for (i=0;ic+matpos(i+1,i); /* xj+xj */ + num_t* mx = r->c+matpos(i,i+1); /* -xj-xj */ + + num_init_set(buf+i ,px); + num_init_set(buf+i+1,mx); + + /* compute Cb & cb ignoring components leading to +oo */ + + /* max */ + if (!num_cmp_zero(t+i)) num_set_int(&ka,0); + else { + num_mul(&ka,t+i ,px); + num_neg(&kb,t+i); + num_mul(&kb,&kb,mx); + num_max(&ka,&ka,&kb); + } + if (!num_cmp_zero(t+i+1)) num_set_int(&kc,0); + else { + num_mul(&kc,t+i+1,mx); + num_neg(&kd,t+i+1); + num_mul(&kd,&kd,px); + num_max(&kc,&kc,&kd); + } + num_max(&ka,&ka,&kc); + if (num_infty(&ka)) { Cinf++; Ci=i; } else num_add(&Cb,&Cb,&ka); + + /* -min */ + if (!num_cmp_zero(t+i)) num_set_int(&ka,0); + else { + num_mul(&ka,t+i ,mx); + num_neg(&kb,t+i); + num_mul(&kb,&kb,px); + num_max(&ka,&ka,&kb); + } + if (!num_cmp_zero(t+i+1)) num_set_int(&kc,0); + else { + num_mul(&kc,t+i+1,px); + num_neg(&kd,t+i+1); + num_mul(&kd,&kd,mx); + num_max(&kc,&kc,&kd); + } + num_max(&ka,&ka,&kc); + if (num_infty(&ka)) { cinf++; ci=i; } else num_add(&cb,&cb,&ka); + } + + r = oct_forget (r,x,true); + + /* upper bounds */ + if (!num_infty(&Cb)) + switch (Cinf) { + case 0: + /* bound is not infinite */ + num_set(r->c+matpos(x2+1,x2),&Cb); /* bound for x */ + for (i=0;ic+matpos2(i, x2),&ka); + } + else if (num_cmp_int(t+i,-1)<=0 && !num_infty(buf+i+1)) { + /* bound for x+y */ + num_sub(&ka,&Cb,buf+i+1); + num_div_by_2(r->c+matpos2(i+1,x2),&ka); + } + } + changed = 1; + break; + case 1: + /* bound has only one infinite coef, for var y of index Ci => + we may still have a finite bound for x-y, or x+y */ + if (Ci!=x2) { + if (!num_cmp_int(t+Ci,1) && !num_cmp_int(t+Ci+1,-1)) { + num_div_by_2(r->c+matpos2(Ci ,x2),&Cb); + changed = 1; + } + else if (!num_cmp_int(t+Ci,-1) && !num_cmp_int(t+Ci+1,1)) { + num_div_by_2(r->c+matpos2(Ci+1,x2),&Cb); + changed = 1; + } + } + break; + } + + /* lower bounds */ + if (!num_infty(&cb)) + switch (cinf) { + case 0: + /* bound is not infinite */ + num_set(r->c+matpos(x2,x2+1),&cb); /* bound for -x */ + for (i=0;ic+matpos2(i+1,x2+1),&ka); + + } + else if (num_cmp_int(t+i,-1)<=0 && !num_infty(buf+i)) { + /* bound for -x-y */ + num_sub(&ka,&cb,buf+i); + num_div_by_2(r->c+matpos2(i, x2+1),&ka); + } + } + changed = 1; + break; + case 1: + /* bound has only one infinite coef, for var y of index ci => + we may still have a finite bound for -x+y, or -x-y */ + if (ci!=x2) { + if (!num_cmp_int(t+ci,1) && !num_cmp_int(t+ci+1,-1)) { + num_div_by_2(r->c+matpos2(x2,ci ),&cb); + changed = 1; + } + else if (!num_cmp_int(t+ci,-1) && !num_cmp_int(t+ci+1,1)) { + num_div_by_2(r->c+matpos2(x2,ci+1),&cb); + changed = 1; + } + } + break; + } + num_clear_n(buf,n2); oct_mm_free (buf); + num_clear(&cb); num_clear(&Cb); + num_clear(&ka); num_clear(&kb); num_clear(&kc); num_clear(&kd); + if (changed) oct_close_incremental(r,x); + } + end: + num_clear(&tmp); + OCT_EXIT("oct_interv_assign_variable",29); + return r; +} + + + +/* as oct_add_constraint, but with interval instead of constant coefficients + [-t[1];t[0]]v0 + ... + [-t[2N-1];t[2N-2]v(N-1)] + [-t[2N+1;t[2N]] >= 0 +*/ +oct_t* +OCT_PROTO(interv_add_constraint) (oct_t* m, + const num_t* t, + bool destructive) +{ + oct_t* r; + var_t i, j, k, y1, y2, N = 0; + const var_t n = m->n; + const var_t n2 = n*2; + const num_t* c = t+n2; + num_t tmp; + OCT_ENTER("oct_interv_add_constraint",46); + + num_init(&tmp); + + if (oct_is_empty_lazy(m)==tbool_true) + { if (destructive) r = m; else r = oct_copy(m); goto end; } + + for (i=0;i= 0 */ + if (num_cmp_int(c,0)>=0) r = oct_copy(m); + else r = oct_empty (m->n); + if (destructive) oct_free(m); + } + + else if (N==1 && /* +/- x + [-d,c] >= 0 */ + ((!num_cmp_int(t+y1, 1) && !num_cmp_int(t+y1+1,-1)) || + (!num_cmp_int(t+y1,-1) && !num_cmp_int(t+y1+1, 1)))) { + oct_cons cons; + cons.x = y1/2; + num_init_set(&cons.c,c); + if (!num_cmp_int(t+y1,1)) cons.type = mx; else cons.type = px; + r = oct_add_bin_constraints(m, 1, &cons, destructive); + num_clear(&cons.c); + } + + + else if (N==2 && /* +/- x +/-y + [-d,c] >= 0 */ + ((!num_cmp_int(t+y1, 1) && !num_cmp_int(t+y1+1,-1)) || + (!num_cmp_int(t+y1,-1) && !num_cmp_int(t+y1+1, 1))) && + ((!num_cmp_int(t+y2, 1) && !num_cmp_int(t+y2+1,-1)) || + (!num_cmp_int(t+y2,-1) && !num_cmp_int(t+y2+1, 1)))) { + + oct_cons cons; + cons.x = y1/2; + cons.y = y2/2; + num_init_set(&cons.c,c); + if (!num_cmp_int(t+y1,1)) { + if (!num_cmp_int(t+y2,1)) cons.type = mxmy; else cons.type = mxpy; + } + else { + if (!num_cmp_int(t+y2,1)) cons.type = pxmy; else cons.type = pxpy; + } + r = oct_add_bin_constraints(m, 1, &cons, destructive); + num_clear(&cons.c); + } + + /* general case */ + else { + num_t* buf; /* 2*bounds for each variable */ + num_t Cb; /* 2*global upper bound */ + int Cinf; /* number of infinite coef in up bound */ + var_t Ci1; /* var1 leading to infinite coef in up bound */ + var_t Ci2; /* var2 leading to infinite coef in up bound */ + num_t ka,kb,kc,kd; + int changed = 0; + r = oct_close (m,destructive,false); + if (r->state==OCT_EMPTY) goto end; + buf = new_n(num_t,n2); + num_init(&Cb); + num_init(&ka); num_init(&kb); num_init(&kc); num_init(&kd); + num_mul_by_2(&Cb,c); + Cinf = 0; + + for (i=0;ic+matpos(i+1,i); /* xj+xj */ + num_t* mx = r->c+matpos(i,i+1); /* -xj-xj */ + + num_init_set(buf+i ,px); + num_init_set(buf+i+1,mx); + + /* max */ + if (!num_cmp_zero(t+i)) num_set_int(&ka,0); + else { + num_mul(&ka,t+i ,px); + num_neg(&kb,t+i); + num_mul(&kb,&kb,mx); + num_max(&ka,&ka,&kb); + } + if (!num_cmp_zero(t+i+1)) num_set_int(&kc,0); + else { + num_mul(&kc,t+i+1,mx); + num_neg(&kd,t+i+1); + num_mul(&kd,&kd,px); + num_max(&kc,&kc,&kd); + } + num_max(&ka,&ka,&kc); + if (num_infty(&ka)) { Cinf++; Ci2=Ci1; Ci1=i; } + else num_add(&Cb,&Cb,&ka); + } + + /* get a copy of r to modify in-place */ + oct_free(r); + r = oct_full_copy(m); + + if (!num_infty(&Cb)) + switch (Cinf) { + case 0: + /* no infinite bound */ + for (i=0;ic+matpos(i,i+1),r->c+matpos(i,i+1),&ka); + k = i+1; + changed = 1; + } + else if (num_cmp_int(t+i,-1)<=0 && !num_infty(buf+i+1)) { + // x <= expr+x <= max(expr) - max(-x) + num_sub(&ka,&Cb,buf+i+1); + num_min(r->c+matpos(i+1,i),r->c+matpos(i+1,i),&ka); + k = i; + changed = 1; + } + else k = -1; + + if (k!=-1) { + for (j=i+2;jc+matpos(j,k),r->c+matpos(j,k),&kb); + changed = 1; + } + else if (num_cmp_int(t+j,-1)<=0 && !num_infty(buf+j+1)) { + // (+/-)x +y <= max(expr) - max((+/-)x) - max (-y) + num_sub(&kb,&ka,buf+j+1); + num_div_by_2(&kb,&kb); + num_min(r->c+matpos(j+1,k),r->c+matpos(j+1,k),&kb); + changed = 1; + } + } + } + } + break; + + case 1: + /* we can still infer info on Ci1 */ + if (!num_cmp_int(t+Ci1, 1) && !num_cmp_int(t+Ci1+1,-1)) k = Ci1+1; + else if (!num_cmp_int(t+Ci1,-1) && !num_cmp_int(t+Ci1+1, 1)) k = Ci1; + else goto end0; + + num_min(r->c+matpos(k^1,k),r->c+matpos(k^1,k),&Cb); + changed = 1; + + for (j=0;jc+matpos2(j,k),r->c+matpos2(j,k),&kb); + } + else if (num_cmp_int(t+j,-1)<=0 && !num_infty(buf+j+1)) { + // (+/-)x +y <= max(expr) - max((+/-)x) - max (-y) + num_sub(&kb,&Cb,buf+j+1); + num_div_by_2(&kb,&kb); + num_min(r->c+matpos2(j+1,k),r->c+matpos2(j+1,k),&kb); + } + } + break; + + case 2: + /* we can still infer info on Ci1 & Ci2 */ + if (!num_cmp_int(t+Ci1, 1) && !num_cmp_int(t+Ci1+1,-1)) i = Ci1+1; + else if (!num_cmp_int(t+Ci1,-1) && !num_cmp_int(t+Ci1+1, 1)) i = Ci1; + else goto end0; + + if (!num_cmp_int(t+Ci2, 1) && !num_cmp_int(t+Ci2+1,-1)) j = Ci1+1; + else if (!num_cmp_int(t+Ci2,-1) && !num_cmp_int(t+Ci2+1, 1)) j = Ci1; + else goto end0; + + num_div_by_2(&ka,&Cb); + num_min(r->c+matpos2(j^1,i),r->c+matpos2(j^1,i),&kb); + changed = 1; + break; + } + + if (changed) r->state = OCT_NORMAL; + + end0: + num_clear_n(buf,n2); oct_mm_free (buf); + num_clear(&Cb); + num_clear(&ka); num_clear(&kb); num_clear(&kc); num_clear(&kd); + } + + end: + num_clear(&tmp); + OCT_EXIT("oct_interv_add_constraint",46); + return r; +} + + +/* as oct_substitute_variable, but with interval instead of constant coefs + e -> [-t[1];t[0]]v0 + ... + [-t[2N-1];t[2N-2]v(N-1)] + [-t[2N+1;t[2N]] + + NOTE: the general case is not yet implemented... +*/ +oct_t* +OCT_PROTO(interv_substitute_variable) (oct_t* m, + var_t x, + const num_t* t, + bool destructive) +{ + oct_t* r; + var_t i, y, N = 0; + const var_t n = m->n; + const var_t n2 = n*2; + const var_t x2 = 2*x; + const num_t* c = t+n2; + num_t tmp; + + OCT_ENTER("oct_interv_substitute_variable",47); + OCT_ASSERT(xn,"variable index greater than the number of variables in oct_interv_substitute_variable"); + + num_init(&tmp); + + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + + for (i=0;in); + if (destructive) oct_free(m); + goto end; + } + if (num_cmp_zero(t+2*i) || num_cmp_zero(t+2*i+1)) { y=i; N++; } + } + + num_add(&tmp,c,c+1); + if (num_cmp_zero(&tmp)<0) { + r = oct_empty(m->n); + if (destructive) oct_free(m); + goto end; + } + + if (N==0) { /* x -> [-d,c] */ + oct_t* mm; + num_t w1,w2; + mm = oct_close (m,destructive,false); + num_init(&w1); num_init(&w2); + /* result is empty */ + if (mm->state==OCT_EMPTY) { r = mm; goto end0; } + num_mul_by_2(&w1,c); num_neg(&w1,&w1); + num_mul_by_2(&w2,c+1); num_neg(&w2,&w2); + if (num_cmp(mm->c+matpos(x2+1,x2),&w2)<0 || + num_cmp(mm->c+matpos(x2,x2+1),&w1)<0) + { r = oct_empty(mm->n); oct_free(mm); goto end0; } + /* result is computed in mm, or in a new octagon */ + if (mm->ref==1) r = mm; + else { r = oct_full_copy(mm); mm->ref--; } + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* change the result matrix */ + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_t* ii = r->c+matpos(i^1,i); + num_add(&w1,xi,c); + num_add(&w2,ix,c+1); + num_min(&w1,&w1,&w2); + num_mul_by_2(&w1,&w1); + num_min(ii,ii,&w1); + num_set_infty(xi); + num_set_infty(ix); + } + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_t* ii = r->c+matpos(i,i^1); + num_add(&w1,xi,c); + num_add(&w2,ix,c+1); + num_min(&w1,&w1,&w2); + num_mul_by_2(&w1,&w1); + num_min(ii,ii,&w1); + num_set_infty(xi); + num_set_infty(ix); + } + num_set_infty(r->c+matpos(x2,x2+1)); + num_set_infty(r->c+matpos(x2+1,x2)); + end0: + num_clear(&w1); num_clear(&w2); + } + + else if (N==1 && + (!num_cmp_int(t+2*y, 1) && !num_cmp_int(t+2*y+1,-1) || + !num_cmp_int(t+2*y,-1) && !num_cmp_int(t+2*y+1, 1))) { + if (y!=x) { /* x -> +/- y + [-d,c], x!=y */ + var_t yy, yy1; + oct_t* mm; + num_t w,ww; + num_init(&w); num_init(&ww); + mm = oct_close (m,destructive,false); + if (!num_cmp_int(t+2*y,-1)) yy = 2*y+1; else yy = 2*y; + yy1 = yy^1; + /* result is empty */ + if (mm->state==OCT_EMPTY) { r = mm; goto end1; } + num_neg(&w, c); + num_neg(&ww,c+1); + if (num_cmp(&ww ,mm->c+matpos2(yy,x2))>0 || + num_cmp(&w, mm->c+matpos2(x2,yy))>0) + { r = oct_empty(mm->n); oct_free(mm); goto end1; } + /* result is computed in mm, or in a new octagon */ + if (mm->ref==1) r = mm; + else { r = oct_full_copy(mm); mm->ref--; } + /* change the result matrix */ + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_t* yi = r->c+matpos2(yy ,i); + num_t* iy = r->c+matpos2(yy1,i); + num_add(xi,xi,c ); num_min(yi,yi,xi); num_set_infty(xi); + num_add(ix,ix,c+1); num_min(iy,iy,ix); num_set_infty(ix); + } + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_t* yi = r->c+matpos2(i,yy1); + num_t* iy = r->c+matpos2(i,yy ); + num_add(xi,xi,c ); num_min(yi,yi,xi); num_set_infty(xi); + num_add(ix,ix,c+1); num_min(iy,iy,ix); num_set_infty(ix); + } + { + num_t* xi = r->c+matpos(x2 ,x2+1); + num_t* ix = r->c+matpos(x2+1,x2 ); + num_t* yi = r->c+matpos2(yy ,yy1); + num_t* iy = r->c+matpos2(yy1,yy ); + num_mul_by_2(&w,c); + num_mul_by_2(&ww,c+1); + num_add(xi,xi,&w ); num_min(yi,yi,xi); num_set_infty(xi); + num_add(ix,ix,&ww); num_min(iy,iy,ix); num_set_infty(ix); + } + oct_close_incremental(r,x); + end1: + num_clear(&w); num_clear(&ww); + } + else { + /* x -> x + [-d,c] is equivalent to x <- x - [-d,c] + x -> -x + [-d,c] is equivalent to x <- -x + [-d,c] + they respect closure + */ + + /* result is computed in m, or in a new octagon */ + m = oct_close_lazy(m,destructive); + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + /* modify the result matrix */ + if (!num_cmp_int(t+2*x,-1)) { /* x <- -x + [-d,c] */ + num_t w,vv,ww; + num_init(&w); num_init(&vv); num_init(&ww); + num_mul_by_2(&vv,c); num_mul_by_2(&ww,c+1); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_set(&w,xi); + num_add(xi,ix,c+1); + num_add(ix,&w,c); + } + num_set(&w,r->c+matpos(x2,x2+1)); + num_add(r->c+matpos(x2,x2+1),r->c+matpos(x2+1,x2),&ww); + num_add(r->c+matpos(x2+1,x2),&w ,&vv); + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_set(&w,xi); + num_add(xi,ix,c+1); + num_add(ix,&w,c); + } + num_clear(&w); num_clear(&vv); num_clear(&ww); + } + else { /* x <- x - [-d,c] */ + num_t vv,ww; + num_init(&vv); num_init(&ww); + num_mul_by_2(&vv,c); num_mul_by_2(&ww,c+1); + for (i=0;ic+matpos(x2 ,i); + num_t* ix = r->c+matpos(x2+1,i); + num_add(xi,xi,c); + num_add(ix,ix,c+1); + } + num_add(r->c+matpos(x2+1,x2),r->c+matpos(x2+1,x2),&ww); + num_add(r->c+matpos(x2,x2+1),r->c+matpos(x2,x2+1),&vv); + for (i=x2+2;ic+matpos(i,x2+1); + num_t* ix = r->c+matpos(i,x2 ); + num_add(xi,xi,c); + num_add(ix,ix,c+1); + } + num_clear(&vv); num_clear(&ww); + } + + } + + } + else { /* general case */ + r = oct_forget (m, x, destructive); + /* not yet implemented */ + } + + end: + num_clear(&tmp); + OCT_EXIT("oct_interv_substitute_variable",47); + return r; +} + + +/* Modify all variables of the octagon simultaneously by the formula + r_i <- r_i + [nmin,nmax] * [-tab[2*i+1],tab[2*i]] + This simulates time flow. + The amout of time t is in [nmin,nmax], and each variable Vi has a change + rate in [-tab[2*i+1],tab[2*i]]. + We must have 0 <= nmin <= nmax. + This function has a O(n^2) complexity. + Original code by Damien Masse. +*/ +oct_t* +OCT_PROTO(time_flow) (oct_t* m, + const num_t *nmin, const num_t *nmax, const num_t *tab, + bool destructive) +{ + var_t i,j; + const var_t n2 = m->n*2; + int a; + num_t tmp, *c; + oct_t* r; + OCT_ENTER("oct_time_flow",56); + OCT_ASSERT((num_cmp_zero(nmin)>=0) && (num_cmp(nmax,nmin)>=0), + "incorrect range in oct_time_flow"); + /* m empty => return m */ + if (oct_is_empty_lazy(m)==tbool_true) { + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + } + /* result is computed in m, or in a new octagon */ + if (destructive) { + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + } + else r = oct_full_copy(m); + + /* change the result matrix */ + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + + num_init(&tmp); + c = r->c; + /* we take each constraint once */ + for (i=0;i0 ? nmax : nmin)); + num_add(c,c,&tmp); + } + } + num_clear(&tmp); + end: + OCT_EXIT("oct_time_flow",56); + return r; +} + + + +/***********************/ +/* Change of Dimension */ +/***********************/ + +/* add dimsup variables at the end + there is no constraints added on the variables: the domain is extruded + O(dimsup^2) time cost (plus optionnal copy) +*/ +oct_t* +OCT_PROTO(add_dimensions_and_embed) (oct_t* m, + var_t dimsup, + bool destructive) +{ + oct_t* r; + const size_t n1=matsize(m->n), n2=matsize(m->n+dimsup); + OCT_ENTER("oct_add_dimensions_and_embed",30); + if (destructive) { + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + } + else r = oct_full_copy(m); + + if (r->state!=OCT_EMPTY) { + size_t i; + r->c = renew_n(r->c,num_t,n2); + for (i=n1;ic+i); + for (i=r->n;i<2*(r->n+dimsup);i++) num_set_int(r->c+matpos(i,i),0); + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + } + r->n += dimsup; + OCT_EXIT("oct_add_dimensions_and_embed",30); + return r; +} + +/* add dimsup variables at the end + added variables are initialy constrained to be 0 + O(dimsup^2) time cost (plus optionnal copy) +*/ +oct_t* +OCT_PROTO(add_dimensions_and_project) (oct_t* m, + var_t dimsup, + bool destructive) +{ + const var_t n0 = m->n; + var_t i; + oct_t* r; + OCT_ENTER("oct_add_dimensions_and_project",31); + r = oct_add_dimensions_and_embed(m,dimsup,destructive); + if (r->state!=OCT_EMPTY) { + for (i=n0;in;i++) { + num_set_int(r->c+matpos(2*i+1,2*i),0); + num_set_int(r->c+matpos(2*i,2*i+1),0); + } + r->state = OCT_NORMAL; + } + OCT_EXIT("oct_add_dimensions_and_project",31); + return r; +} + +/* remove the dimsup last variables + O(n^3) cost for closure +*/ +oct_t* +OCT_PROTO(remove_dimensions) (oct_t* m, + var_t diminf, + bool destructive) +{ + oct_t* mm; + oct_t* r; + const size_t n1=matsize(m->n), n2=matsize(m->n-diminf); + OCT_ENTER("oct_remove_dimensions",32); + OCT_ASSERT(m->n>=diminf,"removing too many dimensions in oct_remove_dimensions"); + mm = oct_close(m, destructive, true); + if (mm->ref==1) r = mm; + else { r = oct_full_copy(mm); mm->ref--; } + + if (r->state!=OCT_EMPTY) { + num_clear_n(r->c+n2,n1-n2); + r->c = renew_n(r->c,num_t,n2); + } + r->n -= diminf; + OCT_EXIT("oct_remove_dimensions",32); + return r; +} + + +/* add variables, not necessarily at the end + there is no constraints added on the variables: the domain is extruded + O(newsize^2) time cost + copies elements by bunch for improved efficiency + always returns a new octagon +*/ +oct_t* +OCT_PROTO(add_dimensions_and_embed_multi) (oct_t* m, + const dimsup_t* tab, + size_t size_tab, + bool destructive) +{ + size_t i,j,org_j,new_j; + size_t new_n; + oct_t* r; + OCT_ENTER("oct_add_dimensions_and_embed_multi",53); + new_n = m->n; + for (i=0;i=tab[i-1].pos) && + tab[i].pos<=m->n, + "invalid dimension array in oct_add_dimensions_and_embed_multi"); + new_n += tab[i].nbdims; + } + if (m->state==OCT_EMPTY) r = oct_empty(new_n); + else { + r = oct_universe(new_n); + r->state = m->state; + + /* copy first lines */ + new_j = org_j = tab[0].pos*2; + num_set_n(r->c,m->c,matsize(tab[0].pos)); + + for (j=0;jc + matsize(org_j/2); + num_t* new_c = r->c + matsize(new_j/2); + size_t last_org_j = ((jn)*2; + for (;org_j=size_org_line) break; /* partial block */ + num_set_n(new_c+new_i,org_c+org_i,last_org_i-org_i); + new_i += last_org_i-org_i; + org_i = last_org_i; + + /* skip elems */ + new_i += tab[i].nbdims*2; + } + + /* copy remaining elems */ + num_set_n(new_c+new_i,org_c+org_i,size_org_line-org_i); + + /* next line */ + org_c += size_org_line; + new_c += size_new_line; + } + } + } + } + if (destructive) oct_free(m); + OCT_EXIT("oct_add_dimensions_and_embed_multi",53); + return r; +} + + +/* (always returns a new octagon) */ +oct_t* +OCT_PROTO(add_dimensions_and_project_multi) (oct_t* m, + const dimsup_t* tab, + size_t size_tab, + bool destructive) +{ + oct_t* r; + OCT_ENTER("oct_add_dimensions_and_project_multi",54); + r = oct_add_dimensions_and_embed_multi(m,tab,size_tab,destructive); + if (r->state!=OCT_EMPTY) { + size_t i,ii; + size_t accum = 0; + /* modify r in-place */ + for (i=0;ic+matpos(v+1,v),0); + num_set_int(r->c+matpos(v,v+1),0); + } + r->state = OCT_NORMAL; + } + OCT_EXIT("oct_add_dimensions_and_project_multi",54); + return r; +} + +/* (always returns a new octagon) */ +oct_t* +OCT_PROTO(remove_dimensions_multi) (oct_t* m, + const dimsup_t* tab, + size_t size_tab, + bool destructive) +{ + oct_t* r; + size_t i,j,org_j,new_j; + size_t new_n; + OCT_ENTER("oct_remove_dimensions_multi",55); + new_n = m->n; + for (i=0;i=tab[i-1].pos+tab[i-1].nbdims) && + tab[i].pos+tab[i].nbdims<=m->n, + "invalid dimension array in oct_remove_dimensions_multi"); + new_n -= tab[i].nbdims; + } + m = oct_close(m,destructive,true); + if (m->state==OCT_EMPTY) r = oct_empty(new_n); + else { + r = oct_alloc(new_n); + r->state = OCT_CLOSED; + + /* copy first lines */ + new_j = org_j = tab[0].pos*2; + num_set_n(r->c,m->c,matsize(tab[0].pos)); + + for (j=0;jc + matsize(org_j/2); + num_t* new_c = r->c + matsize(new_j/2); + size_t last_org_j = ((jn)*2; + for (;org_j=size_org_line) break; /* partial block */ + num_set_n(new_c+new_i,org_c+org_i,last_org_i-org_i); + new_i += last_org_i-org_i; + org_i = last_org_i; + + /* skip elems */ + org_i += tab[i].nbdims*2; + } + + /* copy remaining elems */ + if (size_org_line>org_i) + num_set_n(new_c+new_i,org_c+org_i,size_org_line-org_i); + + /* next line */ + org_c += size_org_line; + new_c += size_new_line; + } + } + } + } + oct_free(m); + OCT_EXIT("oct_remove_dimensions_multi",55); + return r; +} + + +/* add variables at the end, then apply permutation + O(newsize^2) time cost + in practice, less efficient than add_dimensions_and_embed and + add_dimensions_and_embed_multi + (always returns a new octagon) +*/ +oct_t* +OCT_PROTO(add_permute_dimensions_and_embed) (oct_t* m, + var_t dimsup, + const var_t* permutation, + bool destructive) +{ + const var_t old_n = m->n; + const var_t new_n = old_n+dimsup; + oct_t* r; + OCT_ENTER("oct_add_permute_dimensions_and_embed",57); + if (m->state==OCT_EMPTY) r = oct_empty(new_n); + else { + var_t i,j; + num_t* n = m->c; + for (i=0;istate = m->state; + for (i=0;ic+matpos2(new_ii,new_jj),n); + num_set(r->c+matpos2(new_ii,new_jj+1),n+1); + num_set(r->c+matpos2(new_ii+1,new_jj),n+2*(i+1)); + num_set(r->c+matpos2(new_ii+1,new_jj+1),n+2*(i+1)+1); + } + n+=2*(i+1); + } + } + if (destructive) oct_free(m); + OCT_EXIT("oct_add_permute_dimensions_and_embed",57); + return r; +} + +oct_t* +OCT_PROTO(add_permute_dimensions_and_project) (oct_t* m, + var_t dimsup, + const var_t* permutation, + bool destructive) +{ + const var_t old_n = m->n; + const var_t new_n = old_n+dimsup; + oct_t* r; + OCT_ENTER("oct_add_permute_dimensions_and_project",58); + if (m->state==OCT_EMPTY) r = oct_empty(new_n); + else { + var_t i,j; + num_t* n = m->c; + for (i=0;istate = OCT_NORMAL; + for (i=0;ic+matpos2(new_ii,new_jj),n); + num_set(r->c+matpos2(new_ii,new_jj+1),n+1); + num_set(r->c+matpos2(new_ii+1,new_jj),n+2*(i+1)); + num_set(r->c+matpos2(new_ii+1,new_jj+1),n+2*(i+1)+1); + } + n+=2*(i+1); + } + for (i=old_n;ic+matpos(new_ii+1,new_ii),0); + num_set_int(r->c+matpos(new_ii,new_ii+1),0); + } + } + if (destructive) oct_free(m); + OCT_EXIT("oct_add_permute_dimensions_and_project",58); + return r; +} + +/* permute, then remove dimensions */ +oct_t* +OCT_PROTO(permute_remove_dimensions) (oct_t* m, + var_t diminf, + const var_t* permutation, + bool destructive) +{ + const var_t old_n = m->n; + const var_t new_n = old_n-diminf; + const var_t new_n2 = new_n*2; + oct_t* r; + OCT_ENTER("oct_remove_permute_dimensions",59); + m = oct_close(m,destructive,true); + if (m->state==OCT_EMPTY) r = oct_empty(new_n); + else { + var_t i,j; + num_t* n = m->c; + for (i=0;istate = m->state; + for (i=0;ic+matpos2(new_ii,new_jj),n); + num_set(r->c+matpos2(new_ii,new_jj+1),n+1); + num_set(r->c+matpos2(new_ii+1,new_jj),n+2*(i+1)); + num_set(r->c+matpos2(new_ii+1,new_jj+1),n+2*(i+1)+1); + } + } + n+=2*(i+1); + } + else n+=4*(i+1); + } + } + oct_free(m); + OCT_EXIT("oct_remove_permute_dimensions",59); + return r; +} + +/**************************/ +/* Interval Manipulations */ +/**************************/ + +/* get bounds for all variables in a fresh array r + -r[2i+1] <= v_i <= r[2i] + O(n) time cost +*/ +num_t* +OCT_PROTO(get_box) (oct_t* m) +{ + num_t* t; + oct_t* mm; + num_t* r = (num_t*)NULL; + OCT_ENTER("oct_get_box",33); + mm = oct_close(m, false, true); + if (mm->state!=OCT_EMPTY) { + var_t i; + r = new_n(num_t,m->n*2); + num_init_n(r,m->n*2); + for (i=0;in;i++) { + num_div_by_2(r+2*i ,mm->c+matpos(2*i+1,2*i)); /* ( xi+xi)/2 */ + num_div_by_2(r+2*i+1,mm->c+matpos(2*i,2*i+1)); /* (-xi-xi)/2 */ + } + } + oct_free (mm); + OCT_EXIT("oct_get_box",33); + return r; +} + +/* get bounds for only one variable + - *down <= v_k <= *up + O(n) time cost +*/ +void +OCT_PROTO(get_bounds) (oct_t* m, + const var_t k, + num_t* up, + num_t* down) +{ + oct_t* mm; + OCT_ENTER("oct_get_bounds",34); + OCT_ASSERT(kn,"variable index greater than the number of variables in oct_get_bounds"); + mm = oct_close(m, false, true); + if (mm->state!=OCT_EMPTY) { + num_div_by_2(up ,mm->c+matpos(2*k+1,2*k)); /* ( xk+xk)/2 */ + num_div_by_2(down,mm->c+matpos(2*k,2*k+1)); /* (-xk-xk)/2 */ + } + oct_free (mm); + OCT_EXIT("oct_get_bounds",34); +} + +/* set bounds for one variable: + - down <= v_k <= up + O(n) time cost + */ +oct_t* +OCT_PROTO(set_bounds) (oct_t* m, + const var_t k, + const num_t* up, + const num_t* down, + bool destructive) +{ + oct_t* mm; + num_t tmp; + const var_t k2 = k*2; + OCT_ENTER("oct_set_bounds",35); + OCT_ASSERT(kn,"variable index greater than the number of variables in oct_set_bounds"); + num_init(&tmp); + + num_add(&tmp,up,down); + if (num_cmp_zero(&tmp)<0) { + mm = oct_empty(m->n); + if (destructive) oct_free(m); + goto end; + } + + mm = oct_forget(m, k, destructive); + if (mm->state!=OCT_EMPTY) { + var_t i; + const var_t n2 = mm->n*2; + + num_mul_by_2(mm->c+matpos(k2+1,k2),up); /* ( xk+xk)/2 */ + num_mul_by_2(mm->c+matpos(k2,k2+1),down); /* (-xk-xk)/2 */ + + /* enforce closure */ + for (i=0;ic+matpos(i^1,i)); /* (xi+xi)/2 */ + num_add(mm->c+matpos(k2 ,i),&tmp,down); /* xi-xk */ + num_add(mm->c+matpos(k2+1,i),&tmp,up); /* xi+xk */ + } + for (i=k2+2;ic+matpos(i,i^1)); /* (xi+xi)/2 */ + num_add(mm->c+matpos(i,k2+1),&tmp,down); /* xi-xk */ + num_add(mm->c+matpos(i,k2 ),&tmp,up); /* xi+xk */ + } + } + + end: + num_clear(&tmp); + OCT_EXIT("oct_set_bounds",35); + return mm; +} + +/* create an octagon from a list of bounds b + -b[2i+1] <= v_i <= b[2i] + O(n) time cost + */ +oct_t* +OCT_PROTO(from_box) (const var_t n, + const num_t* b) +{ + oct_t* m; + var_t i; + num_t tmp; + OCT_ENTER("oct_from_box",36); + + num_init(&tmp); + + m = oct_universe (n); + for (i=0;ic+matpos(2*i+1,2*i),b+2*i ); /* ( xi+xi)/2 */ + num_mul_by_2(m->c+matpos(2*i,2*i+1),b+2*i+1); /* (-xi-xi)/2 */ + } + m->state = OCT_NORMAL; + + end: + num_clear(&tmp); + OCT_EXIT("oct_from_box",36); + return m; +} + + +/****************/ +/* Perturbation */ +/****************/ + +/* return an octagon where each contraint coefficient a is enlarged + by epsilon |a| (thus resulting in a slightly bigger octagon) + normal form is lost + O(n^2) time cost +*/ +oct_t* +OCT_PROTO(add_epsilon) (oct_t* m, + const num_t* epsilon, + bool destructive) +{ + oct_t* r; + size_t i; + num_t* a; + num_t aa; + const size_t n = matsize(m->n); + OCT_ENTER("oct_add_epsilon",50); + /* m empty => return m */ + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + /* result is computed in m, or in a new octagon */ + if (destructive) { + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + } + else r = oct_full_copy(m); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + num_init(&aa); + for (i=0,a=r->c;i=0) { + num_mul(&aa,a,epsilon); + num_add(a,a,&aa); + } + else { + num_neg(&aa,a); + num_mul(&aa,&aa,epsilon); + num_add(a,a,&aa); + } + num_clear(&aa); + end: + OCT_EXIT("oct_add_epsilon",50); + return r; +} + +/* return an octagon where each contraint coefficient is enlarged + by (epsilon * max { |m| | x_i-x_j <= m, m!=+oo }) + (thus resulting in a slightly bigger octagon) + normal form is lost + O(n^2) time cost +*/ +oct_t* +OCT_PROTO(add_epsilon_max) (oct_t* m, + const num_t* epsilon, + bool destructive) +{ + oct_t* r; + size_t i; + num_t* a; + num_t abs,max; + const size_t n = matsize(m->n); + OCT_ENTER("oct_add_epsilon_max",51); + /* m empty => return m */ + if (oct_is_empty_lazy(m)==tbool_true) + if (destructive) { r = m; goto end; } + else { r = oct_copy(m); goto end; } + /* result is computed in m, or in a new octagon */ + if (destructive) { + if (m->ref==1) r = m; + else { r = oct_full_copy(m); m->ref--; } + } + else r = oct_full_copy(m); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + num_init_set_infty(&max); num_init(&abs); + /* get abs of first non +oo coef */ + for (i=0,a=r->c;ic;in); + OCT_ASSERT(ma->n==mb->n,"oct_add_epsilon_bin must be called with two octagons of the same dimension."); + OCT_ENTER("oct_add_epsilon_bin",52); + /* ma empty => return mb */ + if (oct_is_empty_lazy(ma)==tbool_true) + if (destructive) { r = mb; goto end; } + else { r = oct_copy(mb); goto end; } + /* mb empty => return ma */ + if (oct_is_empty_lazy(mb)==tbool_true) + if (destructive) { r = ma; goto end; } + else { r = oct_copy(ma); goto end; } + /* result is computed in ma, mb, or in a new octagon */ + if (destructive) { + if (ma->ref==1) r = ma; + else if (mb->ref==1) r = mb; + else r = oct_alloc(ma->n); + } + else r = oct_alloc(ma->n); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + num_init_set_infty(&max); num_init(&abs); + /* get abs of first non +oo coef */ + for (i=0,b=mb->c;ic,b=mb->c,c=r->c;istate==OCT_EMPTY) { printf("[ empty ]\n"); OCT_EXIT("oct_print",37); return; } + printf("["); + if (m->state==OCT_CLOSED) printf(" (closed)"); + for (i=0;in;i++) { + if (num_cmp_zero(m->c+matpos(2*i,2*i))) { + printf("\n v%02i-v%02i <= ",i,i); + num_print(m->c+matpos(2*i,2*i)); + } + if (num_cmp_zero(m->c+matpos(2*i+1,2*i+1))) { + printf("\n -v%02i+v%02i <= ",i,i); + num_print(m->c+matpos(2*i+1,2*i+1)); + } + if (!num_infty(m->c+matpos(2*i+1,2*i))) { + printf("\n v%02i <= ",i); + num_div_by_2(&w,m->c+matpos(2*i+1,2*i)); + num_print(&w); + } + if (!num_infty(m->c+matpos(2*i,2*i+1))) { + printf("\n -v%02i <= ",i); + num_div_by_2(&w,m->c+matpos(2*i,2*i+1)); + num_print(&w); + } + } + + for (i=0;in;i++) + for (j=i+1;jn;j++) { + if (!num_infty(m->c+matpos(2*j,2*i))) { + printf("\n v%02i-v%02i <= ",i,j); + num_print(m->c+matpos(2*j,2*i)); + } + if (!num_infty(m->c+matpos(2*j,2*i+1))) { + printf("\n -v%02i-v%02i <= ",i,j); + num_print(m->c+matpos(2*j,2*i+1)); + } + if (!num_infty(m->c+matpos(2*j+1,2*i))) { + printf("\n v%02i+v%02i <= ",i,j); + num_print(m->c+matpos(2*j+1,2*i)); + } + if (!num_infty(m->c+matpos(2*j+1,2*i+1))) { + printf("\n v%02i-v%02i <= ",j,i); + num_print(m->c+matpos(2*j+1,2*i+1)); + } + + } + printf(" ]\n"); + num_clear(&w); + OCT_EXIT("oct_print",37); +} + + +/* usefull to debug the strong closure algorithm + O(n^3) time cost, not optimized at all + */ +bool +OCT_PROTO(check_closed) (const oct_t* m, + bool quiet) +{ + bool r = true; + var_t i,j,k; + const var_t n = m->n; + num_t w; + OCT_ENTER("oct_check_closed",38); + num_init(&w); + if (m->state==OCT_EMPTY) { + if (!quiet) printf("Empty\n"); + } + else { + for (i=0;i<2*n;i++) + for (j=0;j<2*n;j++) + for (k=0;k<2*n;k++) { + num_add(&w,m->c+matpos2(i,k),m->c+matpos2(k,j)); + if (num_cmp(m->c+matpos2(i,j),&w)>0) { + if (!quiet) { + printf("Bueargh #1 %i-%i-%i ",i,j,k); + num_print(m->c+matpos2(i,j)); + printf(" > "); + num_print(m->c+matpos2(i,k)); + printf("+"); + num_print(m->c+matpos2(k,j)); + printf("\n"); + } + r = false; goto end; + } + } + + for (i=0;i<2*n;i++) + for (j=0;j<2*n;j++) + if (num_cmp(m->c+matpos2(i,j), m->c+matpos2(j^1,i^1))>0) { + if (!quiet) { + printf("Bueargh #2 %i-%i ",i,j); + num_print(m->c+matpos2(i,j)); + printf(" != "); + num_print(m->c+matpos2(j^1,i^1)); + printf("\n"); + } + r = false; goto end; + } + + for (i=0;i<2*n;i++) + for (j=0;j<2*n;j++) { + num_add(&w,m->c+matpos2(i,i^1),m->c+matpos2(j^1,j)); + num_div_by_2(&w,&w); + if (num_cmp(m->c+matpos2(i,j),&w)>0) { + if (!quiet) { + printf("Bueargh #3 %i-%i ",i,j); + num_print(m->c+matpos2(i,j)); + printf(" > ("); + num_print(m->c+matpos2(i,i^1)); + printf("+"); + num_print(m->c+matpos2(j^1,j)); + printf(")/2\n"); + } + r = false; goto end; + } + } + } + if (!quiet) printf("OK\n"); + end: + num_clear(&w); + OCT_EXIT("oct_check_closed",38); + return r; +} + + +/****************/ +/* Minimal form */ +/****************/ + +moct_t* +OCT_PROTO(m_empty) (var_t n) +{ + moct_t* a; + OCT_ENTER("oct_m_empty",39); + a = new_t(moct_t); + a->n = n; + a->bol = (size_t*)NULL; + a->col = (var_t*)NULL; + a->data = (num_t*)NULL; + OCT_EXIT("oct_m_empty",39); + return a; +} + +moct_t* +OCT_PROTO(m_from_oct) (oct_t* m) +{ + moct_t* a; + oct_t* cm; + OCT_ENTER("oct_m_from_oct",40); + a = oct_m_empty (m->n); + cm = oct_close (m,false,false); + if (cm->state!=OCT_EMPTY) { + const var_t n2 = m->n*2; + var_t* rep = new_n(var_t,n2); + var_t* next = new_n(var_t,n2); + var_t* first = new_n(var_t,n2); + var_t i,j,k,nb; + size_t n; + num_t c1,c2; + /* compute equivalence classes xi<->xj iff m[i][j]+m[j][i]=0 + next[i] is the smallest index j>i such that xi<->xj (or -1 at the end) + first[i] is the smallest index j such that xi<->xj + rep[i] is the last index in the ith equivalence class + */ + /* maybee we could use union-find instead here ? */ + num_init(&c1); num_init(&c2); + nb = 0; + for (i=0;ic+matpos(i,rep[j]),cm->c+matpos(i^1,rep[j]^1)); + if (!num_cmp_zero(&c1)) { + first[i] = first[rep[j]]; + next[rep[j]] = i; + rep[j] = i; + goto notnew; + } + } + rep[nb++] = i; + first[i] = i; + notnew: + next[i] = 0; + } + /* make rep monotonic: rep[i]bol = new_n(size_t,n2+1); + a->col = new_n(var_t,matsize(cm->n)); + a->data = new_n(num_t,matsize(cm->n)); + n = 0; + for (i=0;ibol[i] = n; + if (next[i]) { + a->col[n] = next[i]; + num_init_set(a->data+n,cm->c+matpos(next[i]^1,i^1)); + n++; + } + else { + const var_t ii = i|1; + num_div_by_2(&c1,cm->c+matpos(i,i^1)); + for (j=0;j<=ii;j++) { + if (j!=i && (j==first[i] || !next[j])) { + const num_t* cij = cm->c+matpos(i,j); + if (num_infty(cij)) goto redund; + if (j==first[i]) goto noredund; + num_div_by_2(&c2,cm->c+matpos(j^1,j)); + num_add(&c2,&c1,&c2); + if ((i^1)!=j && !num_cmp(cij,&c2) && + first[i]!=first[i^1] && first[j]!=first[j^1]) goto redund; + for (k=0;kc+matpos2(i,kk),cm->c+matpos2(kk,j)); + if (!num_cmp(cij,&c2)) goto redund; + } + } + noredund: + a->col[n] = j; + num_init_set(a->data+n,cij); + n++; + redund:; + } + } + } + } + a->bol[i] = n; + oct_mm_free(rep); oct_mm_free(next); oct_mm_free(first); + num_clear(&c1); num_clear(&c2); + a->col = renew_n(a->col,var_t,n+1); + /* we alloc 1 to size to be sure that a->data is not NULL */ + a->data = renew_n(a->data,num_t,n+1); + } + oct_free (cm); + OCT_EXIT("oct_m_from_oct",40); + return a; +} + + +oct_t* +OCT_PROTO(m_to_oct) (moct_t* a) +{ + oct_t* r; + var_t i; + size_t n; + const var_t n2 = a->n*2; + OCT_ENTER("oct_m_to_oct",41); + if (!a->col) { r = oct_empty (a->n); goto end; } + r = oct_universe (a->n); + for (n=0,i=0;ibol[i+1];n++) + if (!num_infty(a->data+n)) + num_set(r->c+matpos2(i,a->col[n]),a->data+n); + r->state = OCT_NORMAL; + if (r->closed) { oct_free(r->closed); r->closed = (oct_t*)NULL; } + end: + OCT_EXIT("oct_m_to_oct",41); + return r; +} + +void +OCT_PROTO(m_free) (moct_t* a) +{ + OCT_ENTER("oct_m_free",42); + if (a->data) { num_clear_n(a->data,a->bol[a->n*2]); oct_mm_free (a->data); } + if (a->col) oct_mm_free (a->col); + if (a->bol) oct_mm_free (a->bol); + oct_mm_free (a); + OCT_EXIT("oct_m_free",42); +} + +/* number of variables */ +inline +var_t +OCT_PROTO(m_dimension) (moct_t* m) +{ + return m->n; +} + +bool +OCT_PROTO(m_is_empty) (moct_t* m) +{ + if (m->data) return false; + return true; +} + + +/* print as a constraint list */ +void +OCT_PROTO(m_print) (moct_t* a) +{ + var_t i; + size_t n; + const var_t n2 = a->n*2; + OCT_ENTER("oct_m_print",43); + if (!a->col) printf("[ empty ]\n"); + else { + printf("["); + for (n=0,i=0;ibol[i+1];n++) + if (!num_infty(a->data+n)) { + const var_t j = a->col[n]; + if (i==(j^1)) + if (i&1) + { printf("\n 2v%02i <= ",i/2); num_print(a->data+n); } + else + { printf("\n -2v%02i <= ",i/2); num_print(a->data+n); } + else + if (i&1) + if (j&1) { + printf("\n -v%02i+v%02i <= ",j/2,i/2); + num_print(a->data+n); + } + else { + printf("\n v%02i+v%02i <= ",j/2,i/2); + num_print(a->data+n); + } + else + if (j&1) { + printf("\n -v%02i-v%02i <= ",j/2,i/2); + num_print(a->data+n); + } + else { + printf("\n v%02i-v%02i <= ",j/2,i/2); + num_print(a->data+n); + } + } + printf(" ]\n"); + } + OCT_EXIT("oct_m_print",43); +} + + +/* using binary search on a row: O(log n) time cost */ +num_t* +OCT_PROTO(m_elem) (moct_t* a, + var_t i, + var_t j) +{ + num_t* r; + size_t lo,hi; + OCT_ENTER("oct_m_elem",44); + OCT_ASSERT(a->data,"empty hollow matrix in oct_m_elem"); + OCT_ASSERT(in*2 && jn*2,"invalid index in oct_m_elem"); + if (j>i) { var_t t = i; i = j^1; j = t^1; } + lo = a->bol[i]; + hi = a->bol[i+1]; + while (locol[mid]) { r = a->data+mid; goto end; } + else if (jcol[mid]) hi = mid; else lo = mid+1; + } + r = (num_t*) NULL; + end: + OCT_EXIT("oct_m_elem",44); + return r; +} + + +/* O(n^2) time cost as minimized octagons are also a normal form */ +bool +OCT_PROTO(m_is_equal) (moct_t* ma, + moct_t* mb) +{ + bool r = true; + OCT_ENTER("oct_m_is_equal",45); + OCT_ASSERT(ma->n==mb->n,"oct_m_is_equal must be called with two octagons of the same dimension."); + if (!ma->data && !mb->data) r = true; + else if (!ma->data || !mb->data) r = false; + else { + const var_t n2 = ma->n*2; + const size_t nn = ma->bol[n2]; + size_t i; + for (i=1;i<=n2;i++) + if (ma->bol[i]!=mb->bol[i]) { r = false; goto end; } + for (i=0;icol[i]!=mb->col[i]) { r = false; goto end; } + for (i=0;idata+i,mb->data+i)) { r = false; goto end; } + r = true; + } + end: + OCT_EXIT("oct_m_is_equal",45); + return r; +} + + +/*****************/ +/* Serialization */ +/*****************/ + +/* this only works for a few underlying numerical domains! */ +/* octagon serialized on an architecture with a numerical type may not be + deserialized on another architecture, or with a different numerical type */ + +#ifdef OCT_NUM_SERIALIZE + +void* +OCT_PROTO(serialize) (oct_t* m, size_t* size) +{ + size_t sz = 16, max = 100; + unsigned char* data; + if (m->closed) m=m->closed; + data = new_n(unsigned char,max); + dump32(data,num_serialize_id); + dump32(data+4,m->n); + dump32(data+8,m->state); + if (m->state!=OCT_EMPTY) { + const size_t nn = matsize(m->n); + size_t i; + for (i=0;ic+i); + while (s+sz>=max) { max*=2; data = renew_n(data,unsigned char,max); } + sz += num_serialize(m->c+i,data+sz); + } + } + *size = sz; + return data; +} + +oct_t* +OCT_PROTO(deserialize) (void* d) +{ + unsigned char* data = (unsigned char*)d; + int id; + var_t n; + int state; + size_t pos = 16; + id = undump32(data); + OCT_ASSERT(id==num_serialize_id,"oct_deserialize: incompatible serialized octagon"); + n = undump32(data+4); + state = undump32(data+8); + if (state==OCT_EMPTY) return(oct_empty(n)); + else { + const size_t nn = matsize(n); + size_t i; + oct_t* m = oct_alloc(n); + m->state = state; + for (i=0;ic+i,data+pos); + return(m); + } +} + +void* +OCT_PROTO(m_serialize) (moct_t* m, size_t* size) +{ + size_t sz = 16, max = 100; + unsigned char* data; + data = new_n(unsigned char,max); + dump32(data,num_serialize_id); + dump32(data+4,m->n); + if (!m->bol) { + /* empty */ + dump32(data+8,0); + } + else { + /* non-empty */ + const var_t n2 = m->n*2; + const size_t nn = m->bol[n2]; + size_t i; + dump32(data+8,1); + dump32(data+12,nn); + max += 2*(nn+n2); + data = renew_n(data,unsigned char,max); + for (i=1;i<=n2;i++,sz+=2) dump16(data+sz,m->bol[i]-m->bol[i-1]); + for (i=0;icol[i]); + for (i=0;idata+i); + while (s+sz>=max) { max*=2; data = renew_n(data,unsigned char,max); } + sz += num_serialize(m->data+i,data+sz); + } + } + *size = sz; + return data; +} + +moct_t* +OCT_PROTO(m_deserialize) (void* d) +{ + unsigned char* data = (unsigned char*)d; + int id; + var_t n; + int state; + size_t pos = 16; + id = undump32(data); + OCT_ASSERT(id==num_serialize_id,"oct_m_deserialize: incompatible serialized octagon"); + n = undump32(data+4); + state = undump32(data+8); + if (state) { + const var_t n2 = n*2; + const size_t nn = undump32(data+12); + size_t i; + moct_t* m; + m = new_t(moct_t); + m->n = n; + m->bol = new_n(size_t,n2+1); + m->col = new_n(var_t,nn); + m->data = new_n(num_t,nn); + m->bol[0] = 0; + num_init_n(m->data,nn); + for (i=1;i<=n2;i++,pos+=2) m->bol[i] = m->bol[i-1] + undump16(data+pos); + for (i=0;icol[i] = undump16(data+pos); + for (i=0;idata+i,data+pos); + return m; + } + else return(oct_m_empty(n)); +} + +#else + +void* +OCT_PROTO(serialize) (oct_t* m, size_t* size) +{ + OCT_ASSERT(0,"oct_serialize: serialization not supported for this underlying numerical domain."); +} + +oct_t* +OCT_PROTO(deserialize) (void* data) +{ + OCT_ASSERT(0,"oct_deserialize: serialization not supported for this underlying numerical domain."); +} + +void* +OCT_PROTO(m_serialize) (moct_t* m, size_t* size) +{ + OCT_ASSERT(0,"oct_m_serialize: serialization not supported for this underlying numerical domain."); +} + +moct_t* +OCT_PROTO(m_deserialize) (void* data) +{ + OCT_ASSERT(0,"oct_m_deserialize: serialization not supported for this underlying numerical domain."); +} + + +#endif diff --git a/src/optimizer/oct/mineOct/oct_util.c b/src/optimizer/oct/mineOct/oct_util.c new file mode 100644 index 0000000..8028d0a --- /dev/null +++ b/src/optimizer/oct/mineOct/oct_util.c @@ -0,0 +1,383 @@ +/* oct_util.c + Utilities functions not directly related to the abstract domain. + + This file is part of the Octagon Abstract Domain Library. + Please read the COPYING file packaged in the distribution. + Main web page is: http://www.di.ens.fr/~mine/oct/ + + Copyright (C) Antoine Mine' 2000-2002 + */ + +#include +#include + +#include +#include +#include +#include +#include +#include + +/**********/ +/* Memory */ +/**********/ + + +/* this header is added before each block malloc'ed */ +typedef struct +{ + size_t size; /* size of the block */ + + mmalloc_t* mm; /* who monitor the block */ + int id; /* if id!=mm->id, monitor was reseted */ + + double dummy; /* alignement stuff */ + +} mmheader_t; + + +/* global (default one at the begining */ +static mmalloc_t m_global = { 0,0,0,0,0,0,0 }; +static mmalloc_t* mm_current = &m_global; +static mmalloc_t* mmalloc_global = &m_global; + +#ifdef OCT_ENABLE_MALLOC_MONITORING +void* +OCT_PROTO(mm_malloc) (size_t t) +{ + char* m = (char*)malloc(t+sizeof(mmheader_t)); + mmheader_t* h = (mmheader_t*) m; + if (!m) { fprintf(stderr, "Insufficent memory while attempting to allocate %i bytes in mm_malloc.",t); exit(1); } + mm_current->nb_alloc++; + mm_current->rem += t; + mm_current->tot += t; + if (mm_current->max < mm_current->rem) mm_current->max = mm_current->rem; + h->mm = mm_current; + h->size = t; + h->id = mm_current->id; + return m+sizeof(mmheader_t); +} + +void* +OCT_PROTO(mm_realloc) (void* p, size_t t) +{ + char* m = ((char*)p)-sizeof(mmheader_t); + mmheader_t* h = (mmheader_t*) m; + size_t old_size = h->size; + m = (char*)realloc(m,t+sizeof(mmheader_t)); + h = (mmheader_t*) m; + if (!m) { fprintf(stderr, "Insufficent memory while attempting to reallocate %i bytes in mm_realloc.",t); exit(1); } + if (h->id == h->mm->id) { + h->mm->nb_realloc++; + h->mm->tot += t-old_size; + h->mm->rem += t-old_size; + if (h->mm->max < h->mm->rem) h->mm->max = h->mm->rem; + } + h->size = t; + return m+sizeof(mmheader_t); +} + +void +OCT_PROTO(mm_free) (void* p) +{ + char* m = ((char*)p)-sizeof(mmheader_t); + mmheader_t* h = (mmheader_t*) m; + if (h->id == h->mm->id) { + h->mm->nb_free++; + h->mm->rem -= h->size; + } + free(m); +} +#endif + +mmalloc_t* +OCT_PROTO(mmalloc_new) () +{ + mmalloc_t* mm = new_t(mmalloc_t); + mm->nb_alloc = mm->nb_realloc = mm->nb_free = 0; + mm->rem = mm->max = mm->tot = 0; + mm->id = 0; + return mm; +} + +void +OCT_PROTO(mmalloc_print) (mmalloc_t* mm) +{ +#ifdef OCT_ENABLE_MALLOC_MONITORING + printf("%i allocs, %i frees, %i reallocs\n%lu total memory used\n%lu memory peak\n%lu still allocated\n", + mm->nb_alloc, + mm->nb_free, + mm->nb_realloc, + (unsigned long)mm->tot, + (unsigned long)mm->max, + (unsigned long)mm->rem); +#else + printf("No memory information available; compile with the ENABLE_MALLOC_MONITORING symbol.\n"); +#endif + fflush(stdout); +} + +void +OCT_PROTO(mmalloc_use) (mmalloc_t* mm) +{ + mm_current = mm; +} + +mmalloc_t* +OCT_PROTO(mmalloc_get_current) () +{ + return mm_current; +} + +void +OCT_PROTO(mmalloc_reset) (mmalloc_t* mm) +{ + mm->nb_alloc = mm->nb_realloc = mm->nb_free = 0; + mm->rem = mm->max = mm->tot = 0; + mm->id++; +} + + + +/**********/ +/* Chrono */ +/**********/ + +void +inline +OCT_PROTO(chrono_reset) (chrono_t* c) +{ + c->usec = 0; + c->sec = 0; + c->start = 0; +} + +void +inline +OCT_PROTO(chrono_start) (chrono_t* c) +{ + OCT_ASSERT(!c->start,"oct_chrono_start: chrono already started"); + gettimeofday(&c->begin, NULL); + c->start = 1; +} + +void +inline +OCT_PROTO(chrono_stop) (chrono_t* c) +{ + struct timeval end; + OCT_ASSERT(c->start,"oct_chrono_stop: chrono already stoped"); + c->start = 0; + gettimeofday(&end, NULL); + c->usec += (end.tv_usec - c->begin.tv_usec + 1000000L) % (1000000L); + c->sec += (end.tv_sec - c->begin.tv_sec); + c->sec += (c->usec / 1000000L); + c->usec %= 1000000L; + if (end.tv_usec < c->begin.tv_usec) c->sec--; +} + +void +inline +OCT_PROTO(chrono_get) (chrono_t* c, long* hour, long* min, long* sec, long *usec) +{ + int start; + start = c->start; + if (start) oct_chrono_stop (c); + *usec = c->usec; + *sec = c->sec; + *min = *sec/60; *sec %= 60; + *hour = *min/60; *min %= 60; + if (start) oct_chrono_start (c); +} + + +void +OCT_PROTO(chrono_print) (chrono_t* c) +{ + long hour, min, sec, usec; + oct_chrono_get (c, &hour, &min, &sec, &usec); + if (hour) printf("%lih %02li'", hour, min); + else if (min) printf("%02li' %02li''", min, sec); + else printf("%02li.%03li''", sec, usec/1000); + fflush(stdout); +} + + +/*************/ +/* Profiling */ +/*************/ + +struct timing_tt +{ + char* name; + + int count; /* count number */ + + int rec; /* recursive call checking */ + + chrono_t tcum; /* time elapsed in context and called context */ + chrono_t tself; /* time elapsed in this context, not in called context */ + + struct timing_tt* stack; /* link to calling context */ +}; + +typedef struct timing_tt timing_t; + +static +timing_t* timing_data[128] = { + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL, + NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; + +/* current context */ +static +timing_t* timing_stack = NULL; + +/* keys are supposed to be < 64 and unique given a name */ +void +OCT_PROTO(timing_enter) (const char* name, unsigned key) +{ + timing_t* t; + OCT_ASSERT(keyname = strdup(name); + t->count = 0; + t->rec = 0; + oct_chrono_reset(&(t->tcum)); + oct_chrono_reset(&(t->tself)); + timing_data[key] = t; + } + OCT_ASSERT(!t->rec,"oct_timing_enter: recursive call detected"); + t->count++; + t->rec = 1; + oct_chrono_start(&(t->tcum)); + oct_chrono_start(&(t->tself)); + if (timing_stack) oct_chrono_stop(&(timing_stack->tself)); + t->stack = timing_stack; + timing_stack = t; +} + +void +OCT_PROTO(timing_exit) (const char* name, unsigned key) +{ + timing_t* t; + OCT_ASSERT(keyrec || timing_stack!=t,"oct_timing_exit: exiting an invalid context"); + timing_stack = t->stack; + t->rec = 0; + if (timing_stack) oct_chrono_start(&(timing_stack->tself)); + oct_chrono_stop(&(t->tself)); + oct_chrono_stop(&(t->tcum)); +} + +void +OCT_PROTO(timing_print) (const char* name) +{ +#ifdef OCT_ENABLE_TIMING + int i; + timing_t* t = NULL; + for (i=0;iname,name)) t=timing_data[i]; + if (!t) printf("No timing information for function %s.\n",name); + else { + printf("%-30s called=%9i time=",t->name,t->count); + oct_chrono_print(&(t->tself)); + printf(" (cum="); + oct_chrono_print(&(t->tcum)); + printf(")\n"); + } +#else + printf("No timing information available; compile with the ENABLE_TIMING symbol.\n"); +#endif + fflush(stdout); +} + +void +OCT_PROTO(timing_print_all) () +{ +#ifdef OCT_ENABLE_TIMING + int i; + for (i=0;iname,name)) t=timing_data[i]; + if (t) { + t->count = 0; + oct_chrono_reset(&(t->tcum)); + oct_chrono_reset(&(t->tself)); + if (t->rec) { + oct_chrono_start (&(t->tcum)); + if (timing_stack==t) oct_chrono_start (&(t->tself)); + } + } +} + +void +OCT_PROTO(timing_reset_all) () +{ + int i; + for (i=0;icount = 0; + oct_chrono_reset(&(t->tcum)); + oct_chrono_reset(&(t->tself)); + if (t->rec) { + oct_chrono_start (&(t->tcum)); + if (timing_stack==t) oct_chrono_start (&(t->tself)); + } + } + } +} + +void +OCT_PROTO(timing_clear) () +{ + int i; + for (i=0;irec,"oct_timing_clear: not all contextes where closed"); + free (t->name); + oct_mm_free (t); + } + } +} diff --git a/src/optimizer/oct/nullOct/doctanalysis.ml b/src/optimizer/oct/nullOct/doctanalysis.ml new file mode 100644 index 0000000..3e147e5 --- /dev/null +++ b/src/optimizer/oct/nullOct/doctanalysis.ml @@ -0,0 +1,32 @@ + +open Cil + + +(* + * When ignore_inst returns true, then + * the instruction in question has no + * effects on the abstract state. + * When ignore_call returns true, then + * the instruction only has side-effects + * from the assignment if there is one. + *) +let ignore_inst = ref (fun i -> false) +let ignore_call = ref (fun i -> false) + +let registerIgnoreInst (f : instr -> bool) : unit = + let f' = !ignore_inst in + ignore_inst := (fun i -> (f i) || (f' i)) + +let registerIgnoreCall (f : instr -> bool) : unit = + let f' = !ignore_call in + ignore_call := (fun i -> (f i) || (f' i)) + +let init () = true + +let doOctAnalysis ?(tryReverse:bool=false) + (fd:fundec) + (fdat : Dprecfinder.functionData) : unit = () + +let real = false + +let reportStats() = () diff --git a/src/optimizer/ptranal/cilPtrAnal/dptranal.ml b/src/optimizer/ptranal/cilPtrAnal/dptranal.ml new file mode 100644 index 0000000..44de136 --- /dev/null +++ b/src/optimizer/ptranal/cilPtrAnal/dptranal.ml @@ -0,0 +1,198 @@ +(* + * dptranal.ml + * + * This file contains functions that Deputy can use to + * make queries about aliasing relationships, and some utility + * functions for using aliasing/mod-ref analysis results in + * dataflow analysis. + * + *) + + +open Cil +open Pretty +open Doptions + +module E = Errormsg +module IH = Inthash +module S = Stats + +module P = Ptranal +module DPF = Dprecfinder + +(* Basic functions for making queries about aliasing *) + +let debug = ref false + +let may_alias (e1 : exp) (e2 : exp) : bool = + if !doPtrAnalysis then + try P.may_alias e1 e2 + (* If the pointer analysis doesn't know anything about one of the + * expressions, then return true for soundess *) + with + | P.UnknownLocation + | Not_found -> true + else true + +let try_resolve_lval (lv : lval) : varinfo list option = + if !doPtrAnalysis then + try Some(P.resolve_lval lv) + with Not_found -> begin + ignore(E.log "DPtrAnal: Couldn't resolve lval: %a.\n" d_lval lv); + None + end + else None + +let try_resolve_exp (e : exp) : varinfo list option = + if !doPtrAnalysis then + try Some(P.resolve_exp e) + with Not_found -> begin + ignore(E.log "DPtrAnal: Couldn't resolve exp: %a\n" d_exp e); + None + end + else None + +let try_resolve_funptr (e : exp) : fundec list option = + if !doPtrAnalysis then + try Some(P.resolve_funptr e) + with Not_found -> begin + ignore(E.log "DPtrAnal: Couldn't resolve funptr %a\n" d_exp e); + None + end + else None + +(* Visitor that finds reads from things that alias the pointer ee *) +class aliasReadFinderClass (br : bool ref) (ee : exp) = object(self) + inherit nopCilVisitor + + method vexpr e = match e with + | AddrOf(Mem e, _) + | StartOf(Mem e, _) + | Lval(Mem e, _) -> begin + if may_alias ee e then begin + br := true; + SkipChildren + end else DoChildren + end + | AddrOf(Var vi, NoOffset) -> + SkipChildren + | Lval(Var vi, _ ) + | StartOf(Var vi, _) -> begin + if vi.vaddrof || vi.vglob then begin + if may_alias ee e then begin + br := true; + SkipChildren + end else match ee with + | AddrOf(Var gvi, NoOffset) -> begin + if gvi.vid = vi.vid then begin + br := true; + SkipChildren + end else DoChildren + end + | _ -> DoChildren + end else DoChildren + end + | _ -> DoChildren + +end + +let exp_has_alias_read ee e = + let br = ref false in + let vis = new aliasReadFinderClass br ee in + ignore(visitCilExpr vis e); + !br + +let lval_has_alias_read ee lv = + let br = ref false in + let vis = new aliasReadFinderClass br ee in + ignore(visitCilExpr vis (Lval lv)); + !br + +(* Utilities for Dataflow analysis *) + +let int_list_union l1 l2 = + List.fold_left (fun l x -> + if List.mem x l then l else x :: l) l1 l2 + +let vi_list_union l1 l2 = + List.fold_left (fun l x -> + if List.exists (fun vi -> vi.vid = x.vid) l then l else x :: l) + l1 l2 + +let handleCall (memKiller : 'a -> exp option -> 'a) + (fdato : DPF.functionData option) + (fe : exp) + (args : exp list) + (absState : 'a) : + 'a + = + match fdato with + | None -> memKiller absState None + | Some fdat -> begin + (* find what fe can point to *) + let fns : varinfo list = + match fe with + | Lval(Var vf, NoOffset) -> [vf] + | Lval(Mem ee, NoOffset) -> begin + if !doPtrAnalysis then + match try_resolve_funptr ee with + | None -> begin + if !debug then + ignore(E.log "Dptranal: try_resolve failed: %a\n" + d_exp ee); + [] + end + | Some [] -> begin + if !debug then + ignore(E.log "Dptranal: try_resolve returned empty: %a\n" + d_exp ee); + [] + end + | Some fds -> List.map (fun fd -> fd.svar) fds + else [] + end + | _ -> [] + in + (* if the function couldn't be identified then kill everything *) + if fns = [] then begin + if !debug then + ignore(E.log "Dptranal: Couldn't resolve call of %a\n" + d_exp fe); + memKiller absState None + end else + (* glob vis and arg nums that fns might modify, an option in case + nothing is known *) + let modsopt : (varinfo list * int list) option = + List.fold_left + (fun modsopt fvi -> + match modsopt with None -> None + | Some(gmds, amds) -> begin + match IH.tryfind fdat.DPF.fdModHash fvi.vid with + | None -> None + | Some(ngmds, namds) -> + Some(vi_list_union ngmds gmds, + int_list_union namds amds) + end) + (Some([],[])) + fns + in + match modsopt with + | None -> begin + if !debug then + ignore(E.log "Dptranal: No mod/ref data for %a\n" d_exp fe); + memKiller absState None + end + | Some(gmds, amds) -> begin + if !debug then + ignore(E.log "Dptranal: killing things for %a\n" d_exp fe); + (* kill lvals refering to globals in gmds *) + let absState = List.fold_left (fun a gvi -> + memKiller absState (Some(AddrOf(Var gvi, NoOffset)))) + absState gmds + in + (* kill lvals that have reads of things aliasing things in amds *) + List.fold_left (fun a anum -> + memKiller absState (Some(List.nth args anum))) + absState amds + end + end diff --git a/src/optimizer/ptranal/saturnPtrAnal/dptranal.ml b/src/optimizer/ptranal/saturnPtrAnal/dptranal.ml new file mode 100644 index 0000000..e69de29 diff --git a/src/optimizer/solver/cvclSolver/Makefile b/src/optimizer/solver/cvclSolver/Makefile new file mode 100644 index 0000000..7acf3f9 --- /dev/null +++ b/src/optimizer/solver/cvclSolver/Makefile @@ -0,0 +1,69 @@ +# Makefile for cvcl_sover_test.ml +# + + +ifndef ARCHOS + ARCHOS = x86_LINUX +endif + +all: + $(MAKE) cvcl_solver_test + $(MAKE) cvcl_solver_test NATIVECAML=1 + +# +# If you've done a 'make install' with cvc lite, then +# the defaults below should work. Otherwise setting the +# environment variables as below should work. +# +# for example on a x86 linux machine +# CVCLLIB = /path/to/cvcl/lib/linux-i686 +# CVCLINC = /path/to/cvcl/src/include +# +ifndef CVCLLIB + CVCLLIB = /usr/local/lib +endif +ifndef CVCLINC + CVCLINC = /usr/local/include +endif +ifndef OCAMLINC + OCAMLINC = /usr/lib/ocaml +endif + +OBJDIR = obj/$(ARCHOS) +DEPENDDIR = obj/.depend + + +SOURCEDIRS = . + +MODULES = cvcl cvcl_solver_test + +COMPILEFLAGS = +LINKFLAGS = + + +ENDLINKFLAGS = -cclib -L$(CVCLLIB) -cclib -lcvclite -cclib -lstdc++ -cclib -lgmp + +CAML_CFLAGS += -ccopt -I$(OCAMLINC) -ccopt -I$(CVCLINC) + +include ../../../../cil/ocamlutil/Makefile.ocaml + +PROJECT_EXECUTABLE = $(OBJDIR)/cvcl_test$(EXE) +PROJECT_MODULES = $(MODULES) + +PROJECT_CMODULES = cvcl_ocaml_wrappers + +PROJECT_LIBS = unix str + +$(PROJECT_EXECUTABLE) : $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC)) + @$(NARRATIVE) "Linking $(COMPILETOWHAT) $@ $(LINKMSG)" + $(AT)$(CAMLLINK) -verbose -o $@ \ + $(PROJECT_LIBS:%=%.$(CMXA)) \ + $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC)) \ + $(ENDLINKFLAGS) + +cvcl_solver_test: $(PROJECT_EXECUTABLE) + +clean: + rm -f $(OBJDIR)/*.* $(DEPENDDIR)/*.* diff --git a/src/optimizer/solver/cvclSolver/cvcl.ml b/src/optimizer/solver/cvclSolver/cvcl.ml new file mode 100644 index 0000000..e2591d6 --- /dev/null +++ b/src/optimizer/solver/cvclSolver/cvcl.ml @@ -0,0 +1,258 @@ +(* + * cvcl.ml + * + * This file contains external declarations for + * calls into cvc lite + *) + +type vc +type context +type em +type flags +type expr +type op +type typ + +(* create validity checker *) +external createVC : flags -> vc = "caml_vc_createValidityChecker" + +(* create flags *) +external createFlags : unit -> flags = "caml_vc_createFlags" + +(* destroy validity checker *) +external destroyVC : vc -> unit = "caml_vc_destroyValidityChecker" + +(* delete flags *) +external deleteFlags : flags -> unit = "caml_vc_deleteFlags" + +(* delete type *) +external deleteType : typ -> unit = "caml_vc_deleteType" + +(* delete expr *) +external deleteExpr : expr -> unit = "caml_vc_deleteExpr" + +(* delete op *) +external deleteOp : op -> unit = "caml_vc_deleteOp" + +(* flag setting *) +external setBoolFlag : flags -> string -> int -> unit = + "caml_vc_setBoolFlag" +external setIntFlag : flags -> string -> int -> unit = + "caml_vc_setIntFlag" +external setStringFlag : flags -> string -> string -> unit = + "caml_vc_setStringFlag" +external setStrSeqFlag : flags -> string -> string -> int -> unit = + "caml_vc_setStrSeqFlag" + +(* Basic Types *) +external boolType : vc -> typ = "caml_vc_boolType" +external realType : vc -> typ = "caml_vc_realType" +external intType : vc -> typ = "caml_vc_intType" + +(* Tuple Types *) +external tupleType2 : vc -> typ -> typ -> typ = "caml_vc_tupleType2" +external tupleType3 : vc -> typ -> typ -> typ -> typ = "caml_vc_tupleType3" +external tupleTypeN : vc -> typ array -> int -> typ = "caml_vc_tupleTypeN" + +(* Record Types *) +external recordType1 : vc -> string -> typ -> typ = + "caml_vc_recordType1" +external recordType2 : vc -> string -> typ -> string -> typ -> typ = + "caml_vc_recordType2" +(*external recordType3 : vc -> string -> typ -> string -> typ -> string -> typ -> typ = + "caml_vc_recordType3"*) +external recordTypeN : vc -> string array -> typ array -> int -> typ = + "caml_vc_recordTypeN" + +(* Array Type *) +external arrayType : vc -> typ -> typ -> typ = "caml_vc_arrayType" + +(* SubRange Type *) +external subRangeType : vc -> int -> int -> typ = "caml_vc_subRangeType" + +(* Function Types *) +external funType1 : vc -> typ -> typ -> typ = "caml_vc_funType1" +external funType2 : vc -> typ -> typ -> typ -> typ = "caml_vc_funType2" +external funType3 : vc -> typ -> typ -> typ -> typ -> typ = + "caml_vc_funType3" +external funTypeN : vc -> typ array -> typ -> typ = "caml_vc_funTypeN" + +(* User defined Types *) +external createType : vc -> string -> typ = "caml_vc_createType" +external lookupType : vc -> string -> typ = "caml_vc_lookupType" + +(* Expression Manipulation *) +external varExpr : vc -> string -> typ -> expr = "caml_vc_varExpr" +external lookupVar : vc -> string -> typ -> expr = "caml_vc_lookupExpr" +external getType : vc -> expr -> typ = "caml_vc_getType" +external eqExpr : vc -> expr -> expr -> expr = "caml_vc_eqExpr" +external trueExpr : vc -> expr = "caml_vc_trueExpr" +external falseExpr : vc -> expr = "caml_vc_falseExpr" +external notExpr : vc -> expr -> expr = "caml_vc_notExpr" +external andExpr : vc -> expr -> expr -> expr = "caml_vc_andExpr" +external andExprN : vc -> expr array -> expr = "caml_vc_andExprN" +external orExpr : vc -> expr -> expr -> expr = "caml_vc_orExpr" +external orExprN : vc -> expr array -> expr = "caml_vc_orExprN" +external impliesExpr : vc -> expr -> expr -> expr = "caml_vc_impliesExpr" +external iffExpr : vc -> expr -> expr -> expr = "caml_vc_iffExpr" +external iteExpr : vc -> expr -> expr -> expr -> expr = "caml_vc_iteExpr" + +(* Arithmetic Expressions *) +external ratExpr : vc -> int -> int -> expr = "caml_vc_ratExpr" +external ratExprFromStr : vc -> string -> string -> int -> expr = + "caml_vc_ratExprFromStr" + +external uminusExpr : vc -> expr -> expr = "caml_vc_uminusExpr" +external plusExpr : vc -> expr -> expr -> expr = "caml_vc_plusExpr" +external minusExpr : vc -> expr -> expr -> expr = "caml_vc_minusExpr" +external multExpr : vc -> expr -> expr -> expr = "caml_vc_multExpr" +external powExpr : vc -> expr -> expr -> expr = "caml_vc_powExpr" +external divideExpr : vc -> expr -> expr -> expr = "caml_vc_divideExpr" + +external ltExpr : vc -> expr -> expr -> expr = "caml_vc_ltExpr" +external leExpr : vc -> expr -> expr -> expr = "caml_vc_leExpr" +external gtExpr : vc -> expr -> expr -> expr = "caml_vc_gtExpr" +external geExpr : vc -> expr -> expr -> expr = "caml_vc_geExpr" + +(* Records *) +(* Arrays *) +(* Functions *) +(* Tuples *) +(* Quantifiers *) + +(* Expr I/O *) +external printExpr : vc -> expr -> unit = "caml_vc_printExpr" +external printExprFile : vc -> expr -> int -> unit = + "caml_vc_printExprFile" + +(* Contexts *) +external assertFormula : vc -> expr -> unit = "caml_vc_assertFormula" +external registerAtom : vc -> expr -> unit = "caml_vc_registerAtom" +external getImpliedLiteral : vc -> expr = "caml_vc_getImpliedLiteral" +external simplify : vc -> expr -> expr = "caml_vc_simplify" +external query : vc -> expr -> bool = "caml_vc_query" +external getCounterExample : vc -> expr list = "caml_vc_getCounterExample" +external setResourceLimit : vc -> int -> unit = "caml_vc_setResourceLimit" +external getProof : vc -> expr = "caml_vc_getProof" +external getProofOfFile : vc -> string -> expr = "caml_vc_getProofOfFile" +external push : vc -> unit = "caml_vc_push" +external pop : vc -> unit = "caml_vc_pop" +external popto : vc -> int -> unit = "caml_vc_popto" +external scopeLevel : vc -> int = "caml_vc_scopeLevel" + +(* Util *) +external compare_exprs : expr -> expr -> bool = "caml_compare_exprs" +external exprString : expr -> string = "caml_exprString" +external typeString : typ -> string = "caml_typeString" +external isClosure : expr -> bool = "caml_isClosure" +external isQuantifier : expr -> bool = "caml_isQuantifier" +external isLambda : expr -> bool = "caml_isLambda" +external isVar : expr -> bool = "caml_isVar" +external isConst : expr -> bool = "caml_isConst" +external arity : expr -> int = "caml_arity" +external getKind : expr -> int = "caml_getKind" +external isEq : expr -> bool = "caml_isEq" +external getChild : expr -> int -> expr = "caml_getChild" +external getNumVars : expr -> expr = "caml_getNumVars" +external getVar : expr -> int -> expr = "caml_getVar" +external getBody : expr -> expr = "caml_getBody" +external getFun : vc -> expr -> expr = "caml_getFun" +external toExpr : typ -> expr = "caml_toExpr" +external getKindString : vc -> int -> string = "caml_vc_getKindString" +external getKindInt : vc -> string -> int = "caml_vc_getKindInt" +external getInt : expr -> int = "caml_getInt" +external getBVInt : expr -> int = "caml_getBVInt" +external getBVUnsigned : expr -> int = "caml_getBVUnsigned" + +(* Print Statistics *) +external print_statistics : vc -> unit = "caml_print_statistics" + +(* Bit Vector Operations *) +(* Construction *) +external bvType : vc -> int -> typ = "caml_vc_bvType" +external bv32Type : vc -> typ = "caml_vc_bv32Type" +external bvConstExprFromStr : vc -> string -> expr = + "caml_vc_bvConstExprFromStr" +external bvConstExprFromInt : vc -> int -> int -> expr = + "caml_vc_bvConstExprFromInt" +external bv32ConstExprFromInt : vc -> int -> expr = + "caml_vc_bv32ConstExprFromInt" +external bvConcatExpr : vc -> expr -> expr -> expr = + "caml_vc_bvConcatExpr" + +(* Arithmetic *) +external bvPlusExpr : vc -> int -> expr -> expr -> expr = + "caml_vc_bvPlusExpr" +external bv32PlusExpr : vc -> expr -> expr -> expr = + "caml_vc_bv32PlusExpr" +external bvMinusExpr : vc -> int -> expr -> expr -> expr = + "caml_vc_bvMinusExpr" +external bv32MinusExpr : vc -> expr -> expr -> expr = + "caml_vc_bv32MinusExpr" +external bvMultExpr : vc -> int -> expr -> expr -> expr = + "caml_vc_bvMultExpr" +external bv32MultExpr : vc -> expr -> expr -> expr = + "caml_vc_bv32MultExpr" + +external bvUMinusExpr : vc -> expr -> expr = + "caml_vc_bvUMinusExpr" +external bvNotExpr : vc -> expr -> expr = + "caml_vc_bvNotExpr" +external bvAndExpr : vc -> expr -> expr -> expr = + "caml_vc_bvAndExpr" +external bvOrExpr : vc -> expr -> expr -> expr = + "caml_vc_bvOrExpr" +external bvXorExpr : vc -> expr -> expr -> expr = + "caml_vc_bvXorExpr" + +external bvLeftShiftExpr : vc -> int -> expr -> expr = + "caml_vc_bvLeftShiftExpr" +external bvRightShiftExpr : vc -> int -> expr -> expr = + "caml_vc_bvRightShiftExpr" +external bv32LeftShiftExpr : vc -> int -> expr -> expr = + "caml_vc_bv32LeftShiftExpr" +external bv32RightShiftExpr : vc -> int -> expr -> expr = + "caml_vc_bv32RightShiftExpr" + +external bvVar32LeftShiftExpr : vc -> expr -> expr -> expr = + "caml_vc_bvVar32LeftShiftExpr" +external bvVar32RightShiftExpr : vc -> expr -> expr -> expr = + "caml_vc_bvVar32RightShiftExpr" +external bvVar32DivByPowOfTwoExpr : vc -> expr -> expr -> expr = + "caml_vc_bvVar32DivByPowOfTwoExpr" + +external bvExtract : vc -> expr -> int -> int -> expr = + "caml_vc_bvExtract" +external bvBoolExtract : vc -> expr -> int -> expr = + "caml_vc_bvBoolExtract" + +external bvSignExtend : vc -> expr -> int -> expr = + "caml_vc_bvSignExtend" + +(* unsigned comparators *) +external bvLtExpr : vc -> expr -> expr -> expr = + "caml_vc_bvLtExpr" +external bvLeExpr : vc -> expr -> expr -> expr = + "caml_vc_bvLeExpr" +external bvGtExpr : vc -> expr -> expr -> expr = + "caml_vc_bvGtExpr" +external bvGeExpr : vc -> expr -> expr -> expr = + "caml_vc_bvGeExpr" + +(* signed comparators *) +external sbvLtExpr : vc -> expr -> expr -> expr = + "caml_vc_sbvLtExpr" +external sbvLeExpr : vc -> expr -> expr -> expr = + "caml_vc_sbvLeExpr" +external sbvGtExpr : vc -> expr -> expr -> expr = + "caml_vc_sbvGtExpr" +external sbvGeExpr : vc -> expr -> expr -> expr = + "caml_vc_sbvGeExpr" + +(* for C arrays *) +external bvCreateMemoryArray : vc -> string -> expr = + "caml_vc_bvCreateMemoryArray" +external bvReadMemoryArray : vc -> expr -> expr -> int -> expr = + "caml_vc_bvReadMemoryArray" +external bvWriteToMemoryArray : vc -> expr -> expr -> expr -> int -> expr = + "caml_vc_bvWriteToMemoryArray" diff --git a/src/optimizer/solver/cvclSolver/cvcl_ocaml_wrappers.c b/src/optimizer/solver/cvclSolver/cvcl_ocaml_wrappers.c new file mode 100644 index 0000000..a0e6264 --- /dev/null +++ b/src/optimizer/solver/cvclSolver/cvcl_ocaml_wrappers.c @@ -0,0 +1,1505 @@ +/* + +cvcl_ocaml_wrappers.c + +This file contains wrappers for the C interface to CVCL +that are callable from ocaml code. + +Search for XXX to find unimplemented things + +*/ + +#include +#include +#include +#include +#include + + // The commonly used kinds and the kinds needed by the parser. All + // these kinds are registered by the ExprManager and are readily + // available for everyone else. +typedef enum { + NULL_KIND = 0, + // Generic LISP kinds for representing raw parsed expressions + RAW_LIST, //!< May have any number of children >= 0 + //! Identifier is (ID (STRING_EXPR "name")) + ID, + // Leaf exprs + STRING_EXPR, + RATIONAL_EXPR, + TRUE, + FALSE, + // Types + BOOLEAN, +// TUPLE_TYPE, + ANY_TYPE, + ARROW, + // The "type" of any expression type (as in BOOLEAN : TYPE). + TYPE, + // Declaration of new (uninterpreted) types: T1, T2, ... : TYPE + // (TYPEDECL T1 T2 ...) + TYPEDECL, + // Declaration of a defined type T : TYPE = type === (TYPEDEF T type) + TYPEDEF, + + // Equality + EQ, + NEQ, + + // Propositional connectives + NOT, + AND, + OR, + XOR, + IFF, + IMPLIES, + // BOOL_VAR, //!< Boolean variables are treated as 0-ary predicates + + // Propositional relations (for circuit propagation) + AND_R, + IFF_R, + ITE_R, + + // (ITE c e1 e2) == IF c THEN e1 ELSE e2 ENDIF, the internal + // representation of the conditional. Parser produces (IF ...). + ITE, + + // Quantifiers + FORALL, + EXISTS, + + // Uninterpreted function + UFUNC, + // Application of a function + APPLY, + + // Top-level Commands + ASSERT, + QUERY, + CHECKSAT, + CONTINUE, + RESTART, + DBG, + TRACE, + UNTRACE, + OPTION, + HELP, + TRANSFORM, + PRINT, + CALL, + ECHO, + INCLUDE, + DUMP_PROOF, + DUMP_ASSUMPTIONS, + DUMP_SIG, + DUMP_TCC, + DUMP_TCC_ASSUMPTIONS, + DUMP_TCC_PROOF, + DUMP_CLOSURE, + DUMP_CLOSURE_PROOF, + WHERE, + ASSERTIONS, + ASSUMPTIONS, + COUNTEREXAMPLE, + COUNTERMODEL, + PUSH, + POP, + POPTO, + PUSH_SCOPE, + POP_SCOPE, + POPTO_SCOPE, + CONTEXT, + FORGET, + GET_TYPE, + CHECK_TYPE, + GET_CHILD, + SUBSTITUTE, + SEQ, + + // Kinds used mostly in the parser + + TCC, + // Variable declaration (VARDECL v1 v2 ... v_n type). A variable + // can be an ID or a BOUNDVAR. + VARDECL, + // A list of variable declarations (VARDECLS (VARDECL ...) (VARDECL ...) ...) + VARDECLS, + + // Bound variables have a "printable name", the one the user typed + // in, and a uniqueID used to distinguish it from other bound + // variables, which is effectively the alpha-renaming: + + // Op(BOUND_VAR (BOUND_ID "user_name" "uniqueID")). Note that + // BOUND_VAR is an operator (Expr without children), just as UFUNC + // and UCONST. + + // The uniqueID normally is just a number, so one can print a bound + // variable X as X_17. + + // NOTE that in the parsed expressions like LET x: T = e IN foo(x), + // the second instance of 'x' will be an ID, and *not* a BOUNDVAR. + // The parser does not know how to resolve bound variables, and it + // has to be resolved later. + BOUND_VAR, + BOUND_ID, + + // Updator "e1 WITH := e2" is represented as + // (UPDATE e1 (UPDATE_SELECT ) e2), where is the list of accessors: + // (READ idx) + // ID (what's that for?) + // (REC_SELECT ID) + // and (TUPLE_SELECT num). +// UPDATE, +// UPDATE_SELECT, + // Record type [# f1 : t1, f2 : t2 ... #] is represented as + // (RECORD_TYPE (f1 t1) (f2 t2) ... ) +// RECORD_TYPE, +// // (# f1=e1, f2=e2, ...#) == (RECORD (f1 e1) ...) +// RECORD, +// RECORD_SELECT, +// RECORD_UPDATE, + +// // (e1, e2, ...) == (TUPLE e1 e2 ...) +// TUPLE, +// TUPLE_SELECT, +// TUPLE_UPDATE, + +// SUBRANGE, + // Enumerated type (SCALARTYPE v1 v2 ...) +// SCALARTYPE, + // Predicate subtype: the argument is the predicate (lambda-expression) + SUBTYPE, + // Datatype is Expr(DATATYPE, Constructors), where Constructors is a + // vector of Expr(CONSTRUCTOR, id [ , arg ]), where 'id' is an ID, + // and 'arg' a VARDECL node (list of variable declarations with + // types). If 'arg' is present, the constructor has arguments + // corresponding to the declared variables. +// DATATYPE, +// THISTYPE, // Used to indicate recursion in recursive datatypes +// CONSTRUCTOR, +// SELECTOR, +// TESTER, + // Expression e WITH accessor := e2 is transformed by the command + // processor into (DATATYPE_UPDATE e accessor e2), where e is the + // original datatype value C(a1, ..., an) (here C is the + // constructor), and "accessor" is the name of one of the arguments + // a_i of C. + // DATATYPE_UPDATE, + // Statement IF c1 THEN e1 ELSIF c2 THEN e2 ... ELSE e_n ENDIF is + // represented as (IF (IFTHEN c1 e1) (IFTHEN c2 e2) ... (ELSE e_n)) + IF, + IFTHEN, + ELSE, + // Lisp version of multi-branch IF: + // (COND (c1 e1) (c2 e2) ... (ELSE en)) + COND, + + // LET x1: t1 = e1, x2: t2 = e2, ... IN e + // Parser builds: + // (LET (LETDECLS (LETDECL x1 t1 e1) (LETDECL x2 t2 e2) ... ) e) + // where each x_i is a BOUNDVAR. + // After processing, it is rebuilt to have (LETDECL var def); the + // type is set as the attribute to var. + LET, + LETDECLS, + LETDECL, + // Lambda-abstraction LAMBDA () : e === (LAMBDA e) + LAMBDA, + // Symbolic simulation operator + SIMULATE, + + // Uninterpreted constants (variables) x1, x2, ... , x_n : type + // (CONST (VARLIST x1 x2 ... x_n) type) + // Uninterpreted functions are declared as constants of functional type. + + // After processing, uninterpreted functions and constants + // (a.k.a. variables) are represented as Op(UFUNC, (ID "name")) and + // Op(UCONST, (ID "name")) with the appropriate type attribute. + CONST, + VARLIST, + UCONST, + + // User function definition f(args) : type = e === (DEFUN args type e) + // Here 'args' are bound var declarations + DEFUN, + + // Arithmetic types and operators +// REAL, +// INT, + +// UMINUS, +// PLUS, +// MINUS, +// MULT, +// DIVIDE, +// INTDIV, +// MOD, +// LT, +// LE, +// GT, +// GE, +// IS_INTEGER, +// NEGINF, +// POSINF, +// DARK_SHADOW, +// GRAY_SHADOW, + +// //Floor theory operators +// FLOOR, + // Kind for Extension to Non-linear Arithmetic +// POW, + + // Kinds for proof terms + PF_APPLY, + PF_HOLE, + + +// // Mlss +// EMPTY, // {} +// UNION, // + +// INTER, // * +// DIFF, +// SINGLETON, +// IN, +// INCS, +// INCIN, + + //Skolem variable + SKOLEM_VAR, + //! Must always be the last kind + LAST_KIND +} Kind; + +/************************************************************ + +Structures that tell the ocaml runtime how to deal with +things of abstract types that we will ll be passing it. + +************************************************************/ + +/* Encapsulation of ValidityChecker + as Caml custom blocks. */ +static struct custom_operations VC_ops = { + "CVCL.ValidityChecker", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of Context + as Caml custom blocks. */ +static struct custom_operations Context_ops = { + "CVCL.Context", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of ExprManager + as Caml custom blocks. */ +static struct custom_operations EM_ops = { + "CVCL.ExprManager", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of Flags + as Caml custom blocks. */ +static struct custom_operations Flags_ops = { + "CVCL.Flags", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of Expr + as Caml custom blocks. */ +static struct custom_operations Expr_ops = { + "CVCL.Expr", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of Op + as Caml custom blocks. */ +static struct custom_operations Op_ops = { + "CVCL.Op", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of Type + as Caml custom blocks. */ +static struct custom_operations Type_ops = { + "CVCL.Type", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/************************************************************ + +Functions for wrapping and unwrapping ocaml values for the +abstract types above. + +************************************************************/ + +/* Accessing the relevant part of a Caml custom block */ +#define VC_val(v) (*((VC *) Data_custom_val(v))) +#define Context_val(v) (*((Context *) Data_custom_val(v))) +#define EM_val(v) (*((ExprManager *) Data_custom_val(v))) +#define Flags_val(v) (*((Flags *) Data_custom_val(v))) +#define Expr_val(v) (*((Expr *) Data_custom_val(v))) +#define OP_val(v) (*((Op *) Data_custom_val(v))) +#define Type_val(v) (*((Type *) Data_custom_val(v))) + +/* Allocating a Caml custom block to hold the given CVCL structure */ +static value alloc_VC(VC vc) +{ + value v = alloc_custom(&VC_ops, sizeof(VC), 0, 1); + VC_val(v) = vc; + return v; +} + +static value alloc_Context(Context ctxt) +{ + value v = alloc_custom(&Context_ops, sizeof(Context), 0, 1); + Context_val(v) = ctxt; + return v; +} + +static value alloc_EM(ExprManager em) +{ + value v = alloc_custom(&EM_ops, sizeof(ExprManager), 0, 1); + EM_val(v) = em; + return v; +} + +static value alloc_Flags(Flags f) +{ + value v = alloc_custom(&Flags_ops, sizeof(Flags), 0, 1); + Flags_val(v) = f; + return v; +} + +static value alloc_Expr(Expr e) +{ + value v = alloc_custom(&Expr_ops, sizeof(Expr), 0, 1); + Expr_val(v) = e; + return v; +} + +static value alloc_Op(Op op) +{ + value v = alloc_custom(&Op_ops, sizeof(Op), 0, 1); + OP_val(v) = op; + return v; +} + +static value alloc_Type(Type t) +{ + value v = alloc_custom(&Type_ops, sizeof(Type), 0, 1); + Type_val(v) = t; + return v; +} + +/************************************************************ + +Wrappers + +************************************************************/ + +value caml_vc_createValidityChecker(value flags) +{ + CAMLparam1(flags); + CAMLreturn(alloc_VC(vc_createValidityChecker(Flags_val(flags)))); +} + +value caml_vc_createFlags(value unit) +{ + CAMLparam1(unit); + CAMLreturn(alloc_Flags(vc_createFlags())); +} + +value caml_vc_destroyValidityChecker(value vc) +{ + CAMLparam1(vc); + vc_destroyValidityChecker(VC_val(vc)); + CAMLreturn(Val_unit); +} + +value caml_vc_deleteFlags(value flags) +{ + CAMLparam1(flags); + vc_deleteFlags(Flags_val(flags)); + CAMLreturn(Val_unit); +} + +value caml_vc_deleteType(value type) +{ + CAMLparam1(type); + vc_deleteType(Type_val(type)); + CAMLreturn(Val_unit); +} + +value caml_vc_deleteExpr(value e) +{ + CAMLparam1(e); + vc_deleteExpr(Expr_val(e)); + CAMLreturn(Val_unit); +} + +value caml_vc_deleteOp(value op) +{ + CAMLparam1(op); + vc_deleteOp(OP_val(op)); + CAMLreturn(Val_unit); +} + +// Setting the flags +value caml_vc_setBoolFlag(value flags, value name, value val) +{ + CAMLparam3(flags,name,val); + vc_setBoolFlag(Flags_val(flags),String_val(name),Int_val(val)); + CAMLreturn(Val_unit); +} + +value caml_vc_setIntFlag(value flags, value name, value val) +{ + CAMLparam3(flags,name,val); + vc_setIntFlag(Flags_val(flags),String_val(name),Int_val(val)); + CAMLreturn(Val_unit); +} + +value caml_vc_setStringFlag(value flags, value name, value val) +{ + CAMLparam3(flags,name,val); + vc_setStringFlag(Flags_val(flags),String_val(name),String_val(val)); + CAMLreturn(Val_unit); +} + +value caml_vc_setStrSeqFlag(value flags, value name, value str, value val) +{ + CAMLparam4(flags,name,str,val); + vc_setStrSeqFlag(Flags_val(flags),String_val(name), + String_val(val),Int_val(val)); + CAMLreturn(Val_unit); +} + +// Basic Types +value caml_vc_boolType(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Type(vc_boolType(VC_val(vc)))); +} + +value caml_vc_realType(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Type(vc_realType(VC_val(vc)))); +} + +value caml_vc_intType(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Type(vc_intType(VC_val(vc)))); +} + +// Tuple Types +value caml_vc_tupleType2(value vc, value t0, value t1) +{ + CAMLparam3(vc,t0,t1); + CAMLreturn(alloc_Type(vc_tupleType2(VC_val(vc),Type_val(t0),Type_val(t1)))); +} + +value caml_vc_tupleType3(value vc, value t0, value t1, value t2) +{ + CAMLparam4(vc,t0,t1,t2); + CAMLreturn(alloc_Type(vc_tupleType3(VC_val(vc),Type_val(t0), + Type_val(t1),Type_val(t2)))); +} + +value caml_vc_tupleTypeN(value vc, value types, value numTypes) +{ + Type *ts; + int i; + + CAMLparam3(vc,types,numTypes); + CAMLlocal1(result); + + ts = (Type *)malloc(Int_val(numTypes) * sizeof(Type)); + if( !ts ) + caml_failwith("malloc returned NULL in vc_tupleTypeN wrapper"); + + for( i = 0; i < Int_val(numTypes); i++ ) { + ts[i] = Type_val(Field(types,i)); + } + + result = alloc_Type(vc_tupleTypeN(VC_val(vc), ts, Int_val(numTypes))); + + free( ts ); + + CAMLreturn(result); +} + +// Record Types +value caml_vc_recordType1(value vc, value field, value t) +{ + CAMLparam3(vc, field, t); + CAMLreturn(alloc_Type(vc_recordType1(VC_val(vc),String_val(field), + Type_val(t)))); +} + +value caml_vc_recordType2(value vc, value f0, value t0, value f1, value t1) +{ + CAMLparam5(vc,f0,t0,f1,t1); + CAMLreturn(alloc_Type(vc_recordType2(VC_val(vc),String_val(f0),Type_val(t0), + String_val(f1),Type_val(t1)))); +} + +/* +value caml_vc_recordType3_(value vc, value f0, value t0, value f1, value t1, + value f2, value t2) +{ + CAMLparam5(vc,f0,t0,f1,t1); + CAMLxparam2(f2,t2); + CAMLreturn(alloc_Type(vc_recordType3(VC_val(vc),String_val(f0),Type_val(t0), + String_val(f1),Type_val(t1), + String_val(f2),Type_val(t2)))); +} + +value caml_vc_recordType3(value *args, int num) +{ + + return(caml_vc_recordType3_(args[0],args[1],args[2], + args[3],args[4],args[5], + args[6])); +} +*/ + +value caml_vc_recordTypeN(value vc, value fields, value types, value num) +{ + char **fs; + Type *ts; + int i; + + CAMLparam4(vc,fields,types,num); + CAMLlocal1(result); + + fs = (char **)malloc(Int_val(num) * sizeof(char *)); + if( !fs ) + caml_failwith("malloc returned NULL in vc_recordTypeN wrapper"); + + ts = (Type *)malloc(Int_val(num) * sizeof(Type)); + if( !ts ) { + free( fs ); + caml_failwith("malloc returned NULL in vc_recordTypeN wrapper"); + } + + for( i = 0; i < Int_val(num); i++ ) { + fs[i] = String_val(Field(fields,i)); + ts[i] = Type_val(Field(types,i)); + } + + result = alloc_Type(vc_recordTypeN(VC_val(vc),fs,ts,Int_val(num))); + + free(ts); + free(fs); + + CAMLreturn(result); +} + +// Create an array type +value caml_vc_arrayType(value vc, value it, value dt) +{ + CAMLparam3(vc,it,dt); + CAMLreturn(alloc_Type(vc_arrayType(VC_val(vc),Type_val(it),Type_val(dt)))); +} + +// Create a subrange type +value caml_vc_subRangeType(value vc, value low, value hi) +{ + CAMLparam3(vc,low,hi); + CAMLreturn(alloc_Type(vc_subRangeType(VC_val(vc),Int_val(low),Int_val(hi)))); +} + +// Create function types +value caml_vc_funType1(value vc, value a1, value tr) +{ + CAMLparam3(vc,a1,tr); + CAMLreturn(alloc_Type(vc_funType1(VC_val(vc),Type_val(a1),Type_val(tr)))); +} + +value caml_vc_funType2(value vc, value a1, value a2, value tr) +{ + CAMLparam4(vc,a1,a2,tr); + CAMLreturn(alloc_Type(vc_funType2(VC_val(vc),Type_val(a1), + Type_val(a2),Type_val(tr)))); +} + +value caml_vc_funType3(value vc, value a1, value a2, value a3, value tr) +{ + CAMLparam5(vc,a1,a2,a3,tr); + CAMLreturn(alloc_Type(vc_funType3(VC_val(vc),Type_val(a1), + Type_val(a2),Type_val(a3), + Type_val(tr)))); +} + +value caml_vc_funTypeN(value vc, value args, value r, value num) +{ + Type *ts; + int i; + + CAMLparam4(vc,args,r,num); + CAMLlocal1(result); + + ts = (Type *)malloc(Int_val(num) * sizeof(Type)); + if( !ts ) + caml_failwith("malloc returned NULL in vc_funTypeN wrapper"); + + for( i = 0; i < Int_val(num); i++ ) { + ts[i] = Type_val(Field(args,i)); + } + + result = alloc_Type(vc_funTypeN(VC_val(vc), ts, Type_val(r), + Int_val(num))); + + free( ts ); + + CAMLreturn(result); +} + +// User-defined types +value caml_vc_createType(value vc, value name) +{ + CAMLparam2(vc, name); + CAMLreturn(alloc_Type(vc_createType(VC_val(vc),String_val(name)))); +} + +value caml_vc_lookupType(value vc, value name) +{ + CAMLparam2(vc,name); + CAMLreturn(alloc_Type(vc_lookupType(VC_val(vc),String_val(name)))); +} + +/* + * Expr manipulation methods + */ + +// XXX +// ExprManager * vc_getEM(VC vc); + +// Create a variable with a given name and type +value caml_vc_varExpr(value vc, value name, value t) +{ + CAMLparam3(vc, name, t); + CAMLreturn(alloc_Expr(vc_varExpr(VC_val(vc),String_val(name),Type_val(t)))); +} + +// Get the expression and type associated with a name +value caml_vc_lookupVar(value vc, value name, value t) +{ + CAMLparam3(vc,name,t); + CAMLreturn(alloc_Expr(vc_lookupVar(VC_val(vc),String_val(name),Type_val(t)))); +} + +// Get the type of the expr +value caml_vc_getType(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Type(vc_getType(VC_val(vc),Expr_val(e)))); +} + +// Create and equality expression. Children have same type +value caml_vc_eqExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_eqExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +// Boolean expressions +value caml_vc_trueExpr(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Expr(vc_trueExpr(VC_val(vc)))); +} + +value caml_vc_falseExpr(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Expr(vc_falseExpr(VC_val(vc)))); +} + +value caml_vc_notExpr(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Expr(vc_notExpr(VC_val(vc),Expr_val(e)))); +} + +value caml_vc_andExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_andExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_andExprN(value vc, value exprs, value num) +{ + Expr *es; + int i; + + CAMLparam3(vc,exprs,num); + CAMLlocal1(result); + + es = (Expr *)malloc(Int_val(num) * sizeof(Expr)); + if( !es ) + caml_failwith("malloc returned NULL in vc_andExprN wrapper"); + + for( i = 0; i < Int_val(num); i++ ) { + es[i] = Expr_val(Field(exprs,i)); + } + + result = alloc_Expr(vc_andExprN(VC_val(vc),es,Int_val(num))); + + free( es ); + + CAMLreturn(result); +} + +value caml_vc_orExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_orExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_orExprN(value vc, value exprs, value num) +{ + Expr *es; + int i; + + CAMLparam3(vc,exprs,num); + CAMLlocal1(result); + + es = (Expr *)malloc(Int_val(num) * sizeof(Expr)); + if( !es ) + caml_failwith("malloc returned NULL in vc_orExprN wrapper"); + + for( i = 0; i < Int_val(num); i++ ) { + es[i] = Expr_val(Field(exprs,i)); + } + + result = alloc_Expr(vc_orExprN(VC_val(vc),es,Int_val(num))); + + free( es ); + + CAMLreturn(result); +} + +value caml_vc_impliesExpr(value vc, value h, value c) +{ + CAMLparam3(vc,h,c); + CAMLreturn(alloc_Expr(vc_impliesExpr(VC_val(vc),Expr_val(h),Expr_val(c)))); +} + +value caml_vc_iffExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_iffExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_iteExpr(value vc, value i, value t, value e) +{ + CAMLparam4(vc,i,t,e); + CAMLreturn(alloc_Expr(vc_iteExpr(VC_val(vc),Expr_val(i),Expr_val(t), + Expr_val(e)))); +} + +/* + * Arithmetic + */ + +// Create a rational number of numerator n and denominator d. +value caml_vc_ratExpr(value vc, value n, value d) +{ + CAMLparam3(vc,n,d); + CAMLreturn(alloc_Expr(vc_ratExpr(VC_val(vc),Int_val(n),Int_val(d)))); +} + +// Create a rational number n/d. n and d given as strings +value caml_vc_ratExprFromStr(value vc, value n, value d, value b) +{ + CAMLparam4(vc,n,d,b); + CAMLreturn(alloc_Expr(vc_ratExprFromStr(VC_val(vc),String_val(n), + String_val(d),Int_val(b)))); +} + +// Unary minus +value caml_vc_uminusExpr(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Expr(vc_uminusExpr(VC_val(vc),Expr_val(e)))); +} + +// plus, minus, mult... exprs must have numeric type +value caml_vc_plusExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_plusExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_minusExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_minusExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_multExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_multExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_powExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_powExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_divideExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_divideExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +// comparators. produce boolean expressions expressions must have numeric type +value caml_vc_ltExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_ltExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_leExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_leExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_gtExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_gtExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_geExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_geExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +/* XXX + * Records + */ + +/* XXX + * Arrays + */ + +/* XXX + * Functions + */ + +/* XXX + * Tuples + */ + +/* XXX + * Quantifiers + */ + +/* + * Expr I/O + */ + +value caml_vc_printExpr(value vc, value e) +{ + CAMLparam2(vc,e); + vc_printExpr(VC_val(vc),Expr_val(e)); + CAMLreturn(Val_unit); +} + +value caml_vc_printExprFile(value vc, value e, value fd) +{ + CAMLparam3(vc,e,fd); + vc_printExprFile(VC_val(vc),Expr_val(e),Int_val(fd)); + CAMLreturn(Val_unit); +} + +/* + * Context related methods + */ + +// Assert a new formula in the current context +value caml_vc_assertFormula(value vc, value e) +{ + CAMLparam2(vc,e); + vc_assertFormula(VC_val(vc),Expr_val(e)); + CAMLreturn(Val_unit); +} + +// Register an atomic formula of interest +value caml_vc_registerAtom(value vc, value e) +{ + CAMLparam2(vc,e); + vc_registerAtom(VC_val(vc),Expr_val(e)); + CAMLreturn(Val_unit); +} + +// Return next literal implied by last assertion +value caml_vc_getImpliedLiteral(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Expr(vc_getImpliedLiteral(VC_val(vc)))); +} + +// Simplify e w.r.t. the current context +value caml_vc_simplify(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Expr(vc_simplify(VC_val(vc),Expr_val(e)))); +} + +// Check validity of e in the current context +value caml_vc_query(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(Val_int(vc_query(VC_val(vc),Expr_val(e)))); +} + +// XXX +// Expr * vc_getCounterExample(VC vc, int *size) +value caml_vc_getCounterExample(value vc) +{ + CAMLparam1(vc); + CAMLlocal2(tmp,result); + Expr *e; + int i, size; + + e = vc_getCounterExample(VC_val(vc), &size); + + if( !e ) CAMLreturn(Val_int(0)); // empty list + + result = Val_int(0); + for( i = 0; i < size; i++ ) { + tmp = caml_alloc(2, 0); + Store_field(tmp, 0, alloc_Expr(e[i])); + Store_field(tmp, 1, result); + result = tmp; + } + + free(e); + CAMLreturn(result); + +} + + +// XXX +// int vc_inconsistent(VC vc, Expr **assumptions, int * size) + +// Set the resource limit (0==unlimited, 1==exhausted) +value caml_vc_setResourceLimit(value vc, value limit) +{ + CAMLparam2(vc,limit); + vc_setResourceLimit(VC_val(vc), Int_val(limit)); + CAMLreturn(Val_unit); +} + +// Returns the proof for the last proven query +value caml_vc_getProof(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Expr(vc_getProof(VC_val(vc)))); +} + +// Returns the proof of a .cvc file, if it is valid +value caml_vc_getProofOfFile(value vc, value fname) +{ + CAMLparam2(vc,fname); + CAMLreturn(alloc_Expr(vc_getProofOfFile(VC_val(vc),String_val(fname)))); +} + +// Checkpoint the current context and increase the scope level +value caml_vc_push(value vc) +{ + CAMLparam1(vc); + vc_push(VC_val(vc)); + CAMLreturn(Val_unit); +} + +// Restore the current context to its state at the last checkpoint +value caml_vc_pop(value vc) +{ + CAMLparam1(vc); + vc_pop(VC_val(vc)); + CAMLreturn(Val_unit); +} + +// Restore the current context to the given scope level +value caml_vc_popto(value vc, value l) +{ + CAMLparam2(vc,l); + vc_popto(VC_val(vc),Int_val(l)); + CAMLreturn(Val_unit); +} + +// Returns the current scope level +value caml_vc_scopeLevel(value vc) +{ + CAMLparam1(vc); + CAMLreturn(Val_int(vc_scopeLevel(VC_val(vc)))); +} + +// XXX +// Context *vc_getCurrentContext(VC vc) + +/* + * Util + */ + +// Returns 1, 0, -1 +value caml_compare_exprs(value e1, value e2) +{ + CAMLparam2(e1,e2); + CAMLreturn(Val_int(compare_exprs(Expr_val(e1),Expr_val(e2)))); +} + +// Converts expression to a string +value caml_exprString(value e) +{ + CAMLparam1(e); + CAMLlocal1(r); + + r = caml_copy_string(exprString(Expr_val(e))); + + CAMLreturn(r); +} + +// Convertsa Type to a string +value caml_typeString(value t) +{ + CAMLparam1(t); + CAMLlocal1(r); + + r = caml_copy_string(typeString(Type_val(t))); + + CAMLreturn(r); +} + +// what kind of Expr? +value caml_isClosure(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(isClosure(Expr_val(e)))); +} + +value caml_isQuantifier(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(isQuantifier(Expr_val(e)))); +} + +value caml_isLambda(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(isLambda(Expr_val(e)))); +} + +value caml_isVar(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(isVar(Expr_val(e)))); +} + +value caml_isConst(value e) +{ + int k,r=0; + CAMLparam1(e); + + k = getKind(Expr_val(e)); + if( k == CONST ) r = 1; + CAMLreturn(Val_int(r)); +} + +value caml_arity(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(arity(Expr_val(e)))); +} + +value caml_getKind(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(getKind(Expr_val(e)))); +} + +value caml_isEq(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(getKind(Expr_val(e)) == EQ)); +} + +value caml_getChild(value e, value i) +{ + CAMLparam2(e,i); + CAMLreturn(alloc_Expr(getChild(Expr_val(e),Int_val(i)))); +} + +value caml_getNumVars(value e) +{ + CAMLparam1(e); + CAMLreturn(alloc_Expr(getNumVars(Expr_val(e)))); +} + +value caml_getVar(value e, value i) +{ + CAMLparam2(e,i); + CAMLreturn(alloc_Expr(getVar(Expr_val(e),Int_val(i)))); +} + +value caml_getBody(value e) +{ + CAMLparam1(e); + CAMLreturn(alloc_Expr(getBody(Expr_val(e)))); +} + +value caml_vc_getFun(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Expr(vc_getFun(VC_val(vc),Expr_val(e)))); +} + +value caml_toExpr(value t) +{ + CAMLparam1(t); + CAMLreturn(alloc_Expr(toExpr(Type_val(t)))); +} + +// Translate a kind int to a string +value caml_vc_getKindString(value vc, value k) +{ + CAMLparam2(vc,k); + CAMLlocal1(r); + + r = caml_copy_string(vc_getKindString(VC_val(vc),Int_val(k))); + + CAMLreturn(r); +} + +// Translate a kind string to an int +value caml_vc_getKindInt(value vc, value name) +{ + CAMLparam2(vc,name); + CAMLreturn(Val_int(vc_getKindInt(VC_val(vc),String_val(name)))); +} + +// Return an in from a rational exp +value caml_getInt(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(getInt(Expr_val(e)))); +} + +// Return an int from a constant bitvector expression +value caml_getBVInt(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(getBVInt(Expr_val(e)))); +} + +value caml_getBVUnsigned(value e) +{ + CAMLparam1(e); + CAMLreturn(Val_int(getBVUnsigned(Expr_val(e)))); +} + +// XXX +// Debug + +// Print statistics +value caml_print_statistics(value vc) +{ + CAMLparam1(vc); + print_statistics(VC_val(vc)); + CAMLreturn(Val_unit); +} + +/* + * Bit Vector Operations + */ + +value caml_vc_bvType(value vc, value no_bits) +{ + CAMLparam2(vc,no_bits); + CAMLreturn(alloc_Type(vc_bvType(VC_val(vc),Int_val(no_bits)))); +} + +value caml_vc_bv32Type(value vc) +{ + CAMLparam1(vc); + CAMLreturn(alloc_Type(vc_bv32Type(VC_val(vc)))); +} + +value caml_vc_bvConstExprFromStr(value vc, value binstr) +{ + CAMLparam2(vc,binstr); + CAMLreturn(alloc_Expr(vc_bvConstExprFromStr(VC_val(vc),String_val(binstr)))); +} + +value caml_vc_bvConstExprFromInt(value vc, value nbits,value i) +{ + CAMLparam3(vc,nbits,i); + CAMLreturn(alloc_Expr(vc_bvConstExprFromInt(VC_val(vc),Int_val(nbits), + Int_val(i)))); +} + +value caml_vc_bv32ConstExprFromInt(value vc, value i) +{ + CAMLparam2(vc,i); + CAMLreturn(alloc_Expr(vc_bv32ConstExprFromInt(VC_val(vc),Int_val(i)))); +} + +value caml_vc_bvConcatExpr(value vc, value l, value r) +{ + CAMLparam3(vc,l,r); + CAMLreturn(alloc_Expr(vc_bvConcatExpr(VC_val(vc),Expr_val(l),Expr_val(r)))); +} + +// XXX +// Expr vc_bvConcatExprN(VC vc, Expr *c, int num) + +value caml_vc_bvPlusExpr(value vc, value bits, value e1, value e2) +{ + CAMLparam4(vc,bits,e1,e2); + CAMLreturn(alloc_Expr(vc_bvPlusExpr(VC_val(vc),Int_val(bits), + Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bv32PlusExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bv32PlusExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvMinusExpr(value vc, value bits, value e1, value e2) +{ + CAMLparam4(vc,bits,e1,e2); + CAMLreturn(alloc_Expr(vc_bvMinusExpr(VC_val(vc),Int_val(bits), + Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bv32MinusExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bv32MinusExpr(VC_val(vc),Expr_val(e1), + Expr_val(e2)))); +} + +value caml_vc_bvMultExpr(value vc, value bits, value e1, value e2) +{ + CAMLparam4(vc,bits,e1,e2); + CAMLreturn(alloc_Expr(vc_bvMultExpr(VC_val(vc),Int_val(bits), + Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bv32MultExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bv32MultExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvLtExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvLtExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvLeExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvLeExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvGtExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvGtExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvGeExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvGeExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_sbvLtExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_sbvLtExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_sbvLeExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_sbvLeExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_sbvGtExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_sbvGtExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_sbvGeExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_sbvGeExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvUMinusExpr(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Expr(vc_bvUMinusExpr(VC_val(vc),Expr_val(e)))); +} + +value caml_vc_bvNotExpr(value vc, value e) +{ + CAMLparam2(vc,e); + CAMLreturn(alloc_Expr(vc_bvNotExpr(VC_val(vc),Expr_val(e)))); +} + +value caml_vc_bvAndExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvAndExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvOrExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvOrExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvXorExpr(value vc, value e1, value e2) +{ + CAMLparam3(vc,e1,e2); + CAMLreturn(alloc_Expr(vc_bvXorExpr(VC_val(vc),Expr_val(e1),Expr_val(e2)))); +} + +value caml_vc_bvLeftShiftExpr(value vc, value amt, value e) +{ + CAMLparam3(vc,amt,e); + CAMLreturn(alloc_Expr(vc_bvLeftShiftExpr(VC_val(vc),Int_val(amt), + Expr_val(e)))); +} + +value caml_vc_bvRightShiftExpr(value vc, value amt, value e) +{ + CAMLparam3(vc,amt,e); + CAMLreturn(alloc_Expr(vc_bvRightShiftExpr(VC_val(vc),Int_val(amt), + Expr_val(e)))); +} + +value caml_vc_bv32LeftShiftExpr(value vc, value amt, value e) +{ + CAMLparam3(vc,amt,e); + CAMLreturn(alloc_Expr(vc_bv32LeftShiftExpr(VC_val(vc),Int_val(amt), + Expr_val(e)))); +} + +value caml_vc_bv32RightShiftExpr(value vc, value amt, value e) +{ + CAMLparam3(vc,amt,e); + CAMLreturn(alloc_Expr(vc_bv32RightShiftExpr(VC_val(vc),Int_val(amt), + Expr_val(e)))); +} + +value caml_vc_bvVar32LeftShiftExpr(value vc, value she, value e) +{ + CAMLparam3(vc,she,e); + CAMLreturn(alloc_Expr(vc_bvVar32LeftShiftExpr(VC_val(vc),Expr_val(she), + Expr_val(e)))); +} + +value caml_vc_bvVar32RightShiftExpr(value vc, value she, value e) +{ + CAMLparam3(vc,she,e); + CAMLreturn(alloc_Expr(vc_bvVar32RightShiftExpr(VC_val(vc),Expr_val(she), + Expr_val(e)))); +} + +value caml_vc_bvVar32DivByPowOfTwoExpr(value vc, value e, value rhs) +{ + CAMLparam3(vc,e,rhs); + CAMLreturn(alloc_Expr(vc_bvVar32DivByPowOfTwoExpr(VC_val(vc),Expr_val(e), + Expr_val(rhs)))); +} + +value caml_vc_bvExtract(value vc, value e, value hi, value lo) +{ + CAMLparam4(vc,e,hi,lo); + CAMLreturn(alloc_Expr(vc_bvExtract(VC_val(vc),Expr_val(e),Int_val(hi), + Int_val(lo)))); +} + +value caml_vc_bvBoolExtract(value vc, value e, value b) +{ + CAMLparam3(vc,e,b); + CAMLreturn(alloc_Expr(vc_bvBoolExtract(VC_val(vc),Expr_val(e),Int_val(b)))); +} + +value caml_vc_bvSignExtend(value vc, value e, value nb) +{ + CAMLparam3(vc,e,nb); + CAMLreturn(alloc_Expr(vc_bvSignExtend(VC_val(vc),Expr_val(e),Int_val(nb)))); +} + +value caml_vc_bvCreateMemoryArray(value vc, value name) +{ + CAMLparam2(vc,name); + CAMLreturn(alloc_Expr(vc_bvCreateMemoryArray(VC_val(vc),String_val(name)))); +} + +value caml_vc_bvReadMemoryArray(value vc, value arr, value b, value num) +{ + CAMLparam4(vc,arr,b,num); + CAMLreturn(alloc_Expr(vc_bvReadMemoryArray(VC_val(vc), Expr_val(arr), + Expr_val(b), Int_val(num)))); +} + +value caml_vc_bvWriteToMemoryArray(value vc, value arr, value bi, + value e, value num) +{ + CAMLparam5(vc,arr,bi,e,num); + CAMLreturn(alloc_Expr(vc_bvWriteToMemoryArray(VC_val(vc),Expr_val(arr), + Expr_val(bi),Expr_val(e), + Int_val(num)))); +} + +// XXX +// Expr vc_bvConstExprFromLL(VC vc, int n_bits, unsigned long long value) diff --git a/src/optimizer/solver/cvclSolver/cvcl_solver_test.ml b/src/optimizer/solver/cvclSolver/cvcl_solver_test.ml new file mode 100644 index 0000000..9ff5e8d --- /dev/null +++ b/src/optimizer/solver/cvclSolver/cvcl_solver_test.ml @@ -0,0 +1,22 @@ + + +module C = Cvcl + +let test () = + let flags = C.createFlags () in + let vc = C.createVC flags in + let x = C.varExpr vc "x" (C.intType vc) in + let y = C.varExpr vc "y" (C.intType vc) in + let xpy = C.plusExpr vc x y in + let xpygtten = C.gtExpr vc xpy (C.ratExpr vc 10 1) in + let neg = C.notExpr vc xpygtten in + if C.query vc neg <> 1 then + let ces = C.getCounterExample vc in + List.iter (C.printExpr vc) ces + else + print_string "Satisfiable" + + +let _ = test (); + + diff --git a/src/optimizer/solver/cvclSolver/solverInterface.ml b/src/optimizer/solver/cvclSolver/solverInterface.ml new file mode 100644 index 0000000..31f6d20 --- /dev/null +++ b/src/optimizer/solver/cvclSolver/solverInterface.ml @@ -0,0 +1,308 @@ + +(* + * solverInterface.ml + * + * This is the interface of cvcl provided to the Deputy optimizer + * + *) + +open Pretty + +module E = Errormsg +module C = Cvcl +module D = Dsolverfront + +exception NYI of string + +let is_real = true + +let getCounterExample vc () = + let el = C.getCounterExample vc in + List.fold_left (fun l e -> + C.printExpr vc e; + if not(C.isEq e) then begin + ignore(E.log "SI.getCounterExample: not an equality\n"); + l + end else begin + (*ignore(E.log "SI.getCounterExample: %s is a %s, and %s is a %s\n" + (C.exprString (C.getChild e 0)) + (exprKindString vc (C.getChild e 0)) + (C.exprString (C.getChild e 1)) + (exprKindString vc (C.getChild e 1)));*) + (C.exprString (C.getChild e 0), C.getInt (C.getChild e 1)) :: l + end) + [] el + +let isValid vc e : (bool * (string * int) list) = + ignore(E.log "Checking: %s\n" (C.exprString e)); + C.push vc; + let r = C.query vc e in + let ce = if not r then getCounterExample vc () else [] in + C.pop vc; + ignore(E.log "Returned: %s\n" (if r then "valid" else "not valid")); + (r, ce) + +let isValidWithAssumptions vc al e : (bool * (string * int) list) = + ignore(E.log "Checking: %s with assuptions\n" (C.exprString e)); + List.iter (fun a -> ignore(E.log "\t%s\n" (C.exprString a))) al; + C.push vc; + List.iter (C.assertFormula vc) al; + let r = C.query vc e in + ignore(E.log "Returned: %s\n" (if r then "valid" else "not valid")); + let ce = if not r then getCounterExample vc () else [] in + C.pop vc; + (r, ce) + + +let cvcl_bv_translator vc = +{ + D.mkTrue = (fun () -> C.trueExpr vc); + D.mkFalse = (fun () -> C.falseExpr vc); + + D.mkAnd = C.andExpr vc; + D.mkOr = C.orExpr vc; + D.mkNot = C.notExpr vc; + D.mkIte = C.iteExpr vc; + D.mkImp = C.impliesExpr vc; + + D.mkEq = C.eqExpr vc; + D.mkNe = (fun e1 e2 -> C.notExpr vc (C.eqExpr vc e1 e2)); + D.mkLt = C.sbvLtExpr vc; + D.mkLe = C.sbvLeExpr vc; + D.mkGt = C.sbvGtExpr vc; + D.mkGe = C.sbvGeExpr vc; + + D.mkPlus = C.bv32PlusExpr vc; + D.mkTimes = C.bv32MultExpr vc; + D.mkMinus = C.bv32MinusExpr vc; + D.mkDiv = (fun _ _ -> raise(NYI "mkDiv")); + D.mkMod = (fun _ _ -> raise(NYI "mkMod")); + D.mkLShift = C.bvVar32LeftShiftExpr vc; + D.mkRShift = C.bvVar32RightShiftExpr vc; + D.mkBAnd = C.bvAndExpr vc; + D.mkBXor = C.bvXorExpr vc; + D.mkBOr = C.bvOrExpr vc; + + D.mkNeg = C.bvUMinusExpr vc; + D.mkCompl = C.bvXorExpr vc (C.bv32ConstExprFromInt vc 0); + + D.mkVar = (fun s -> C.varExpr vc s (C.bv32Type vc)); + D.mkConst = C.bv32ConstExprFromInt vc; + + D.isValidWithAssumptions = isValidWithAssumptions vc; + D.isValid = isValid vc; +} + +let andExpr vc e1 e2 = + if not(C.compare_exprs e1 (C.falseExpr vc)) || + not(C.compare_exprs e2 (C.falseExpr vc)) + then C.falseExpr vc + else if not(C.compare_exprs e1 (C.trueExpr vc)) + then e2 + else if not(C.compare_exprs e2 (C.trueExpr vc)) + then e1 + else C.andExpr vc e1 e2 + +let orExpr vc e1 e2 = + if not(C.compare_exprs e1 (C.falseExpr vc)) || + not(C.compare_exprs e2 (C.falseExpr vc)) + then C.trueExpr vc + else if not(C.compare_exprs e1 (C.falseExpr vc)) + then e2 + else if not(C.compare_exprs e2 (C.falseExpr vc)) + then e1 + else C.orExpr vc e1 e2 + +let notExpr vc e = + if not(C.compare_exprs e (C.falseExpr vc)) + then C.trueExpr vc + else if not(C.compare_exprs e (C.trueExpr vc)) + then C.falseExpr vc + else C.notExpr vc e + +let iteExpr vc e1 e2 e3 = + if not(C.compare_exprs e1 (C.trueExpr vc)) + then e2 + else if not(C.compare_exprs e1 (C.falseExpr vc)) + then e3 + else C.iteExpr vc e1 e2 e3 + +let impliesExpr vc e1 e2 = + if not(C.compare_exprs e1 (C.trueExpr vc)) + then e2 + else if not(C.compare_exprs e1 (C.falseExpr vc)) + then C.trueExpr vc + else C.impliesExpr vc e1 e2 + + +let eqExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + if e1 = e2 + then C.trueExpr vc + else C.falseExpr vc + else C.eqExpr vc e1 e2 + +let neExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + if not(e1 = e2) + then C.trueExpr vc + else C.falseExpr vc + else C.notExpr vc (C.eqExpr vc e1 e2) + +let ltExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + if e1 < e2 + then C.trueExpr vc + else C.falseExpr vc + else C.ltExpr vc e1 e2 + +let leExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + if e1 <= e2 + then C.trueExpr vc + else C.falseExpr vc + else C.leExpr vc e1 e2 + +let gtExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + if e1 > e2 + then C.trueExpr vc + else C.falseExpr vc + else C.gtExpr vc e1 e2 + +let geExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + if e1 >= e2 + then C.trueExpr vc + else C.falseExpr vc + else C.geExpr vc e1 e2 + +let plusExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + C.ratExpr vc (e1 + e2) 1 + else C.plusExpr vc e1 e2 + +let timesExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + C.ratExpr vc (e1 * e2) 1 + else C.multExpr vc e1 e2 + +let minusExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + C.ratExpr vc (e1 - e2) 1 + else C.minusExpr vc e1 e2 + +let divideExpr vc e1 e2 = + if C.isConst e1 && C.isConst e2 then + let e1 = C.getInt e1 in + let e2 = C.getInt e2 in + C.ratExpr vc (e1 / e2) 1 + else C.divideExpr vc e1 e2 + +let uminusExpr vc e = + if C.isConst e then + let e = C.getInt e in + C.ratExpr vc (-e) 1 + else C.uminusExpr vc e + +let exprKindString vc e = + C.getKindString vc (C.getKind e) + +let cvcl_translator vc = +{ + D.mkTrue = (fun () -> C.trueExpr vc); + D.mkFalse = (fun () -> C.falseExpr vc); + + D.mkAnd = andExpr vc; + D.mkOr = orExpr vc; + D.mkNot = notExpr vc; + D.mkIte = iteExpr vc; + D.mkImp = impliesExpr vc; + + D.mkEq = eqExpr vc; + D.mkNe = neExpr vc; + D.mkLt = ltExpr vc; + D.mkLe = leExpr vc; + D.mkGt = gtExpr vc; + D.mkGe = geExpr vc; + + D.mkPlus = plusExpr vc; + D.mkTimes = timesExpr vc; + D.mkMinus = minusExpr vc; + D.mkDiv = divideExpr vc; + D.mkMod = (fun _ _ -> raise(NYI "mkMod")); + D.mkLShift = (fun _ _ -> raise(NYI "mkLShift")); + D.mkRShift = (fun _ _ -> raise(NYI "mkRShift")); + D.mkBAnd = (fun _ _ -> raise(NYI "mkBAnd")); + D.mkBXor = (fun _ _ -> raise(NYI "mkBXor")); + D.mkBOr = (fun _ _ -> raise(NYI "mkBOr")); + + D.mkNeg = uminusExpr vc; + D.mkCompl = (fun _ -> raise(NYI "mkCompl")); + + D.mkVar = (fun s -> C.varExpr vc s (C.intType vc)); + D.mkConst = (fun i -> C.ratExpr vc i 1); + + D.isValidWithAssumptions = isValidWithAssumptions vc; + D.isValid = isValid vc; +} + +let curVC = ref None + +let getBVTranslator rl = + match !curVC with + | Some vc -> cvcl_bv_translator vc + | None -> begin + let flags = C.createFlags () in + let vc = C.createVC flags in + C.setResourceLimit vc rl; + curVC := (Some vc); + cvcl_bv_translator vc + end + +(* rl is the resource limit for the solver if supported. + * rl = 0 => no limits + * rl = 1 => don't use this. + * rl >= 2 => OK *) +let getTranslator (rl : int) = + match !curVC with + | Some vc -> cvcl_translator vc + | None -> begin + let flags = C.createFlags () in + let vc = C.createVC flags in + C.setResourceLimit vc rl; + curVC := (Some vc); + cvcl_translator vc + end + +(* This is the interface exposed to doptim.ml *) +(* check if (e1 op e2) is valid in state s *) +(* +let valid s op e1 e2 = + ignore(E.log "calling the solver: %a + ignore(E.log "the solver raised an exception: %s\n" s); + false +*) diff --git a/src/optimizer/solver/nullSolver/solverInterface.ml b/src/optimizer/solver/nullSolver/solverInterface.ml new file mode 100644 index 0000000..726417d --- /dev/null +++ b/src/optimizer/solver/nullSolver/solverInterface.ml @@ -0,0 +1,17 @@ +(* + * solverInterface.ml + * + * This is the interface of a null solver provided to the Deputy optimizer + * + *) + +exception NYI of string + +let is_real = false + +let getTranslator (rl : int) = raise(NYI "null solver") + +(* This is the interface exposed to doptim.ml *) +(* check if (e1 op e2) is valid in state s *) +let valid s op e1 e2 = raise(NYI "null solver") + diff --git a/src/optimizer/solver/yicesSolver/Makefile b/src/optimizer/solver/yicesSolver/Makefile new file mode 100644 index 0000000..f867d8f --- /dev/null +++ b/src/optimizer/solver/yicesSolver/Makefile @@ -0,0 +1,69 @@ +# Makefile for yices_sover_test.ml +# + + +ifndef ARCHOS + ARCHOS = x86_LINUX +endif + +all: + $(MAKE) yices_solver_test + $(MAKE) yices_solver_test NATIVECAML=1 + +# +# If you've done a 'make install' with cvc lite, then +# the defaults below should work. Otherwise setting the +# environment variables as below should work. +# +# for example on a x86 linux machine +# YICESLIB = /path/to/yices/lib +# YICESINC = /path/to/yices/include +# +ifndef YICESLIB + CVCLLIB = /usr/local/lib +endif +ifndef YICESINC + CVCLINC = /usr/local/include +endif +ifndef OCAMLINC + OCAMLINC = /usr/lib/ocaml +endif + +OBJDIR = obj/$(ARCHOS) +DEPENDDIR = obj/.depend + + +SOURCEDIRS = . + +MODULES = yices yices_solver_test + +COMPILEFLAGS = +LINKFLAGS = + + +ENDLINKFLAGS = -cclib -L$(YICESLIB) -cclib -lyices -cclib -lstdc++ -cclib -lgmp + +CAML_CFLAGS += -ccopt -I$(OCAMLINC) -ccopt -I$(YICESINC) + +include ../../../../cil/ocamlutil/Makefile.ocaml + +PROJECT_EXECUTABLE = $(OBJDIR)/yices_test$(EXE) +PROJECT_MODULES = $(MODULES) + +PROJECT_CMODULES = yices_ocaml_wrappers + +PROJECT_LIBS = unix str + +$(PROJECT_EXECUTABLE) : $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC)) + @$(NARRATIVE) "Linking $(COMPILETOWHAT) $@ $(LINKMSG)" + $(AT)$(CAMLLINK) -verbose -o $@ \ + $(PROJECT_LIBS:%=%.$(CMXA)) \ + $(PROJECT_MODULES:%=$(OBJDIR)/%.$(CMO)) \ + $(PROJECT_CMODULES:%=$(OBJDIR)/%.$(CMC)) \ + $(ENDLINKFLAGS) + +yices_solver_test: $(PROJECT_EXECUTABLE) + +clean: + rm -f $(OBJDIR)/*.* $(DEPENDDIR)/*.* diff --git a/src/optimizer/solver/yicesSolver/solverInterface.ml b/src/optimizer/solver/yicesSolver/solverInterface.ml new file mode 100644 index 0000000..77cf972 --- /dev/null +++ b/src/optimizer/solver/yicesSolver/solverInterface.ml @@ -0,0 +1,182 @@ +(* + * solverInterface.ml + * + * This is the interface of yices provided to the Deputy optimizer + * + *) + +open Pretty + +module E = Errormsg +module Y = Yices +module D = Dsolverfront + +exception NYI of string + +let is_real = true + +let andExpr yc e1 e2 = + Y.mk_and yc [e1;e2] 2 + +let orExpr yc e1 e2 = + Y.mk_or yc [e1;e2] 2 + +let notExpr yc e1 = + Y.mk_not yc e1 + +let iteExpr yc e1 e2 e3 = + Y.mk_ite yc e1 e2 e3 + +let impliesExpr yc e1 e2 = + orExpr yc (notExpr yc e1) e2 + +let eqExpr yc e1 e2 = + Y.mk_eq yc e1 e2 + +let neExpr yc e1 e2 = + Y.mk_diseq yc e1 e2 + +let ltExpr yc e1 e2 = + Y.mk_lt yc e1 e2 + +let leExpr yc e1 e2 = + Y.mk_le yc e1 e2 + +let gtExpr yc e1 e2 = + Y.mk_gt yc e1 e2 + +let geExpr yc e1 e2 = + Y.mk_ge yc e1 e2 + +let plusExpr yc e1 e2 = + Y.mk_sum yc [e1;e2] 2 + +let minusExpr yc e1 e2 = + Y.mk_sub yc [e1;e2] 2 + +let timesExpr yc e1 e2 = + Y.mk_mul yc [e1;e2] 2 + +let uminusExpr yc e = + Y.mk_sub yc [(Y.mk_num yc 0);e] 2 + +let varExpr yc name = + match Y.get_var_decl_from_name yc name with + | [] -> begin + Y.mk_var_from_decl yc (Y.mk_var_decl yc name (Y.mk_type yc "int")) + end + | vd :: _ -> Y.mk_var_from_decl yc vd + +let isValidWithAssumptions yc el e : (bool * (string * int) list) = + Y.push_context yc; + List.iter (Y.assert_expr yc) el; + Y.assert_expr yc (notExpr yc e); + Y.dump_context yc; + match Y.check_context yc with + | 1 -> begin + ignore(E.log "SI: valid\n"); + let m = Y.get_model yc in + match m with + | [] -> begin + ignore(E.log "SI: model not available\n"); + (false, []) + end + | m :: _ -> begin + ignore(E.log "SI: model available:\n"); + (*Y.display_model m;*) + let it = Y.create_var_decl_iterator yc in + let rec loop sil = + if Y.iterator_has_next it then begin + let vd = Y.iterator_next it in + let (res,v) = Y.get_int_value m vd in + if res then begin + let name = Y.get_var_decl_name vd in + ignore(E.log "SI: model: %s -> %d\n" name v); + loop ((name,v)::sil) + end else begin + let name = Y.get_var_decl_name vd in + ignore(E.log "SI: model: %s -> undef\n" name); + loop sil + end + end else begin + ignore(E.log "SI:model: done\n"); + sil + end + in + let sil = loop [] in + Y.del_iterator it; + Y.pop_context yc; + (false, sil) + end + end + | 0 -> begin + ignore(E.log "SI: invalid\n"); + Y.pop_context yc; + (true, []) + end + | -1 -> begin + ignore(E.log "SI: unknown\n"); + Y.pop_context yc; + (false, []) + end + | _ -> begin + ignore(E.log "SI: error\n"); + Y.pop_context yc; + (false, []) + end + +let isValid yc e = isValidWithAssumptions yc [] e + +let yices_translator yc = +{ + D.mkTrue = (fun () -> Y.mk_true yc); + D.mkFalse = (fun () -> Y.mk_false yc); + + D.mkAnd = andExpr yc; + D.mkOr = orExpr yc; + D.mkNot = notExpr yc; + D.mkIte = iteExpr yc; + D.mkImp = impliesExpr yc; + + D.mkEq = eqExpr yc; + D.mkNe = neExpr yc; + D.mkLt = ltExpr yc; + D.mkLe = leExpr yc; + D.mkGt = gtExpr yc; + D.mkGe = geExpr yc; + + D.mkPlus = plusExpr yc; + D.mkTimes = timesExpr yc; + D.mkMinus = minusExpr yc; + D.mkDiv = (fun _ _ -> raise(NYI "mkDiv")); + D.mkMod = (fun _ _ -> raise(NYI "mkMod")); + D.mkLShift = (fun _ _ -> raise(NYI "mkLShift")); + D.mkRShift = (fun _ _ -> raise(NYI "mkRShift")); + D.mkBAnd = (fun _ _ -> raise(NYI "mkBAnd")); + D.mkBXor = (fun _ _ -> raise(NYI "mkBXor")); + D.mkBOr = (fun _ _ -> raise(NYI "mkBOr")); + + D.mkNeg = uminusExpr yc; + D.mkCompl = (fun _ -> raise(NYI "mkCompl")); + + D.mkVar = varExpr yc; + D.mkConst = (fun i -> Y.mk_num yc i); + + D.isValidWithAssumptions = isValidWithAssumptions yc; + D.isValid = isValid yc; +} + +let curYC = ref None + +let getTranslator (rl : int) = + match !curYC with + | Some yc -> yices_translator yc + | None -> begin + Y.set_arith_only true; + Y.enable_log_file "yices.log.txt"; + let yc = Y.mk_context () in + curYC := (Some yc); + yices_translator yc + end + +let valid s op e1 e2 = raise(NYI "valid") diff --git a/src/optimizer/solver/yicesSolver/yices.ml b/src/optimizer/solver/yicesSolver/yices.ml new file mode 100644 index 0000000..b1bffd7 --- /dev/null +++ b/src/optimizer/solver/yicesSolver/yices.ml @@ -0,0 +1,195 @@ +(* + * yices.ml + * + * This file contains external declarations for + * calls into yices. + * + *) + +type yices_expr +type yices_type +type yices_var_decl +type yices_context +type yices_model +type yices_var_decl_iterator +type yices_ast + + +(* + * Set some options + *) +external set_verbosity : int -> unit = "caml_yices_set_verbosity" +external version : unit -> string = "caml_yices_version" +external set_max_num_conflicts_in_maxsat_iteration : int -> unit = + "caml_yices_set_max_num_conflicts_in_maxsat_iteration" +external enable_type_checker : bool -> unit = "caml_yices_enable_type_checker" +external set_max_num_iterations_in_maxsat : int -> unit = + "caml_yices_set_max_num_iterations_in_maxsat" +external set_maxsat_initial_cost : int64 -> unit = + "caml_yices_set_maxsat_initial_cost" +external set_arith_only : bool -> unit = "caml_yices_set_arith_only" +external enable_log_file : string -> unit = "caml_yices_enable_log_file" + +(* + * Context manipulation + *) +external mk_context : unit -> yices_context = "caml_yices_mk_context" +external del_context : yices_context -> unit = "caml_yices_del_context" +external reset_context : yices_context -> unit = "caml_yices_reset" +external dump_context : yices_context -> unit = "caml_yices_dump_context" +external push_context : yices_context -> unit = "caml_yices_push" +external pop_context : yices_context -> unit = "caml_yices_pop" +external assert_expr : yices_context -> yices_expr -> unit = + "caml_yices_assert" +external assert_expr_weighted : yices_context -> yices_expr -> int64 -> int = + "caml_yices_assert_weighted" +external assert_expr_retractable : yices_context -> yices_expr -> int = + "caml_yices_assert_retractable" +external retract_expr : yices_context -> int -> unit = "caml_yices_retract" +external inconsistent_context : yices_context -> bool = "caml_yices_inconsistent" +external check_context : yices_context -> int = "caml_yices_check" +external find_weighted_model : yices_context -> int -> int = + "caml_yices_find_weighted_model" +external max_sat : yices_context -> int = "caml_yices_max_sat" +external max_sat_cost_leq : yices_context -> int64 -> int = + "caml_yices_max_sat_cost_leq" +external get_model : yices_context -> yices_model list = "caml_yices_get_model" + +(* + * Functions for Models + *) +external get_value : yices_model -> yices_var_decl -> int = + "caml_yices_get_value" +external get_int_value : yices_model -> yices_var_decl -> (bool * int) = + "caml_yices_get_int_value" +external get_arith_value : yices_model -> yices_var_decl -> (bool * int * int) = + "caml_yices_get_arith_value" +external get_double_value : yices_model -> yices_var_decl -> (bool * float) = + "caml_yices_get_double_value" +external get_bitvector_value : yices_model -> yices_var_decl -> int -> (bool * int array) = + "caml_yices_get_bitvector_value" +external get_assertion_value : yices_model -> int -> int = + "caml_yices_get_assertion_value" +external display_model : yices_model -> unit = "caml_yices_display_model" +external get_cost : yices_model -> int64 = "caml_yices_get_cost" +external get_cost_as_double : yices_model -> float = + "caml_yices_get_cost_as_double" + +(* + * Expression Building + *) +external mk_true : yices_context -> yices_expr = "caml_yices_mk_true" +external mk_false : yices_context -> yices_expr = "caml_yices_mk_false" +external mk_bool_var : yices_context -> string -> yices_expr = + "caml_yices_mk_bool_var" +external mk_fresh_bool_var : yices_context -> yices_expr = + "caml_yices_mk_fresh_bool_var" +external get_var_decl : yices_expr -> yices_var_decl = "caml_yices_get_var_decl" +external mk_bool_var_decl : yices_context -> string -> yices_var_decl = + "caml_yices_mk_bool_var_decl" +external get_var_decl_name : yices_var_decl -> string = + "caml_yices_get_var_decl_name" +external mk_bool_var_from_decl : yices_context -> yices_var_decl -> yices_expr = + "caml_yices_mk_bool_var_from_decl" +external mk_or : yices_context -> yices_expr list -> int -> yices_expr = + "caml_yices_mk_or" +external mk_and : yices_context -> yices_expr list -> int -> yices_expr = + "caml_yices_mk_and" +external mk_eq : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_eq" +external mk_diseq : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_diseq" +external mk_ite : yices_context -> yices_expr -> yices_expr -> yices_expr -> + yices_expr = "caml_yices_mk_ite" +external mk_not : yices_context -> yices_expr -> yices_expr = + "caml_yices_mk_not" +external create_var_decl_iterator : yices_context -> yices_var_decl_iterator = + "caml_yices_create_var_decl_iterator" +external iterator_has_next : yices_var_decl_iterator -> bool = + "caml_yices_iterator_has_next" +external iterator_next : yices_var_decl_iterator -> yices_var_decl = + "caml_yices_iterator_next" +external iterator_reset : yices_var_decl_iterator -> unit = + "caml_yices_iterator_reset" +external del_iterator : yices_var_decl_iterator -> unit = + "caml_yices_del_iterator" +external mk_type : yices_context -> string -> yices_type = "caml_yices_mk_type" +external mk_bv_type : yices_context -> int -> yices_type = + "caml_yices_mk_bitvector_type" +external mk_var_decl : yices_context -> string -> yices_type -> yices_var_decl = + "caml_yices_mk_var_decl" +external mk_var_from_decl : yices_context -> yices_var_decl -> yices_expr = + "caml_yices_mk_var_from_decl" +external get_var_decl_from_name : yices_context -> string -> yices_var_decl list = + "caml_yices_get_var_decl_from_name" +external mk_num : yices_context -> int -> yices_expr = "caml_yices_mk_num" +external mk_num_from_string : yices_context -> string -> yices_expr = + "caml_yices_mk_num_from_string" +external mk_sum : yices_context -> yices_expr list -> int -> yices_expr = + "caml_yices_mk_sum" +external mk_sub : yices_context -> yices_expr list -> int -> yices_expr = + "caml_yices_mk_sub" +external mk_mul : yices_context -> yices_expr list -> int -> yices_expr = + "caml_yices_mk_mul" +external mk_lt : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_lt" +external mk_le : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_le" +external mk_gt : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_gt" +external mk_ge : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_ge" + +(* + * Bit-vector expression construction + *) +external mk_bv_constant : yices_context -> int -> int -> yices_expr = + "caml_yices_mk_bv_constant" +external mk_bv_add : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_add" +external mk_bv_sub : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_sub" +external mk_bv_mul : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_mul" +external mk_bv_minus : yices_context -> yices_expr -> yices_expr = + "caml_yices_mk_bv_minus" +external mk_bv_concat : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_concat" +external mk_bv_and : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_and" +external mk_bv_or : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_or" +external mk_bv_xor : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_mk_bv_xor" +external mk_bv_not : yices_context -> yices_expr -> yices_expr = + "caml_yices_mk_bv_not" +external mk_bv_extract : yices_context -> int -> int -> yices_expr = + "caml_yices_mk_bv_extract" +external mk_bv_sign_extend : yices_context -> yices_expr -> int -> yices_expr = + "caml_yices_mk_bv_sign_extend" +external mk_bv_shift_left0 : yices_context -> yices_expr -> int -> yices_expr = + "caml_yices_bv_shift_left0" +external mk_bv_shift_left1 : yices_context -> yices_expr -> int -> yices_expr = + "caml_yices_bv_shift_left1" +external mk_bv_shift_right0 : yices_context -> yices_expr -> int -> yices_expr = + "caml_yices_bv_shift_right0" +external mk_bv_shift_right1 : yices_context -> yices_expr -> int -> yices_expr = + "caml_yices_bv_shift_right1" +external mk_bv_lt : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_lt" +external mk_bv_le : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_le" +external mk_bv_gt : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_gt" +external mk_bv_ge : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_ge" +external mk_bv_slt : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_slt" +external mk_bv_sle : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_sle" +external mk_bv_sgt : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_sgt" +external mk_bv_sge : yices_context -> yices_expr -> yices_expr -> yices_expr = + "caml_yices_bv_sge" + +external pp_expr : yices_expr -> unit = "caml_yices_pp_expr" diff --git a/src/optimizer/solver/yicesSolver/yices_ocaml_wrappers.c b/src/optimizer/solver/yicesSolver/yices_ocaml_wrappers.c new file mode 100644 index 0000000..ec6a510 --- /dev/null +++ b/src/optimizer/solver/yicesSolver/yices_ocaml_wrappers.c @@ -0,0 +1,1015 @@ +/* + +yices_ocaml_wrappers.c + +This file contains wrappers for the C interface to yices +that are callable from ocaml code. + +Search for XXX to find unimplemented things + +*/ + +#include +#include +#include +#include +#include + +/************************************************************ + +Structures that tell the ocaml runtime how to deal with +things of abstract types that we will ll be passing it. + +************************************************************/ + +/* Encapsulation of yices_expr + as Caml custom blocks. */ +static struct custom_operations yices_expr_ops = { + "Yices.yices_expr", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of yices_type + as Caml custom blocks. */ +static struct custom_operations yices_type_ops = { + "Yices.yices_type", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of yices_var_decl + as Caml custom blocks. */ +static struct custom_operations yices_var_decl_ops = { + "Yices.yices_var_decl", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of yices_context + as Caml custom blocks. */ +static struct custom_operations yices_context_ops = { + "Yices.yices_context", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of yices_model + as Caml custom blocks. */ +static struct custom_operations yices_model_ops = { + "Yices.yices_model", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + +/* Encapsulation of yices_var_decl_iterator + as Caml custom blocks. */ +static struct custom_operations yices_var_decl_iterator_ops = { + "Yices.yices_var_decl_iterator", + custom_finalize_default, + custom_compare_default, + custom_hash_default, + custom_serialize_default, + custom_deserialize_default +}; + + +/************************************************************ + +Functions for wrapping and unwrapping ocaml values for the +abstract types above. + +************************************************************/ + +/* Accessing the relevant part of a Caml custom block */ +#define yices_expr_val(v) (*((yices_expr *) Data_custom_val(v))) +#define yices_type_val(v) (*((yices_type *) Data_custom_val(v))) +#define yices_var_decl_val(v) (*((yices_var_decl *) Data_custom_val(v))) +#define yices_context_val(v) (*((yices_context *) Data_custom_val(v))) +#define yices_model_val(v) (*((yices_model *) Data_custom_val(v))) +#define yices_var_decl_iterator_val(v) (*((yices_var_decl_iterator *) Data_custom_val(v))) + +/* Allocating a Caml custom block to hold the given CVCL structure */ +static value alloc_yices_expr(yices_expr ye) +{ + value v = alloc_custom(&yices_expr_ops, sizeof(yices_expr), 0, 1); + yices_expr_val(v) = ye; + return v; +} + +static value alloc_yices_type(yices_type t) +{ + value v = alloc_custom(&yices_type_ops, sizeof(yices_type), 0, 1); + yices_type_val(v) = t; + return v; +} + +static value alloc_yices_var_decl(yices_var_decl vd) +{ + value v = alloc_custom(&yices_var_decl_ops, sizeof(yices_var_decl), 0, 1); + yices_var_decl_val(v) = vd; + return v; +} + +static value alloc_yices_context(yices_context ctxt) +{ + value v = alloc_custom(&yices_context_ops, sizeof(yices_context), 0, 1); + yices_context_val(v) = ctxt; + return v; +} + +static value alloc_yices_model(yices_model m) +{ + value v = alloc_custom(&yices_model_ops, sizeof(yices_model), 0, 1); + yices_model_val(v) = m; + return v; +} + +static value alloc_yices_var_decl_iterator(yices_var_decl_iterator vdi) +{ + value v = alloc_custom(&yices_var_decl_iterator_ops, + sizeof(yices_var_decl_iterator), 0, 1); + yices_var_decl_iterator_val(v) = vdi; + return v; +} + + +/************************************************************ + +Wrappers + +************************************************************/ + +value caml_yices_set_verbosity(value i) +{ + CAMLparam1(i); + yices_set_verbosity(Int_val(i)); + CAMLreturn(Val_unit); +} + +value caml_yices_version(value unit) +{ + CAMLparam1(unit); + CAMLlocal1(r); + r = caml_copy_string(yices_version()); + CAMLreturn(r); +} + +value caml_yices_set_max_num_conflicts_in_maxsat_iteration(value n) +{ + CAMLparam1(n); + yices_set_max_num_conflicts_in_maxsat_iteration(Int_val(n)); + CAMLreturn(Val_unit); +} + +value caml_yices_enable_type_checker(value flag) +{ + CAMLparam1(flag); + yices_enable_type_checker(Int_val(flag)); + CAMLreturn(Val_unit); +} + +value caml_yices_set_max_num_iterations_in_maxsat(value n) +{ + CAMLparam1(n); + yices_set_max_num_iterations_in_maxsat(Int_val(n)); + CAMLreturn(Val_unit); +} + +value caml_yices_set_maxsat_initial_cost(value c) +{ + CAMLparam1(c); + yices_set_maxsat_initial_cost(Int64_val(c)); + CAMLreturn(Val_unit); +} + +value caml_yices_set_arith_only(value flag) +{ + CAMLparam1(flag); + yices_set_arith_only(Int_val(flag)); + CAMLreturn(Val_unit); +} + +value caml_yices_enable_log_file(value fname) +{ + CAMLparam1(fname); + yices_enable_log_file(String_val(fname)); + CAMLreturn(Val_unit); +} + +value caml_yices_mk_context(value unit) +{ + CAMLparam1(unit); + CAMLreturn(alloc_yices_context(yices_mk_context())); +} + +value caml_yices_del_context(value yc) +{ + CAMLparam1(yc); + yices_del_context(yices_context_val(yc)); + CAMLreturn(Val_unit); +} + +value caml_yices_reset(value yc) +{ + CAMLparam1(yc); + yices_reset(yices_context_val(yc)); + CAMLreturn(Val_unit); +} + +value caml_yices_dump_context(value yc) +{ + CAMLparam1(yc); + yices_dump_context(yices_context_val(yc)); + CAMLreturn(Val_unit); +} + +value caml_yices_push(value yc) +{ + CAMLparam1(yc); + yices_push(yices_context_val(yc)); + CAMLreturn(Val_unit); +} + +value caml_yices_pop(value yc) +{ + CAMLparam1(yc); + yices_pop(yices_context_val(yc)); + CAMLreturn(Val_unit); +} + +value caml_yices_assert(value yc, value expr) +{ + CAMLparam2(yc, expr); + yices_assert(yices_context_val(yc), yices_expr_val(expr)); + CAMLreturn(Val_unit); +} + +value caml_yices_assert_weighted(value yc, value expr, value w) +{ + CAMLparam3(yc,expr,w); + CAMLreturn(Val_int(yices_assert_weighted(yices_context_val(yc),yices_expr_val(expr), + Int64_val(w)))); +} + +value caml_yices_assert_retractable(value yc, value expr) +{ + CAMLparam2(yc,expr); + CAMLreturn(Val_int(yices_assert_retractable(yices_context_val(yc), + yices_expr_val(expr)))); +} + +value caml_yices_retract(value yc, value id) +{ + CAMLparam2(yc, id); + yices_retract(yices_context_val(yc), Int_val(id)); + CAMLreturn(Val_unit); +} + +value caml_yices_inconsistent(value yc) +{ + CAMLparam1(yc); + CAMLreturn(Val_int(yices_inconsistent(yices_context_val(yc)))); +} + +value caml_yices_check(value yc) +{ + int cr = -1; + lbool r; + + CAMLparam1(yc); + r = yices_check(yices_context_val(yc)); + switch(r) { + case l_true: cr = 1; break; + case l_false: cr = 0; break; + case l_undef: cr = -1; break; + } + + CAMLreturn(Val_int(cr)); +} + +value caml_yices_find_weighted_model(value yc, value r) +{ + int cr = -1; + lbool res; + + CAMLparam2(yc,r); + res = yices_find_weighted_model(yices_context_val(yc), Int_val(r)); + switch(res) { + case l_true: cr = 1; break; + case l_false: cr = 0; break; + case l_undef: cr = -1; break; + } + + CAMLreturn(Int_val(cr)); +} + +value caml_yices_max_sat(value yc) +{ + int cr = -1; + lbool r; + + CAMLparam1(yc); + r = yices_max_sat(yices_context_val(yc)); + switch(r) { + case l_true: cr = 1; break; + case l_false: cr = 0; break; + case l_undef: cr = -1; break; + } + + CAMLreturn(Int_val(cr)); +} + +value caml_yices_max_sat_cost_leq(value yc, value max) +{ + int cr = -1; + lbool r; + + CAMLparam2(yc, max); + r = yices_max_sat_cost_leq(yices_context_val(yc),Int64_val(max)); + switch(r) { + case l_true: cr = 1; break; + case l_false: cr = 0; break; + case l_undef: cr = -1; break; + } + + CAMLreturn(Int_val(cr)); +} + +value caml_yices_get_model(value yc) +{ + yices_model m; + + CAMLparam1(yc); + CAMLlocal1(res); + + m = yices_get_model(yices_context_val(yc)); + if( m ) { + res = caml_alloc_tuple(2); + Store_field(res, 0, alloc_yices_model(m)); + Store_field(res, 1, Int_val(0)); + } + else { + res = Int_val(0); + } + + CAMLreturn(res); +} + +value caml_yices_get_value(value m, value vd) +{ + int cr = -1; + lbool r; + + CAMLparam2(m, vd); + r = yices_get_value(yices_model_val(m), yices_var_decl_val(vd)); + switch(r) { + case l_true: cr = 1; break; + case l_false: cr = 0; break; + case l_undef: cr = -1; break; + } + + CAMLreturn(Int_val(cr)); +} + +value caml_yices_get_int_value(value m, value vd) +{ + long val; + int res; + + CAMLparam2(m, vd); + CAMLlocal1(r); + res = yices_get_int_value(yices_model_val(m), yices_var_decl_val(vd), &val); + r = caml_alloc_tuple(2); + Store_field(r, 0, Int_val(res)); + Store_field(r, 1, Long_val(val)); + + CAMLreturn(r); +} + +value caml_yices_get_arith_value(value m, value vd) +{ + long num, den; + int res; + + CAMLparam2(m, vd); + CAMLlocal1(r); + res = yices_get_arith_value(yices_model_val(m), yices_var_decl_val(vd), + &num, &den); + r = caml_alloc_tuple(3); + Store_field(r, 0, Int_val(res)); + Store_field(r, 1, Long_val(num)); + Store_field(r, 2, Long_val(den)); + + CAMLreturn(r); +} + +value caml_yices_get_double_value(value m, value vd) +{ + double val; + int res; + + CAMLparam2(m, vd); + CAMLlocal1(r); + res = yices_get_double_value(yices_model_val(m), yices_var_decl_val(vd), &val); + r = caml_alloc_tuple(2); + Store_field(r, 0, Int_val(res)); + Store_field(r, 1, caml_copy_double(val)); + + CAMLreturn(r); +} + +value caml_yices_get_bitvector_value(value m, value vd, value n) +{ + int *bv; + int res; + int i; + + CAMLparam3(m, vd, n); + CAMLlocal2(cbv, cr); + bv = (int *)malloc(Int_val(n) * sizeof(int)); + res = yices_get_bitvector_value(yices_model_val(m), yices_var_decl_val(vd), + Int_val(n), bv); + cbv = caml_alloc_tuple(n); + for(i = 0; i < n; i++) { + Store_field(cbv, i, Int_val(bv[i])); + } + free(bv); + cr = caml_alloc_tuple(2); + Store_field(cr, 0, Int_val(res)); + Store_field(cr, 1, cbv); + + CAMLreturn(cr); +} + +value caml_yices_get_assertion_value(value m, value id) +{ + CAMLparam2(m, id); + CAMLreturn(Val_int(yices_get_assertion_value(yices_model_val(m),Int_val(id)))); +} + +value caml_yices_display_model(value m) +{ + CAMLparam1(m); + yices_display_model(yices_model_val(m)); + CAMLreturn(Val_unit); +} + +value caml_yices_get_cost(value m) +{ + CAMLparam1(m); + CAMLreturn(caml_copy_int64(yices_get_cost(yices_model_val(m)))); +} + +value caml_yices_get_cost_as_double(value m) +{ + CAMLparam1(m); + CAMLreturn(caml_copy_double(yices_get_cost_as_double(yices_model_val(m)))); +} + +/* + * Expression Building + * + * + */ + +value caml_yices_mk_true(value yc) +{ + CAMLparam1(yc); + CAMLreturn(alloc_yices_expr(yices_mk_true(yices_context_val(yc)))); +} + +value caml_yices_mk_false(value yc) +{ + CAMLparam1(yc); + CAMLreturn(alloc_yices_expr(yices_mk_false(yices_context_val(yc)))); +} + +value caml_yices_mk_bool_var(value yc, value name) +{ + CAMLparam2(yc, name); + CAMLreturn(alloc_yices_expr(yices_mk_bool_var(yices_context_val(yc), + String_val(name)))); +} + +value caml_yices_mk_fresh_bool_var(value yc) +{ + CAMLparam1(yc); + CAMLreturn(alloc_yices_expr(yices_mk_fresh_bool_var(yices_context_val(yc)))); +} + +value caml_yices_get_var_decl(value ye) +{ + CAMLparam1(ye); + CAMLreturn(alloc_yices_var_decl(yices_get_var_decl(yices_expr_val(ye)))); +} + +value caml_yices_mk_bool_var_decl(value yc, value name) +{ + CAMLparam2(yc,name); + CAMLreturn(alloc_yices_var_decl(yices_mk_bool_var_decl(yices_context_val(yc), + String_val(name)))); +} + +value caml_yices_get_var_decl_name(value vd) +{ + CAMLparam1(vd); + CAMLreturn(caml_copy_string(yices_get_var_decl_name(yices_var_decl_val(vd)))); +} + +value caml_yices_mk_bool_var_from_decl(value yc, value vd) +{ + CAMLparam2(yc,vd); + CAMLreturn(alloc_yices_expr(yices_mk_bool_var_from_decl(yices_context_val(yc), + yices_var_decl_val(vd)))); +} + +value caml_yices_mk_or(value yc, value args, value n) +{ + yices_expr *cargs; + yices_expr res; + int i = 0; + + CAMLparam3(yc, args, n); + CAMLlocal1(tmp); + + cargs = (yices_expr *)malloc(Int_val(n) * sizeof(yices_expr)); + tmp = args; + while(Int_val(tmp) != 0 && i < n) { + cargs[i] = yices_expr_val(Field(tmp, 0)); + tmp = Field(tmp, 1); + i++; + } + res = yices_mk_or(yices_context_val(yc), cargs, Int_val(n)); + free(cargs); + + CAMLreturn(alloc_yices_expr(res)); +} + +value caml_yices_mk_and(value yc, value args, value n) +{ + yices_expr *cargs; + yices_expr res; + int i = 0; + + CAMLparam3(yc, args, n); + CAMLlocal1(tmp); + + cargs = (yices_expr *)malloc(Int_val(n) * sizeof(yices_expr)); + tmp = args; + while(Int_val(tmp) != 0 && i < n) { + cargs[i] = yices_expr_val(Field(tmp, 0)); + tmp = Field(tmp, 1); + i++; + } + res = yices_mk_and(yices_context_val(yc), cargs, Int_val(n)); + free(cargs); + + CAMLreturn(alloc_yices_expr(res)); +} + +value caml_yices_mk_eq(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_eq(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_diseq(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_diseq(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_ite(value yc, value c, value t, value e) +{ + CAMLparam4(yc, c, t, e); + CAMLreturn(alloc_yices_expr(yices_mk_ite(yices_context_val(yc), + yices_expr_val(c), + yices_expr_val(t), + yices_expr_val(e)))); +} + +value caml_yices_mk_not(value yc, value e) +{ + CAMLparam2(yc, e); + CAMLreturn(alloc_yices_expr(yices_mk_not(yices_context_val(yc), + yices_expr_val(e)))); +} + +value caml_yices_create_var_decl_iterator(value yc) +{ + CAMLparam1(yc); + CAMLreturn(alloc_yices_var_decl_iterator(yices_create_var_decl_iterator( + yices_context_val(yc)))); +} + +value caml_yices_iterator_has_next(value it) +{ + CAMLparam1(it); + CAMLreturn(Val_int(yices_iterator_has_next(yices_var_decl_iterator_val(it)))); +} + +value caml_yices_iterator_next(value it) +{ + CAMLparam1(it); + CAMLreturn(alloc_yices_var_decl(yices_iterator_next( + yices_var_decl_iterator_val(it)))); +} + +value caml_yices_iterator_reset(value it) +{ + CAMLparam1(it); + yices_iterator_reset(yices_var_decl_iterator_val(it)); + CAMLreturn(Val_unit); +} + +value caml_yices_del_iterator(value it) +{ + CAMLparam1(it); + yices_del_iterator(yices_var_decl_iterator_val(it)); + CAMLreturn(Val_unit); +} + +value caml_yices_mk_type(value yc, value name) +{ + CAMLparam2(yc, name); + CAMLreturn(alloc_yices_type(yices_mk_type(yices_context_val(yc), + String_val(name)))); +} + +/* XXX: value caml_yices_mk_function_type */ + +value caml_yices_mk_bitvector_type(value yc, value size) +{ + CAMLparam2(yc,size); + CAMLreturn(alloc_yices_type(yices_mk_bitvector_type(yices_context_val(yc), + Int_val(size)))); +} + +/* XXX: value caml_yices_mk_tuple_type */ + +value caml_yices_mk_var_decl(value yc, value name, value ty) +{ + CAMLparam3(yc, name, ty); + CAMLreturn(alloc_yices_var_decl(yices_mk_var_decl(yices_context_val(yc), + String_val(name), + yices_type_val(ty)))); +} + +/* Returns a list! */ +value caml_yices_get_var_decl_from_name(value yc, value name) +{ + yices_var_decl yvd; + + CAMLparam2(yc, name); + CAMLlocal1(res); + yvd = yices_get_var_decl_from_name(yices_context_val(yc),String_val(name)); + if( yvd ) { + res = caml_alloc_tuple(2); + Store_field(res, 0, alloc_yices_var_decl(yvd)); + Store_field(res, 1, Val_int(0)); + } + else { + res = Val_int(0); + } + + CAMLreturn(res); +} + +value caml_yices_mk_var_from_decl(value yc, value vd) +{ + CAMLparam2(yc,vd); + CAMLreturn(alloc_yices_expr(yices_mk_var_from_decl(yices_context_val(yc), + yices_var_decl_val(vd)))); +} + +/* XXX: value caml_yices_mk_app */ + +value caml_yices_mk_num(value yc, value n) +{ + CAMLparam2(yc, n); + CAMLreturn(alloc_yices_expr(yices_mk_num(yices_context_val(yc),Int_val(n)))); +} + +value caml_yices_mk_num_from_string(value yc, value numstr) +{ + CAMLparam2(yc, numstr); + CAMLreturn(alloc_yices_expr(yices_mk_num_from_string(yices_context_val(yc), + String_val(numstr)))); +} + +value caml_yices_mk_sum(value yc, value args, value n) +{ + yices_expr *cargs; + yices_expr res; + int i = 0; + + CAMLparam3(yc, args, n); + CAMLlocal1(tmp); + + cargs = (yices_expr *)malloc(Int_val(n) * sizeof(yices_expr)); + tmp = args; + while(Int_val(tmp) != 0 && i < n) { + cargs[i] = yices_expr_val(Field(tmp, 0)); + tmp = Field(tmp, 1); + i++; + } + res = yices_mk_sum(yices_context_val(yc), cargs, Int_val(n)); + free(cargs); + + CAMLreturn(alloc_yices_expr(res)); +} + +value caml_yices_mk_sub(value yc, value args, value n) +{ + yices_expr *cargs; + yices_expr res; + int i = 0; + + CAMLparam3(yc, args, n); + CAMLlocal1(tmp); + + cargs = (yices_expr *)malloc(Int_val(n) * sizeof(yices_expr)); + tmp = args; + while(Int_val(tmp) != 0 && i < n) { + cargs[i] = yices_expr_val(Field(tmp, 0)); + tmp = Field(tmp, 1); + i++; + } + res = yices_mk_sub(yices_context_val(yc), cargs, Int_val(n)); + free(cargs); + + CAMLreturn(alloc_yices_expr(res)); +} + +value caml_yices_mk_mul(value yc, value args, value n) +{ + yices_expr *cargs; + yices_expr res; + int i = 0; + + CAMLparam3(yc, args, n); + CAMLlocal1(tmp); + + cargs = (yices_expr *)malloc(Int_val(n) * sizeof(yices_expr)); + tmp = args; + while(Int_val(tmp) != 0 && i < n) { + cargs[i] = yices_expr_val(Field(tmp, 0)); + tmp = Field(tmp, 1); + i++; + } + res = yices_mk_mul(yices_context_val(yc), cargs, Int_val(n)); + free(cargs); + + CAMLreturn(alloc_yices_expr(res)); +} + +value caml_yices_mk_lt(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_lt(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_le(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_le(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_gt(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_gt(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_ge(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_ge(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_constant(value yc, value size, value val) +{ + CAMLparam3(yc,size,val); + CAMLreturn(alloc_yices_expr(yices_mk_bv_constant(yices_context_val(yc), + Int_val(size), + Int_val(val)))); +} + +/* XXX: value vaml_yices_mk_bv_constant_from_array */ + +value caml_yices_mk_bv_add(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_add(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_sub(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_sub(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_mul(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_mul(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_minus(value yc, value e) +{ + CAMLparam2(yc, e); + CAMLreturn(alloc_yices_expr(yices_mk_bv_minus(yices_context_val(yc), + yices_expr_val(e)))); +} + +value caml_yices_mk_bv_concat(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_concat(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_and(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_and(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_or(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_or(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_xor(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_xor(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_not(value yc, value e) +{ + CAMLparam2(yc, e); + CAMLreturn(alloc_yices_expr(yices_mk_bv_not(yices_context_val(yc), + yices_expr_val(e)))); +} + +value caml_yices_mk_bv_extract(value yc, value end, value begin, value e) +{ + CAMLparam4(yc, end, begin, e); + CAMLreturn(alloc_yices_expr(yices_mk_bv_extract(yices_context_val(yc), + Int_val(end),Int_val(begin), + yices_expr_val(e)))); +} + +value caml_yices_mk_bv_sign_extend(value yc, value e, value n) +{ + CAMLparam3(yc,e,n); + CAMLreturn(alloc_yices_expr(yices_mk_bv_sign_extend(yices_context_val(yc), + yices_expr_val(e), + Int_val(n)))); +} + +value caml_yices_mk_bv_shift_left0(value yc, value e, value n) +{ + CAMLparam3(yc, e, n); + CAMLreturn(alloc_yices_expr(yices_mk_bv_shift_left0(yices_context_val(yc), + yices_expr_val(e), + Int_val(n)))); +} + +value caml_yices_mk_bv_shift_left1(value yc, value e, value n) +{ + CAMLparam3(yc, e, n); + CAMLreturn(alloc_yices_expr(yices_mk_bv_shift_left1(yices_context_val(yc), + yices_expr_val(e), + Int_val(n)))); +} + +value caml_yices_mk_bv_shift_right0(value yc, value e, value n) +{ + CAMLparam3(yc, e, n); + CAMLreturn(alloc_yices_expr(yices_mk_bv_shift_right0(yices_context_val(yc), + yices_expr_val(e), + Int_val(n)))); +} + +value caml_yices_mk_bv_shift_right1(value yc, value e, value n) +{ + CAMLparam3(yc, e, n); + CAMLreturn(alloc_yices_expr(yices_mk_bv_shift_right1(yices_context_val(yc), + yices_expr_val(e), + Int_val(n)))); +} + +value caml_yices_mk_bv_lt(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_lt(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_le(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_le(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_gt(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_gt(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_ge(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_ge(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_slt(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_slt(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_sle(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_sle(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_sgt(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_sgt(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_mk_bv_sge(value yc, value e1, value e2) +{ + CAMLparam3(yc, e1, e2); + CAMLreturn(alloc_yices_expr(yices_mk_bv_sge(yices_context_val(yc), + yices_expr_val(e1), + yices_expr_val(e2)))); +} + +value caml_yices_pp_expr(value e) +{ + CAMLparam1(e); + yices_pp_expr(yices_expr_val(e)); + CAMLreturn(Val_unit); +} diff --git a/src/optimizer/solver/yicesSolver/yices_solver_test.ml b/src/optimizer/solver/yicesSolver/yices_solver_test.ml new file mode 100644 index 0000000..f0c7fa0 --- /dev/null +++ b/src/optimizer/solver/yicesSolver/yices_solver_test.ml @@ -0,0 +1,63 @@ + +open Printf + +module Y = Yices + +let test () = + (*Y.enable_type_checker true; + Y.set_arith_only true;*) + let yc = Y.mk_context () in + let intType = Y.mk_type yc "int" in + let x = Y.mk_var_decl yc "x" intType in + let y = Y.mk_var_decl yc "y" intType in + let xe = Y.mk_var_from_decl yc x in + let ye = Y.mk_var_from_decl yc y in + + let ten = Y.mk_num yc 10 in + let xpy = Y.mk_sum yc [xe;ye] 2 in + let xpygtten = Y.mk_gt yc xpy ten in + let e = xpygtten in + (*let e = Y.mk_not yc xpygtten in*) + (*let e = Y.mk_gt yc xe (Y.mk_num yc 10) in*) + + Y.assert_expr yc e; + Y.dump_context yc; + match Y.check_context yc with + | 1 -> begin + let m = Y.get_model yc in + match m with + | [] -> print_string "Sat but no model\n" + | m :: _ -> begin + print_string "Satisfiable. Printing model:\n"; + let it = Y.create_var_decl_iterator yc in (* XXX: why doesn't this work??? *) + let rec loop () = + if Y.iterator_has_next it then begin + let vd = Y.iterator_next it in + let (res, v) = Y.get_int_value m vd in + if res then begin + let name = Y.get_var_decl_name vd in + printf "model: %s -> %d\n" name v; + loop () + end else begin + let name = Y.get_var_decl_name vd in + printf "model: %s -> undef\n" name; + loop () + end + end else begin + printf "model: done\n"; + () + end + in + loop (); + Y.del_iterator it; + () + end + end + | 0 -> print_string "Not Satisfiable\n" + | -1 -> print_string "Couldn't determine anything\n" + | _ -> print_string "Internal Error\n" + + +let _ = test (); + + diff --git a/src/optimizer/xhtml/xHTML.ml b/src/optimizer/xhtml/xHTML.ml new file mode 100644 index 0000000..0fddb0c --- /dev/null +++ b/src/optimizer/xhtml/xHTML.ml @@ -0,0 +1,1629 @@ +(* BEGIN INTERFACE *) +(* $Id: xHTML.ml,v 1.31 2005/06/20 17:57:58 ohl Exp $ + + Copyright (C) 2004 by Thorsten Ohl + + XHTML 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, or (at your option) + any later version. + + XHTML 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., 675 Mass Ave, Cambridge, MA 02139, USA. *) + +(* IDEAS: + + It might be possible to factorize attributes and elements into separate + modules. Problems are attributes like [class] and [for] that class with + reserved words. Then the [a_] prefix would have to be maintained and the + only advantage are a potentially better mapping of the XHTML modularization + to O'Caml modules. *) + +(** Typesafe constructors for XHTML 1.1 documents. + @see W3C Recommendation *) + +module type T = + sig + +(** The elements, attributes, attribute types and data types are given names + that match the names in the W3C recommendation as closely as allowed by + a strict typing discipline and the lexical conventions of O'Caml: + {ul + {- {e elements} are implemented as O'Caml constructors with the same name as + in the W3C recommendation. The domain and codomain are specified as ['a elt], + where ['a] is a concrete phantom type build out of polymorphic variants.} + {- {e attributes} are implemented as O'Caml constructors with [a_] prefixed to the + name. The name is the same as in the W3C recommendation, unless an additional + prefix is required to disambiguate: + {ul + {- [a_fs_rows] and [a_fs_cols] instead of [a_rows] and [a_cols] for framesets, + because of the different argument types.}}} + {- {e attribute types} are implemented as O'Caml types that all have the same names + as in the W3C recommendation, but are all lowercase.} + {- {e data types} are also implemented as O'Caml types that all have the same names + as in the W3C recommendation and are again all lowercase.}} + + Finite sets of alternatives are mapped to polymorphic variants. + + The phantom type is always the {e most general} required by any (supported) + version of the standard. Type discipline is enforced by exporting or not-exporting + the corresponding constructor. *) + +(** {1 Attribute Types} + @see Modularization of XHTML *) + + type cdata = string +(** Character data *) + + type id = string +(** A document-unique identifier *) + + type idref = string +(** A reference to a document-unique identifier *) + + type idrefs = idref list +(** A space-separated list of references to document-unique identifiers *) + + type name = string +(** A name with the same character constraints as ID above *) + + type nmtoken = string +(** A name composed of only name tokens as defined in XML 1.0 + @see XML 1.0 *) + + type nmtokens = nmtoken list +(** One or more white space separated NMTOKEN values *) + + type pcdata = string +(** Processed character data *) + +(** {2 Data Types} *) + + type character = char +(** A single character from ISO 10646. *) + + type charset = string +(** A character encoding, as per RFC2045 (MIME). + @see RFC2045 *) + + type charsets = charset list +(** A space-separated list of character encodings, as per RFC2045 (MIME). + @see RFC2045 *) + + type color = + [ `Aqua | `Black | `Blue | `Fuchsia | `Gray | `Green | `Lime | `Maroon + | `Navy | `Olive | `Purple | `Red | `Silver | `Teal | `White | `Yellow + | `Hex of string | `RGB of int * int * int ] +(** The attribute value type [color] refers to color definitions as specified in + SRGB. A color value may either be a hexadecimal number (prefixed by a hash mark) + or one of the following sixteen color names. The color names are case-insensitive. + @see A Standard Default Color Space for the Internet. *) + + type contenttype = string +(** A media type, as per RFC2045 (MIME). + @see RFC2045 *) + + type contenttypes = contenttype list +(** A comma-separated list of media types, as per RFC2045 (MIME). + @see RFC2045 *) + + type coords = string list +(** Comma- separated list of coordinates to use in defining areas. *) + + type datetime = string +(** Date and time information. *) + + type fpi = string +(** A character string representing an SGML Formal Public Identifier. *) + + type frametarget = string +(** Frame name used as destination for results of certain actions. *) + + type languagecode = string +(** A language code, as per RFC3066. + @see RFC3066 *) + + type length = [ `Pixels of int | `Percent of int ] +(** The value may be either in pixels or a percentage of the available + horizontal or vertical space. Thus, the value [`Percent 50] means half of + the available space. *) + + type linktypes = + [ `Alternate | `Appendix | `Bookmark | `Chapter | `Contents + | `Copyright | `Glossary | `Help | `Index | `Next | `Prev + | `Section | `Start | `Stylesheet | `Subsection] list +(** Authors may use the following recognized link types, listed here with + their conventional interpretations. A LinkTypes value refers to a + space-separated list of link types. White space characters are not + permitted within link types. These link types are case-insensitive, i.e., + ["Alternate"] has the same meaning as ["alternate"]. + + User agents, search engines, etc. may interpret these link types in a + variety of ways. For example, user agents may provide access to linked + documents through a navigation bar. + + {ul + {- [`Alternate]: + Designates substitute versions for the document in which the link occurs. + When used together with the hreflang attribute, it implies a translated + version of the document. When used together with the media attribute, + it implies a version designed for a different medium (or media).} + {- [`Stylesheet]: + Refers to an external style sheet. See the Style Module for details. + This is used together with the link type ["Alternate"] for user-selectable + alternate style sheets.} + {- [`Start]: + Refers to the first document in a collection of documents. + This link type tells search engines which document is considered + by the author to be the starting point of the collection.} + {- [`Next]: + Refers to the next document in a linear sequence of documents. + User agents may choose to pre-load the "next" document, to reduce + the perceived load time.} + {- [`Prev]: + Refers to the previous document in an ordered series of documents. + Some user agents also support the synonym "Previous".} + {- [`Contents]: + Refers to a document serving as a table of contents. Some user + agents also support the synonym ToC (from "Table of Contents").} + {- [`Index]: + Refers to a document providing an index for the current document.} + {- [`Glossary]: + Refers to a document providing a glossary of terms that pertain to + the current document.} + {- [`Copyright]: + Refers to a copyright statement for the current document.} + {- [`Chapter]: + Refers to a document serving as a chapter in a collection of documents.} + {- [`Section]: + Refers to a document serving as a section in a collection of documents.} + {- [`Subsection]: + Refers to a document serving as a subsection in a collection of documents.} + {- [`Appendix]: + Refers to a document serving as an appendix in a collection of documents.} + {- [`Help]: + Refers to a document offering help (more information, links to other + sources information, etc.)} + {- [`Bookmark]: + Refers to a bookmark. A bookmark is a link to a key entry point within + an extended document. The title attribute may be used, for example, to + label the bookmark. Note that several bookmarks may be defined in each + document.}} *) + + type mediadesc = + [ `All | `Aural | `Braille | `Handheld | `Print + | `Projection | `Screen | `TTY | `TV ] list +(** The MediaDesc attribute is a comma-separated list of media descriptors. + The following is a list of recognized media descriptors: + {ul + {- [`Screen]: + Intended for non-paged computer screens.} + {- [`TTY]: + Intended for media using a fixed-pitch character grid, such as + teletypes, terminals, or portable devices with limited display + capabilities.} + {- [`TV]: + Intended for television-type devices (low resolution, color, + limited scrollability).} + {- [`Projection]: + Intended for projectors.} + {- [`Handheld]: + Intended for handheld devices (small screen, monochrome, + bitmapped graphics, limited bandwidth).} + {- [`Print]: + Intended for paged, opaque material and for documents viewed + on screen in print preview mode.} + {- [`Braille]: + Intended for braille tactile feedback devices.} + {- [`Aural]: + Intended for speech synthesizers.} + {- [`All]: + Suitable for all devices.}} + + Future versions of XHTML may introduce new values and may allow + parameterized values. To facilitate the introduction of these + extensions, conforming user agents must be able to parse the media + attribute value as follows: + {ol + {- The value is a comma-separated list of entries. For example, + [media="screen, 3d-glasses, print and resolution > 90dpi"] + is mapped to: ["screen"], ["3d-glasses"], + ["print and resolution > 90dpi"].} + {- Each entry is truncated just before the first character that + isn't a US ASCII letter [\[a-zA-Z\]] (ISO 10646 hex 41-5a, + 61-7a), digit [\[0-9\]] (hex 30-39), or hyphen-minus (hex 2d). + In the example, this gives: ["screen"], ["3d-glasses"], ["print"].} + {- A case-insensitive match is then made with the set of media + types defined above. User agents may ignore entries that + don't match. In the example we are left with ["screen"] and + ["print"].}} + + Note. Style sheets may include media-dependent variations within them + (e.g., the [CSS \@media] construct). In such cases it may be appropriate + to use ["media=all"]. *) + + type multilength = [ length | `Relative of int ] +(** The value may be a Length or a relative length. A relative length + has the form ["i*"], where ["i"] is an integer. When allotting space + among elements competing for that space, user agents allot pixel + and percentage lengths first, then divide up remaining available + space among relative lengths. Each relative length receives a + portion of the available space that is proportional to the integer + preceding the ["*"]. The value ["*"] is equivalent to ["1*"]. Thus, if + 60 pixels of space are available after the user agent allots pixel + and percentage space, and the competing relative lengths are ["1*"], + ["2*"], and ["3*"], the ["1*"] will be allotted 10 pixels, the ["2*"] will be + allotted 20 pixels, and the ["3*"] will be allotted 30 pixels. *) + + type multilengths = multilength list (* comma-separated *) +(** A comma separated list of items of type MultiLength. *) + + type number = int +(** One or more digits. *) + + type pixels = int + +(** The value is an integer that represents the number of pixels of + the canvas (screen, paper). Thus, the value ["50"] means fifty + pixels. For normative information about the definition of a pixel, + please consult CSS2. + @see CSS2 *) + + type script = string +(** Script data can be the content of the ["script"] element and the + value of intrinsic event attributes. User agents must not evaluate + script data as HTML markup but instead must pass it on as data to a + script engine. + + The case-sensitivity of script data depends on the scripting + language. + + Please note that script data that is element content may not + contain character references, but script data that is the value of + an attribute may contain them. *) + + type shape = string +(** The shape of a region. *) + + type text = string +(** Arbitrary textual data, likely meant to be human-readable. *) + + type uri = string +(** A Uniform Resource Identifier, as per RFC2396. + @see RFC2396 *) + + type uris = uri +(** A space-separated list of Uniform Resource Identifiers, as per RFC2396. + @see RFC2396 *) + + +(** {1 Common Attributes} *) + + type 'a attrib + type 'a attribs + (** ['a] is known as a {i phantom type}. The implementation is + actually monomorphic (the different element types are distinguished + by a homogeneous variable, such as their textual representation) + and the type variable [`a] is just used by the type checker. + + NB: It might be possible to use polymorphic variants directly, without + phantom types, but the implementation is likely to be more involved. *) + +(** {2 Core} *) + + type core = [ `Class | `Id | `Title ] + + val a_class : nmtokens -> [>`Class] attrib +(** This attribute assigns a class name or set of class names to an + element. Any number of elements may be assigned the same class + name or names. *) + + val a_id : id -> [>`Id] attrib +(** This attribute assigns a name to an element. This name must be + unique in a document. *) + + val a_title : cdata -> [>`Title] attrib +(** This attribute offers advisory information about the element for + which it is set. *) + +(** Values of the title attribute may be rendered by user agents in a + variety of ways. For instance, visual browsers frequently display + the title as a {i tool tip} (a short message that appears when the + pointing device pauses over an object). Audio user agents may + speak the title information in a similar context. *) + +(** The title attribute has an additional role when used with the [link] + element to designate an external style sheet. Please consult the + section on links and style sheets for details. *) + +(** {2 I18N} *) + + type i18n = [ `XML_lang ] + val a_xml_lang : nmtoken -> [>`XML_lang] attrib + +(** {2 Style} + The Style collection is deprecated, because the Style Attribute Module is + deprecated. *) + + type common = [ core | i18n ] + +(** {1 Modules, Element Sets and Attributes } *) + +(** {2 5.2. Core Modules} *) + +(** {3 5.2.1. Structure Module} *) + + module STRUCTURE : + sig + type t = [ `Body | `Head | `Html | `Title ] + end + + val a_profile : uri -> [>`Profile] attrib + val a_version : cdata -> [>`Version] attrib + val a_xmlns : [< `W3_org_1999_xhtml ] -> [>`XMLns] attrib + +(** {3 5.2.2. Text Module} *) + + module TEXT : + sig + type heading = [ `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ] + type block = [ `Address | `Blockquote | `Div | `P | `Pre ] + type inline = + [ `Abbr | `Acronym | `Br | `Cite | `Code | `Dfn + | `Em | `Kbd | `Q | `Samp | `Span | `Strong | `Var ] + type flow = [ heading | block | inline ] + end + + val a_cite : uri -> [>`Cite] attrib + val a_xml_space : [< `Preserve ] -> [>`XML_space] attrib + +(** {3 5.2.3. Hypertext Module} *) + + module HYPERTEXT : + sig + type inline = [ `A ] + type flow = inline + end + + val a_accesskey : character -> [>`Accesskey] attrib +(** This attribute assigns an access key to an element. An access key + is a single character from the document character + set. NB: authors should consider the input method of the + expected reader when specifying an accesskey. *) + + val a_charset : charset -> [>`Charset] attrib +(** This attribute specifies the character encoding of the resource + designated by the link. Please consult the section on character + encodings for more details. *) + + val a_href : uri -> [>`Href] attrib +(** This attribute specifies the location of a Web resource, thus + defining a link between the current element (the source anchor) + and the destination anchor defined by this attribute. *) + + val a_hreflang : languagecode -> [>`Hreflang] attrib +(** This attribute specifies the base language of the resource + designated by href and may only be used when href is specified. *) + + val a_rel : linktypes -> [>`Rel] attrib +(** This attribute describes the relationship from the current document + to the anchor specified by the href attribute. The value of this attribute + is a space-separated list of link types. *) + + val a_rev : linktypes -> [>`Rev] attrib +(** This attribute is used to describe a reverse link from the anchor specified + by the href attribute to the current document. The value of this attribute + is a space-separated list of link types. *) + + val a_tabindex : number -> [>`Tabindex] attrib +(** This attribute specifies the position of the current element in + the tabbing order for the current document. This value must be a + number between 0 and 32767. User agents should ignore leading + zeros. *) + + val a_type : contenttype -> [>`Type] attrib +(** This attribute gives an advisory hint as to the content type of + the content available at the link target address. It allows user + agents to opt to use a fallback mechanism rather than fetch the + content if they are advised that they will get content in a + content type they do not support.Authors who use this attribute + take responsibility to manage the risk that it may become + inconsistent with the content available at the link target + address. *) + +(** {3 5.2.3. List Module} *) + + module LIST : + sig + type list = [ `Dl | `Ol | `Ul ] + type t = [ `Dd | `Dt | `Li ] + type flow = list + end + +(** {2 5.3. Applet Module} + This module is deprecated. Similar functionality + can be found in the Object Module. *) + +(** {2 5.4. Text Extension Modules} *) + +(** {3 5.4.1. Presentation Module} *) + + module PRESENTATION : + sig + type block = [ `Hr ] + type inline = [ `B | `Big | `I | `Small | `Sub | `Sup | `Tt ] + end + +(** {3 5.4.2. Edit Module} *) + +(** {3 5.4.3. Bi-directional Text Module} *) + +(** {2 5.5. Forms Modules} *) + +(** {3 5.5.1. Basic Forms Module} *) + + module FORMS : + sig + type t = [ `Option ] + type form = [ `Form ] + type formctrl_sans_label = [ `Input | `Select | `Textarea ] + type formctrl = [ formctrl_sans_label | `Label ] + type block = form + type inline_sans_label = formctrl_sans_label + type inline = formctrl + type flow_sans_label = [block | inline_sans_label ] + type flow = [ block | inline ] + end + + val a_action : uri -> [>`Action] attrib +(** This attribute specifies a form processing agent. User agent + behavior for a value other than an HTTP URI is undefined. *) + + val a_checked : [< `Checked ] -> [>`Checked] attrib +(** When the [type] attribute has the value ["radio"] or ["checkbox"], + this boolean attribute specifies that the button is on. User + agents must ignore this attribute for other control types. *) + + val a_cols : number -> [>`Cols] attrib +(** This attribute specifies the visible width in average character + widths. Users should be able to enter longer lines than this, so + user agents should provide some means to scroll through the + contents of the control when the contents extend beyond the + visible area. User agents may wrap visible text lines to keep long + lines visible without the need for scrolling. *) + + val a_enctype : contenttype -> [>`Enctype] attrib + val a_for : idref -> [>`For] attrib + val a_maxlength : number -> [>`Maxlength] attrib + val a_method : [< `Get | `Post ] -> [>`Method] attrib + val a_multiple : [< `Multiple ] -> [>`Multiple] attrib + + val a_name : cdata -> [>`Name] attrib +(** This attribute assigns the control name. *) + + val a_rows : number -> [>`Rows] attrib +(** This attribute specifies the number of visible text lines. Users + should be able to enter more lines than this, so user agents + should provide some means to scroll through the contents of the + control when the contents extend beyond the visible area. *) + + val a_selected : [< `Selected ] -> [>`Selected] attrib +(** When set, this boolean attribute specifies that this option is pre-selected. *) + + val a_size : number -> [>`Size] attrib + val a_src : uri -> [>`Src] attrib + val a_input_type : + [< `Text | `Password | `Checkbox | `Radio | `Submit | `Reset | `Hidden ] -> + [>`Input_Type] attrib + + val a_value : cdata -> [>`Value] attrib +(** This attribute specifies the initial value of the control. If this + attribute is not set, the initial value is set to the contents of + the [option] element. *) + + +(** {3 5.5.2. Forms Module} *) + +(** {2 5.6. Table Modules} *) + +(** {3 5.6.1. Basic Tables Module} *) + + module TABLES : + sig + type t = [ `Caption | `Td | `Th | `Tr ] + type block = [ `Table ] + type flow = block + end + + val a_abbr : text -> [>`Abbr] attrib + val a_align : [< `Left | `Center | `Right | `Justify | `Char ] -> + [>`Align] attrib + val a_axis : cdata -> [>`Axis] attrib + val a_colspan : number -> [>`Colspan] attrib + val a_headers : idrefs -> [>`Headers] attrib + val a_rowspan : number -> [>`Rowspan] attrib + val a_scope : [< `Row | `Col | `Rowgroup | `Colgroup ] -> [>`Scope] attrib + val a_summary : text -> [>`Summary] attrib + val a_valign : [< `Top | `Middle | `Bottom | `Baseline ] -> + [>`Valign] attrib + +(** {3 5.6.2. Tables Module} *) + + val a_border : pixels -> [>`Border] attrib + val a_cellpadding : length -> [>`Cellpadding] attrib + val a_cellspacing : length -> [>`Cellspacing] attrib + val a_datapagesize : cdata -> [>`Datapagesize] attrib + val a_frame : + [< `Void | `Above | `Below | `Hsides | `LHS | `RHS + | `Vsides | `Box | `Border ] -> [>`Frame] attrib + val a_rules : [< `None | `Groups | `Rows | `Cols | `All ] -> [>`Rules] attrib + val a_char : character -> [>`Char] attrib + val a_charoff : length -> [>`Charoff] attrib + +(** {2 5.7. Image Module} *) + + module IMAGE : + sig + type inline = [ `Img ] + end + + val a_alt : text -> [>`Alt] attrib + val a_height : length -> [>`Height] attrib + val a_longdesc : uri -> [>`Longdesc] attrib + val a_width : length -> [>`Width] attrib + +(** {2 5.8. Client-side Image Map Module} *) + +(** {2 5.9. Server-side Image Map Module} *) + +(** {2 5.10. Object Module} *) + +(** {2 5.11. Frames Module} *) + + val a_fs_rows : multilengths -> [>`FS_Rows] attrib + val a_fs_cols : multilengths -> [>`FS_Cols] attrib + val a_frameborder : [< `Zero | `One ] -> [>`Frameborder] attrib + val a_marginheight : pixels -> [>`Marginheight] attrib + val a_marginwidth : pixels -> [>`Marginwidth] attrib + val a_noresize : [< `Noresize ] -> [>`Noresize] attrib + val a_scrolling : [< `Yes | `No | `Auto ] -> [>`Scrolling] attrib + +(** {2 5.12. Target Module} *) + + val a_target : frametarget -> [>`Target] attrib + +(** {2 5.13. Iframe Module} *) + +(** {2 5.14. Intrinsic Events Module} *) + +(** {2 5.15. Metainformation Module} *) + + module METAINFORMATION : + sig + type t = [ `Meta ] + end + + val a_content : cdata -> [>`Content] attrib + val a_http_equiv : nmtoken -> [>`Http_equiv] attrib + val a_scheme : cdata -> [>`Scheme] attrib + +(** {2 5.16. Scripting Module} *) + +(** {2 5.17. Style Sheet Module} *) + + module STYLE_SHEET : + sig + type t = [ `Style ] + end + + val a_media : mediadesc -> [>`Media] attrib + +(** {2 5.18. Style Attribute Module} *) + +(** {2 5.19. Link Module} *) + + module LINK : + sig + type t = [ `Link ] + end + +(** {2 5.20. Base Module} *) + + module BASE : + sig + type t = [ `Base ] + end + +(** {2 5.21. Name Identification Module} + This module is deprecated in XHTML 1.1, but supported for XHTML 1.0 + using [`Name_01_00] . *) + +(** {2 5.22. Legacy Module} *) + +(** {1 Combined Element Sets:} *) + + type block = + [ TEXT.block | PRESENTATION.block | FORMS.block | TABLES.block ] + type block_sans_form = + [ TEXT.block | PRESENTATION.block | TABLES.block ] + + type flow = + [ TEXT.flow | HYPERTEXT.flow | LIST.flow | FORMS.flow | TABLES.flow ] + type flow_sans_table = + [ TEXT.flow | HYPERTEXT.flow | LIST.flow | FORMS.flow ] + + type inline = + [ TEXT.inline | HYPERTEXT.inline | PRESENTATION.inline + | FORMS.inline | IMAGE.inline] + type inline_sans_a = + [ TEXT.inline | PRESENTATION.inline + | FORMS.inline | IMAGE.inline] + type inline_sans_label = + [ TEXT.inline | HYPERTEXT.inline | PRESENTATION.inline + | FORMS.inline_sans_label | IMAGE.inline] + + type heading = TEXT.heading + +(** {1 Elements} *) + + type 'a elt + +(** {2 Element Constructor Types} *) + + type ('a, 'b) nullary = ?a:('a attrib list) -> unit -> 'b elt + type ('a, 'b, 'c) unary = ?a:('a attrib list) -> 'b elt -> 'c elt + type ('a, 'b, 'c, 'd) binary = ?a:('a attrib list) -> 'b elt -> 'c elt -> 'd elt + + type ('a, 'b, 'c) star = ?a:('a attrib list) -> 'b elt list -> 'c elt +(** Star '*' denotes any number of children, uncluding zero. *) + + type ('a, 'b, 'c) plus = ?a:('a attrib list) -> 'b elt -> 'b elt list -> 'c elt +(** Plus '+' requires at least one child. *) + +(** {2 Structure} *) + + type html = [`Html] elt + + val html : ?a:([< i18n | `Version | `XMLns ] attrib list) -> + [< `Head ] elt -> [< `Body | `Frameset ] elt -> html + val head : ([< i18n | `Profile ], + [< `Title | `Meta | `Link | `Style | `Base ], [>`Head]) plus + val title : ([< i18n ], [< `PCDATA ], [>`Title]) unary + val body : ([< common ], [< heading | block | LIST.list ], [>`Body]) star + +(** {2 Data} *) + + val pcdata : string -> [>`PCDATA] elt + val entity : string -> [>`PCDATA] elt + val space : unit -> [>`PCDATA] elt + +(** {2 Text} *) + + val h1 : ([< common ], [< `PCDATA | inline ], [>`H1]) star + val h2 : ([< common ], [< `PCDATA | inline ], [>`H2]) star + val h3 : ([< common ], [< `PCDATA | inline ], [>`H3]) star + val h4 : ([< common ], [< `PCDATA | inline ], [>`H4]) star + val h5 : ([< common ], [< `PCDATA | inline ], [>`H5]) star + val h6 : ([< common ], [< `PCDATA | inline ], [>`H6]) star + + val address : ([< common ], [< `PCDATA | inline ], [>`Address]) star + val blockquote : ([< common | `Cite ], + [< `PCDATA | heading | block | LIST.list ], [>`Blockquote]) star + val div : ([< common ], [< `PCDATA | flow ], [>`Div]) star + val p : ([< common ], [< `PCDATA | inline ], [>`P]) star + val pre : ([< common | `XML_space ], [< `PCDATA | inline ], [>`Pre]) star + + val abbr : ([< common ], [< `PCDATA | inline ], [>`Abbr]) star + val acronym : ([< common ], [< `PCDATA | inline ], [>`Acronym]) star + val br : ([< core ], [>`Br]) nullary + val cite : ([< common ], [< `PCDATA | inline ], [>`Cite]) star + val code : ([< common ], [< `PCDATA | inline ], [>`Code]) star + val dfn : ([< common ], [< `PCDATA | inline ], [>`Dfn]) star + val em : ([< common ], [< `PCDATA | inline ], [>`Em]) star + val kbd : ([< common ], [< `PCDATA | inline ], [>`Kbd]) star + val q : ([< common | `Cite ], [< `PCDATA | inline ], [>`Q]) star + val samp : ([< common ], [< `PCDATA | inline ], [>`Samp]) star + val span : ([< common ], [< `PCDATA | inline ], [>`Span]) star + val strong : ([< common ], [< `PCDATA | inline ], [>`Strong]) star + +(** {2 Hypertext} *) + + val a : ([< common | `Accesskey | `Charset | `Href | `Hreflang + | `Name_01_00 | `Rel | `Rev | `Tabindex | `Target | `Type ], + [< `PCDATA | inline_sans_a ], [>`A]) star + +(** {2 List} *) + + val dl : ([< common ], [< `Dt | `Dd ], [>`Dl]) plus + val ol : ([< common ], [< `Li ], [>`Ol]) plus + val ul : ([< common ], [< `Li ], [>`Ul]) plus + val dd : ([< common ], [< `PCDATA | flow ], [>`Dd]) star + val dt : ([< common ], [< `PCDATA | inline ], [>`Dt]) star + val li : ([< common ], [< `PCDATA | flow ], [>`Li]) star + +(** {2 Presentation} *) + + val hr : ([< common ], [>`Hr]) nullary + val b : ([< common ], [< `PCDATA | inline ], [>`B]) star + val big : ([< common ], [< `PCDATA | inline ], [>`Big]) star + val i : ([< common ], [< `PCDATA | inline ], [>`I]) star + val small : ([< common ], [< `PCDATA | inline ], [>`Small]) star + val sub : ([< common ], [< `PCDATA | inline ], [>`Sub]) star + val sup : ([< common ], [< `PCDATA | inline ], [>`Sup]) star + val tt : ([< common ], [< `PCDATA | inline ], [>`Tt]) star + +(** {2 Forms} *) + +(** {3 Basic Forms} *) + +(** One can use [open Basic_Forms] to enable basic forms. *) + + module Basic_Forms : + sig + val form : action:uri -> + ([< common | `Enctype | `Method | `Name_01_00 | `Target ], + [< `PCDATA | heading | LIST.list | block_sans_form ], [>`Form]) star + val input : ([< common | `Accesskey | `Checked | `Maxlength | `Name | `Size + | `Src | `Tabindex | `Input_Type | `Value ], [>`Input]) nullary + val label : ([< common | `Accesskey | `For ], + [< `PCDATA | inline_sans_label ], [>`Label]) star + val option : ([< common | `Selected | `Value ], + [< `PCDATA ], [>`Option]) unary + val select : ([< common | `Multiple | `Name | `Size | `Tabindex ], + [< `Option ], [>`Select]) plus + val textarea : rows:number -> cols:number -> + ([< common | `Accesskey | `Name | `Tabindex ], + [< `PCDATA ], [>`Textarea]) unary + end + +(** {3 Forms} *) + +(** General forms are not implemented yet, but one can use [open Basic_Forms] + to enable basic forms. *) + +(** {2 Tables} *) + +(** {3 Basic Tables} *) + +(** One can use [open Basic_Tables] to switch globally to basic tables. *) + + module Basic_Tables : + sig + val a_align : [< `Left | `Center | `Right ] -> [>`Align] attrib + val a_scope : [< `Row | `Col ] -> [>`Scope] attrib + val a_valign : [< `Top | `Middle | `Bottom ] -> [>`Valign] attrib + + val caption : ([< common ], [< `PCDATA | inline ], [>`Caption]) star + val table : ?caption:([< `Caption ] elt) -> + ([< common | `Summary | `Width ], [< `Tr ], [>`Table]) plus + val td : ([< common | `Abbr | `Align | `Axis | `Colspan | `Headers | `Rowspan + | `Scope | `Valign ], [< `PCDATA | flow_sans_table ], [>`Td]) star + val th : ([< common | `Abbr | `Align | `Axis | `Colspan | `Headers | `Rowspan + | `Scope | `Valign ], [< `PCDATA | flow_sans_table ], [>`Th]) star + val tr : ([< common | `Align | `Valign ], [< `Td | `Th ], [>`Tr]) plus + end + +(** {3 Tables} *) + + val caption : ([< common ], [< `PCDATA | inline ], [>`Caption]) star + + val table : ?caption:([< `Caption ] elt) -> + ?columns:([< `Cols of ([< `Col ] elt list) + | `Colgroups of ([< `Colgroup ] elt list) ]) -> + ([< common | `Border | `Cellpadding | `Cellspacing | `Datapagesize + | `Frame | `Rules | `Summary | `Width ], [< `Tr ], [>`Table]) plus + + val tablex : ?caption:([< `Caption ] elt) -> + ?columns:([< `Cols of ([< `Col ] elt list) + | `Colgroups of ([< `Colgroup ] elt list) ]) -> + ?thead:([< `Thead ] elt) -> ?tfoot:([< `Tfoot ] elt) -> + ([< common | `Border | `Cellpadding | `Cellspacing | `Datapagesize + | `Frame | `Rules | `Summary | `Width ], [< `Tbody ], [>`Table]) plus + + val td : ([< common | `Abbr | `Align | `Axis | `Char | `Charoff + | `Colspan | `Headers | `Rowspan | `Scope | `Valign ], + [< `PCDATA | flow ], [>`Td]) star + val th : ([< common | `Abbr | `Align | `Axis | `Char | `Charoff + | `Colspan | `Headers | `Rowspan | `Scope | `Valign ], + [< `PCDATA | flow ], [>`Th]) star + val tr : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Td | `Th ], [>`Tr]) plus + + val col : ([< common | `Align | `Char | `Charoff + | `Span | `Valign | `Width ], [>`Col]) nullary + val colgroup : ([< common | `Align | `Char | `Charoff + | `Span | `Valign | `Width ], [< `Col ], [>`Colgroup]) star + val thead : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Tr ], [>`Thead]) plus + val tbody : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Tr ], [>`Tbody]) plus + val tfoot : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Tr ], [>`Tfoot]) plus + +(** {2 Image} *) + + val img : src:uri -> alt:text -> + ([< common | `Height | `Longdesc | `Name_01_00 | `Width ], [>`Img]) nullary + +(** {2 Frames} *) + + val frameset : ?noframes:([< `Noframes ] elt) -> + ([< core | `FS_Rows | `FS_Cols ], [< `Frameset | `Frame ], [>`Frameset]) plus + + val frame : src:uri -> + ([< core | `Frameborder | `Longdesc | `Marginheight | `Marginwidth + | `Name_01_00 | `Noresize | `Scrolling ], [>`Frame]) nullary + + val noframes : ([< common ], [< `Body ], [>`Noframes]) unary + +(** {2 Meta} *) + + val meta : content:cdata -> + ([< i18n | `Http_equiv | `Name | `Scheme ], [>`Meta]) nullary + +(** {2 Style Sheets} *) + + val style : contenttype:contenttype -> + ([< i18n | `Media | `Title | `XML_space ], [< `PCDATA ], [>`Style]) star + +(** {2 Link} *) + + val link : ([< common | `Charset | `Href | `Hreflang | `Media + | `Rel | `Rev | `Target | `Type ], [>`Link]) nullary + +(** {2 Base} *) + + val base : href:uri -> unit -> [>`Base] elt + +(** {1 Output} *) + +(** [?encode] maps strings to HTML and {e must} encode the unsafe characters + ['<'], ['>'], ['"'], ['&'] and the control characters 0-8, 11-12, 14-31, 127 + to HTML entities. [XML.encode_unsafe] is the default for [?encode] in [output] + and [pretty_print] below. Other implementations are provided by the module + [Netencoding] in the + {{:http://www.ocaml-programming.de/programming/ocamlnet.html}OcamlNet} library, e.g.: + [let encode = Netencoding.Html.encode ~in_enc:`Enc_iso88591 ~out_enc:`Enc_usascii ()], + Where national characters are replaced by HTML entities. + The user is of course free to write her own implementation. + @see OcamlNet *) + +(** [~encoding] is the official name of the external character set encoding that + is used by [outs : string -> unit]. *) + + val output : ?encode:(string -> string) -> ?encoding:string -> + (string -> unit) -> html -> unit + + val pretty_print : ?width:int -> + ?encode:(string -> string) -> ?encoding:string -> + (string -> unit) -> html -> unit + +(** {1 Tools} *) + + val version : string + val standard : uri + val validator : uri + val validator_icon : unit -> [>`A] elt +(** A hyperlink to the W3C validator, including the logo. + @see Validator *) + + val addto_class : string -> 'a elt -> 'a elt +(** Add the element and all its subelements to a class. Note that this + is only almost typesafe, because a few elements from the structure class + do not support the class attribute. On the other hand, listing all + allowed elements would be too tedious right now. *) + + val addto_class1 : string -> 'a elt -> 'a elt +(** Add the element to a class. *) + + val set_rowspan : int -> ([< `Th | `Td ] as 'a) elt -> 'a elt +(** Set the rowspan attribute for the element. *) + + val rewrite_hrefs : (string -> string) -> 'a elt -> 'a elt + val all_hrefs : 'a elt -> uri list + val all_anchors : 'a elt -> id list + +(* + val amap : (string -> 'a attribs -> 'a attribs) -> 'b elt -> 'b elt + val amap1 : (string -> 'a attribs -> 'a attribs) -> 'b elt -> 'b elt + + val rm_attrib : (string -> bool) -> 'a attribs -> 'a attribs + val rm_attrib_from_list : + (string -> bool) -> (string -> bool) -> 'a attribs -> 'a attribs + +(** Exporting the following will drive a hole through the type system, + because they allow to add any attribute to any element. *) + val add_int_attrib : string -> int -> 'a attribs -> 'a attribs + val add_string_attrib : string -> string -> 'a attribs -> 'a attribs + val add_comma_sep_attrib : string -> string -> 'a attribs -> 'a attribs + val add_space_sep_attrib : string -> string -> 'a attribs -> 'a attribs +*) + + end + +(** An alias for XHTML 1.1 (for symmetry): + @see XHTML 1.1 - Module-based XHTML *) +module type T_01_01 = T + +(** XHTML 1.0 includes some deprecated features that since + have been removed from XHTML 1.1: + @see Changes from XHTML 1.0 Strict + @see XHTML 1.0: The Extensible HyperText Markup Language *) +module type T_01_00 = + sig + include T + +(** XHTML 1.1 has removed the name attribute from several elements: *) + val a_name_01_00 : cdata -> [>`Name_01_00] attrib + end + +(* END INTERFACE *) + +(* BEGIN INTERFACE + +module M : T +module M_01_01 : T_01_01 +module M_01_00 : T_01_00 + + END INTERFACE *) + +module Version = + struct + + (* Directly from http://www.w3.org/TR/xhtml-modularization/abstract_modules.html *) + + type core = [ `Class | `Id | `Title ] + type i18n = [ `XML_lang ] + + type common = [ core | i18n ] + + type 'a attrib = XML.attrib + type 'a attribs = XML.attribs + + let int_attrib = XML.int_attrib + let string_attrib = XML.string_attrib + let space_sep_attrib = XML.space_sep_attrib + let comma_sep_attrib = XML.comma_sep_attrib + + type cdata = string + type id = string + type idref = string + type idrefs = idref list (* space-separated *) + type name = string + type nmtoken = string + type nmtokens = nmtoken list (* space-separated *) + type pcdata = string + + type character = char + type charset = string + type charsets = charset list (* space-separated *) + type color = + [ `Aqua | `Black | `Blue | `Fuchsia | `Gray | `Green | `Lime | `Maroon + | `Navy | `Olive | `Purple | `Red | `Silver | `Teal | `White | `Yellow + | `Hex of string | `RGB of int * int * int ] + type contenttype = string + type contenttypes = contenttype list (* comma-separated *) + type coords = string list (* Comma separated list of coordinates to use in defining areas. *) + type datetime = string + type fpi = string + type frametarget = string + type languagecode = string + type length = [ `Pixels of int | `Percent of int ] + type linktypes = + [`Alternate | `Appendix | `Bookmark | `Chapter | `Contents + | `Copyright | `Glossary | `Help | `Index | `Next | `Prev + | `Section | `Start | `Stylesheet | `Subsection] list + type mediadesc = + [ `All | `Aural | `Braille | `Handheld | `Print + | `Projection | `Screen | `TTY | `TV ] list + + type multilength = [ length | `Relative of int ] + type multilengths = multilength list (* comma-separated *) + type number = int + type pixels = int + type script = string + type shape = string + type text = string + type uri = string + type uris = uri (* space-separated *) + + let color_attrib name value = + string_attrib name + (match value with + | `Aqua -> "aqua" + | `Black -> "black" + | `Blue -> "blue" + | `Fuchsia -> "fuchsia" + | `Gray -> "gray" + | `Green -> "green" + | `Lime -> "lime" + | `Maroon -> "maroon" + | `Navy -> "navy" + | `Olive -> "olive" + | `Purple -> "purple" + | `Red -> "red" + | `Silver -> "silver" + | `Teal -> "teal" + | `White -> "white" + | `Yellow -> "yellow" + | `Hex h -> ("#" ^ h) + | `RGB (r, g, b) -> Printf.sprintf "#%02X%02X%02X" r g b) + + let length_attrib name = function + | `Pixels p -> int_attrib name p + | `Percent p -> string_attrib name (string_of_int p ^ "%") + + let multilength_attrib name = function + | #length as l -> length_attrib name l + | `Relative 1 -> string_attrib name "*" + | `Relative i -> string_attrib name (string_of_int i ^ "*") + + let multilength_to_string = function + | `Pixels p -> string_of_int p + | `Percent p -> string_of_int p ^ "%" + | `Relative 1 -> "*" + | `Relative i -> string_of_int i ^ "*" + + let multilengths_attrib name multilengths = + string_attrib name + (String.concat ", " (List.map multilength_to_string multilengths)) + + let linktype_to_string = function + | `Alternate -> "alternate" + | `Appendix -> "appendix" + | `Bookmark -> "bookmark" + | `Chapter -> "chapter" + | `Contents -> "contents" + | `Copyright -> "copyright" + | `Glossary -> "glossary" + | `Help -> "help" + | `Index -> "index" + | `Next -> "next" + | `Prev -> "prev" + | `Section -> "section" + | `Start -> "start" + | `Stylesheet -> "stylesheet" + | `Subsection -> "subsection" + + let linktypes_attrib name linktypes = + string_attrib name + (String.concat " " (List.map linktype_to_string linktypes)) + + let mediadesc_to_string = function + | `All -> "all" + | `Aural -> "aural" + | `Braille -> "braille" + | `Handheld -> "handheld" + | `Print -> "print" + | `Projection -> "projection" + | `Screen -> "screen" + | `TTY -> "tty" + | `TV -> "tv" + + let mediadesc_attrib name mediadescs = + string_attrib name + (String.concat ", " (List.map mediadesc_to_string mediadescs)) + + (* Core: *) + + let a_class = space_sep_attrib "class" + let a_id = string_attrib "id" + let a_title = string_attrib "title" + + (* I18N: *) + + let a_xml_lang = string_attrib "xml:lang" + + (* Style: *) + + let a_style = string_attrib "style" + + (* Other Attributes *) + + let a_profile = string_attrib "profile" + let a_version = string_attrib "version" + let a_xmlns = function + | `W3_org_1999_xhtml -> string_attrib "xmlns" "http://www.w3.org/1999/xhtml" + + let a_cite = string_attrib "cite" + let a_xml_space = function + | `Preserve -> string_attrib "xml:space" "preserve" + + let a_accesskey c = string_attrib "accesskey" (String.make 1 c) + let a_charset = string_attrib "charset" + let a_href = string_attrib "href" + let a_hreflang = string_attrib "hreflang" + let a_rel = linktypes_attrib "rel" + let a_rev = linktypes_attrib "rev" + let a_tabindex = int_attrib "tabindex" + let a_type = string_attrib "type" + + let a_alt = string_attrib "alt" + let a_height p = length_attrib "height" p + let a_longdesc = string_attrib "longdesc" + let a_src = string_attrib "src" + let a_width p = length_attrib "width" p + + let a_for = string_attrib "for" + let a_selected = function + | `Selected -> string_attrib "selected" "selected" + let a_value = string_attrib "value" + let a_action = string_attrib "action" + let a_method m = + string_attrib "method" (match m with `Get -> "get" | `Post -> "post") + let a_enctype = string_attrib "enctype" + + let a_checked = function + | `Checked -> string_attrib "checked" "checked" + let a_maxlength = int_attrib "maxlength" + let a_name = string_attrib "name" + +(* XHTML 1.0 allows the name attribute for more elements:*) + let a_name_01_00 = string_attrib "name" + + let a_size = int_attrib "size" + let a_input_type it = + string_attrib "type" + (match it with + | `Text -> "text" + | `Password -> "password" + | `Checkbox -> "checkbox" + | `Radio -> "radio" + | `Submit -> "submit" + | `Reset -> "reset" + | `Hidden -> "hidden") + let a_multiple = function + | `Multiple -> string_attrib "multiple" "multiple" + let a_cols = int_attrib "cols" + let a_rows = int_attrib "rows" + + let a_summary = string_attrib "summary" + + let a_abbr = string_attrib "attrib" + let a_align a = + string_attrib "align" + (match a with + | `Left -> "left" + | `Center -> "center" + | `Right -> "right" + | `Justify -> "justify" + | `Char -> "char") + let a_axis = string_attrib "axis" + let a_colspan = int_attrib "colspan" + let a_headers = space_sep_attrib "headers" + let a_rowspan = int_attrib "rowspan" + let a_scope s = + string_attrib "scope" + (match s with + | `Row -> "row" + | `Col -> "col" + | `Rowgroup -> "rowgroup" + | `Colgroup -> "colgroup") + let a_valign v = + string_attrib "valign" + (match v with + | `Top -> "top" + | `Middle -> "middle" + | `Bottom -> "bottom" + | `Baseline -> "baseline") + + let a_border = int_attrib "border" + let a_cellpadding = length_attrib "cellpadding" + let a_cellspacing = length_attrib "cellspacing" + let a_datapagesize = string_attrib "datapagesize" + let a_frame f = + string_attrib "frame" + (match f with + | `Void -> "void" + | `Above -> "above" + | `Below -> "below" + | `Hsides -> "hsides" + | `LHS -> "lhs" + | `RHS -> "rhs" + | `Vsides -> "vsides" + | `Box -> "box" + | `Border -> "border") + let a_rules r = + string_attrib "rules" + (match r with + | `None -> "none" + | `Groups -> "groups" + | `Rows -> "rows" + | `Cols -> "cols" + | `All -> "all") + let a_char c = string_attrib "char" (String.make 1 c) + let a_charoff = length_attrib "charoff" + + let a_fs_rows mls = multilengths_attrib "rows" mls + let a_fs_cols mls = multilengths_attrib "cols" mls + let a_frameborder b = + int_attrib "frameborder" (match b with `Zero -> 0 | `One -> 1) + let a_marginheight = int_attrib "marginheight" + let a_marginwidth = int_attrib "marginwidth" + let a_noresize `Noresize = string_attrib "noresize" "noresize" + let a_scrolling s = + string_attrib "scrolling" + (match s with + | `Yes -> "yes" + | `No -> "no" + | `Auto -> "auto") + + let a_target = string_attrib "target" + + let a_content = string_attrib "content" + let a_http_equiv = string_attrib "http-equiv" + let a_scheme = string_attrib "scheme" + + let a_media = mediadesc_attrib "media" + + type 'a elt = XML.elt + + type html = [`Html] elt + + (* NB: These are more general than the ones in xHTML.mli *) + + type ('a, 'b) nullary = ?a:('a attrib list) -> unit -> 'b elt + type ('a, 'b, 'c) unary = ?a:('a attrib list) -> 'b elt -> 'c elt + type ('a, 'b, 'c, 'd) binary = ?a:('a attrib list) -> 'b elt -> 'c elt -> 'd elt + type ('a, 'b, 'c) star = ?a:('a attrib list) -> 'b elt list -> 'c elt + type ('a, 'b, 'c) plus = ?a:('a attrib list) -> 'b elt -> 'b elt list -> 'c elt + + let terminal tag ?a () = XML.leaf ?a tag + (* let nullary tag ?a () = XML.node ?a tag [] *) + let unary tag ?a elt = XML.node ?a tag [elt] + let binary tag ?a elt1 elt2 = XML.node ?a tag [elt1; elt2] + let star tag ?a elts = XML.node ?a tag elts + let plus tag ?a elt elts = XML.node ?a tag (elt :: elts) + + module STRUCTURE = + struct + type t = [ `Body | `Head | `Html | `Title ] + end + + let body = star "body" + let head = plus "head" + let title = unary "title" + let html = binary "html" + + let pcdata = XML.pcdata + let entity = XML.entity + + let space () = entity "nbsp" + + module TEXT = + struct + type heading = [ `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ] + type block = [ `Address | `Blockquote | `Div | `P | `Pre ] + type inline = + [ `Abbr | `Acronym | `Br | `Cite | `Code | `Dfn + | `Em | `Kbd | `Q | `Samp | `Span | `Strong | `Var ] + type flow = [ heading | block | inline ] + end + + let h1 = star "h1" + let h2 = star "h2" + let h3 = star "h3" + let h4 = star "h4" + let h5 = star "h5" + let h6 = star "h6" + + let address = star "address" + let blockquote = star "blockquote" + let div = star "div" + let p = star "p" + let pre = star "pre" + + let abbr = star "abbr" + let acronym = star "acronym" + let br = terminal "br" + let cite = star "cite" + let code = star "code" + let dfn = star "dfn" + let em = star "em" + let kbd = star "kbd" + let q = star "q" + let samp = star "samp" + let span = star "span" + let strong = star "strong" + + module HYPERTEXT = + struct + type inline = [ `A ] + type flow = inline + end + + let a = star "a" + + module LIST = + struct + type list = [ `Dl | `Ol | `Ul ] + type t = [ `Dd | `Dt | `Li ] + type flow = list + end + + let dl = plus "dl" + let ol = plus "ol" + let ul = plus "ul" + let dd = star "dd" + let dt = star "dt" + let li = star "li" + + module PRESENTATION = + struct + type block = [ `Hr ] + type inline = [ `B | `Big | `I | `Small | `Sub | `Sup | `Tt ] + end + + let hr = terminal "hr" + let b = star "b" + let big = star "big" + let i = star "i" + let small = star "small" + let sub = star "sub" + let sup = star "sup" + let tt = star "tt" + + module FORMS = + struct + type t = [ `Option ] + type form = [ `Form ] + type formctrl_sans_label = [ `Input | `Select | `Textarea ] + type formctrl = [ `Input | `Label | `Select | `Textarea ] + type block = form + type inline_sans_label = formctrl_sans_label + type inline = formctrl + type flow_sans_label = [block | inline_sans_label ] + type flow = [ block | inline ] + end + + module Basic_Forms = + struct + let form ~action ?(a = []) elts = + XML.node ~a:(a_action action :: a) "form" elts + let input = terminal "input" + let label = star "label" + let option = unary "option" + let select = plus "select" + let textarea ~rows ~cols ?(a = []) elt = + XML.node ~a:(a_rows rows :: a_cols cols :: a) "textarea" [elt] + end + + module TABLES = + struct + type t = [ `Caption | `Td | `Th | `Tr ] + type block = [ `Table ] + type flow = block + end + + let list_of_option = function + | Some x -> [x] + | None -> [] + + let list_of_list_option = function + | Some x -> x + | None -> [] + + module Basic_Tables = + struct + let a_align = a_align + let a_scope = a_scope + let a_valign = a_valign + let caption = star "caption" + let table ?caption ?a elt elts = + XML.node ?a "table" (list_of_option caption @ elt :: elts) + let td = star "td" + let th = star "th" + let tr = plus "tr" + end + + let caption = star "caption" + + let cols_option = function + | Some (`Cols c) -> c + | Some (`Colgroups c) -> c + | None -> [] + + let table ?caption ?columns ?a elt elts = + XML.node ?a "table" + (list_of_option caption @ cols_option columns @ elt :: elts) + + let tablex ?caption ?columns ?thead ?tfoot ?a elt elts = + XML.node ?a "table" + (list_of_option caption @ cols_option columns @ + list_of_option thead @ list_of_option tfoot @ elt :: elts) + + let td = star "td" + let th = star "th" + let tr = plus "tr" + + let col = terminal "col" + let colgroup = star "colgroup" + let thead = plus "thead" + let tbody = plus "tbody" + let tfoot = plus "tfoot" + + module IMAGE = + struct + type inline = [ `Img ] + end + + let img ~src ~alt ?(a = []) () = + XML.leaf ~a:(a_src src :: a_alt alt :: a) "img" + + let frameset ?noframes ?a elt elts = + XML.node ?a "frameset" + (elt :: elts @ (match noframes with None -> [] | Some e -> [e])) + let frame ~src ?(a = []) () = + XML.leaf ~a:(a_src src :: a) "frame" + let noframes = unary "noframes" + + module METAINFORMATION = + struct + type t = [ `Meta ] + end + + let meta ~content ?(a = []) () = + XML.leaf ~a:(a_content content :: a) "meta" + + module STYLE_SHEET = + struct + type t = [ `Style ] + end + + let style ~contenttype ?(a = []) elts = + XML.node ~a:(a_type contenttype :: a) "style" elts + + module LINK = + struct + type t = [ `Link ] + end + + let link = terminal "link" + + module BASE = + struct + type t = [ `Base ] + end + + let base ~href () = + XML.leaf ~a:[a_href href] "base" + + type block = + [ TEXT.block | PRESENTATION.block | FORMS.block | TABLES.block ] + type block_sans_form = + [ TEXT.block | PRESENTATION.block | TABLES.block ] + + type flow = + [ TEXT.flow | HYPERTEXT.flow | LIST.flow | FORMS.flow | TABLES.flow ] + type flow_sans_table = + [ TEXT.flow | HYPERTEXT.flow | LIST.flow | FORMS.flow ] + + type inline = + [ TEXT.inline | HYPERTEXT.inline | PRESENTATION.inline + | FORMS.inline | IMAGE.inline] + + type inline_sans_a = + [ TEXT.inline | PRESENTATION.inline | FORMS.inline | IMAGE.inline] + type inline_sans_label = + [ TEXT.inline | HYPERTEXT.inline | PRESENTATION.inline + | FORMS.inline_sans_label | IMAGE.inline] + + type heading = TEXT.heading + + (* I/O *) + + let compose_doctype dt args = + " "\"" ^ a ^ "\"") args) ^ ">\n" + + let doctype = function + | `HTML_v03_02 -> + compose_doctype "html" ["-//W3C//DTD HTML 3.2 Final//EN"] + | `HTML_v04_01 -> + compose_doctype "html" ["-//W3C//DTD HTML 4.01//EN"; + "http://www.w3.org/TR/html4/strict.dtd"] + | `XHTML_01_00 -> + compose_doctype "html" ["-//W3C//DTD XHTML 1.0 Strict//EN"; + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd"] + | `XHTML_01_01 -> + compose_doctype "html" ["-//W3C//DTD XHTML 1.1//EN"; + "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"] + + let no_break = + ["title"; + "h1"; "h2"; "h3"; "h4"; "h5"; "h6"; + "address"; "blockquote"; "div"; "p"; + "li"; "dd"; "dt"; "td"; "th"] + + let preformatted = + ["pre"] + + let output version ?encode ?encoding outs page = + XML.decl ?encoding outs (); + outs (doctype version); + XML.output ~preformatted ~no_break ?encode outs page + + let pretty_print version ?width ?encode ?encoding outs page = + XML.decl ?encoding outs (); + outs (doctype version); + XML.pretty_print ?width ~preformatted ~no_break ?encode outs page + + (* Tools *) + + let version = function + | `XHTML_01_00 -> "XHTML 1.0" + | `XHTML_01_01 -> "XHTML 1.1" + + let standard = function + | `XHTML_01_00 -> "http://www.w3.org/TR/xhtml1/" + | `XHTML_01_01 -> "http://www.w3.org/TR/xhtml11/" + + let validator = + "http://validator.w3.org/check/referer" + + let compose_validator_icon icon alt = + a ~a:[a_href validator] + [img ~src:icon ~alt ~a:[a_height (`Pixels 31); a_width (`Pixels 88)] ()] + + let validator_icon = function + | `XHTML_01_00 -> compose_validator_icon + "http://www.w3.org/Icons/valid-xhtml10" "Valid XHTML 1.0!" + | `XHTML_01_01 -> compose_validator_icon + "http://www.w3.org/Icons/valid-xhtml11" "Valid XHTML 1.1!" + + let addto_class name = + XML.amap (fun _ a -> XML.add_space_sep_attrib "class" name a) + + let addto_class1 name = + XML.amap1 (fun _ a -> XML.add_space_sep_attrib "class" name a) + + let set_rowspan n = + XML.amap1 (fun _ a -> XML.add_int_attrib "rowspan" n a) + + let rewrite_hrefs f = + XML.amap (fun _ a -> XML.map_string_attrib ((=) "href") f a) + + let all_hrefs = XML.all_string_attribs "href" + let all_anchors = XML.all_string_attribs ~is_elt:((=) "a") "id" + + let amap = XML.amap + let amap1 = XML.amap1 + + let rm_attrib = XML.rm_attrib + let rm_attrib_from_list = XML.rm_attrib_from_list + + end + +module M_01_00 : T_01_00 = + struct + module M = Version + include M + let xhtml_version = `XHTML_01_00 + let version = M.version xhtml_version + let standard = M.standard xhtml_version + let output = M.output xhtml_version + let pretty_print = M.pretty_print xhtml_version + let validator_icon () = M.validator_icon xhtml_version + let all_anchors elt = + M.all_anchors elt @ XML.all_string_attribs ~is_elt:((=) "a") "name" elt + end + +module M_01_01 : T_01_01 = + struct + module M = Version + include M + let xhtml_version = `XHTML_01_01 + let version = M.version xhtml_version + let standard = M.standard xhtml_version + let output = M.output xhtml_version + let pretty_print = M.pretty_print xhtml_version + let validator_icon () = M.validator_icon xhtml_version + end + +module M = M_01_01 diff --git a/src/optimizer/xhtml/xHTML.mli b/src/optimizer/xhtml/xHTML.mli new file mode 100644 index 0000000..19ccfa2 --- /dev/null +++ b/src/optimizer/xhtml/xHTML.mli @@ -0,0 +1,969 @@ +(* $Id: xHTML.mli,v 1.30 2005/06/20 17:57:58 ohl Exp $ + + Copyright (C) 2004 by Thorsten Ohl + + XHTML 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, or (at your option) + any later version. + + XHTML 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., 675 Mass Ave, Cambridge, MA 02139, USA. *) + +(* IDEAS: + + It might be possible to factorize attributes and elements into separate + modules. Problems are attributes like [class] and [for] that class with + reserved words. Then the [a_] prefix would have to be maintained and the + only advantage are a potentially better mapping of the XHTML modularization + to O'Caml modules. *) + +(** Typesafe constructors for XHTML 1.1 documents. + @see W3C Recommendation *) + +module type T = + sig + +(** The elements, attributes, attribute types and data types are given names + that match the names in the W3C recommendation as closely as allowed by + a strict typing discipline and the lexical conventions of O'Caml: + {ul + {- {e elements} are implemented as O'Caml constructors with the same name as + in the W3C recommendation. The domain and codomain are specified as ['a elt], + where ['a] is a concrete phantom type build out of polymorphic variants.} + {- {e attributes} are implemented as O'Caml constructors with [a_] prefixed to the + name. The name is the same as in the W3C recommendation, unless an additional + prefix is required to disambiguate: + {ul + {- [a_fs_rows] and [a_fs_cols] instead of [a_rows] and [a_cols] for framesets, + because of the different argument types.}}} + {- {e attribute types} are implemented as O'Caml types that all have the same names + as in the W3C recommendation, but are all lowercase.} + {- {e data types} are also implemented as O'Caml types that all have the same names + as in the W3C recommendation and are again all lowercase.}} + + Finite sets of alternatives are mapped to polymorphic variants. + + The phantom type is always the {e most general} required by any (supported) + version of the standard. Type discipline is enforced by exporting or not-exporting + the corresponding constructor. *) + +(** {1 Attribute Types} + @see Modularization of XHTML *) + + type cdata = string +(** Character data *) + + type id = string +(** A document-unique identifier *) + + type idref = string +(** A reference to a document-unique identifier *) + + type idrefs = idref list +(** A space-separated list of references to document-unique identifiers *) + + type name = string +(** A name with the same character constraints as ID above *) + + type nmtoken = string +(** A name composed of only name tokens as defined in XML 1.0 + @see XML 1.0 *) + + type nmtokens = nmtoken list +(** One or more white space separated NMTOKEN values *) + + type pcdata = string +(** Processed character data *) + +(** {2 Data Types} *) + + type character = char +(** A single character from ISO 10646. *) + + type charset = string +(** A character encoding, as per RFC2045 (MIME). + @see RFC2045 *) + + type charsets = charset list +(** A space-separated list of character encodings, as per RFC2045 (MIME). + @see RFC2045 *) + + type color = + [ `Aqua | `Black | `Blue | `Fuchsia | `Gray | `Green | `Lime | `Maroon + | `Navy | `Olive | `Purple | `Red | `Silver | `Teal | `White | `Yellow + | `Hex of string | `RGB of int * int * int ] +(** The attribute value type [color] refers to color definitions as specified in + SRGB. A color value may either be a hexadecimal number (prefixed by a hash mark) + or one of the following sixteen color names. The color names are case-insensitive. + @see A Standard Default Color Space for the Internet. *) + + type contenttype = string +(** A media type, as per RFC2045 (MIME). + @see RFC2045 *) + + type contenttypes = contenttype list +(** A comma-separated list of media types, as per RFC2045 (MIME). + @see RFC2045 *) + + type coords = string list +(** Comma- separated list of coordinates to use in defining areas. *) + + type datetime = string +(** Date and time information. *) + + type fpi = string +(** A character string representing an SGML Formal Public Identifier. *) + + type frametarget = string +(** Frame name used as destination for results of certain actions. *) + + type languagecode = string +(** A language code, as per RFC3066. + @see RFC3066 *) + + type length = [ `Pixels of int | `Percent of int ] +(** The value may be either in pixels or a percentage of the available + horizontal or vertical space. Thus, the value [`Percent 50] means half of + the available space. *) + + type linktypes = + [ `Alternate | `Appendix | `Bookmark | `Chapter | `Contents + | `Copyright | `Glossary | `Help | `Index | `Next | `Prev + | `Section | `Start | `Stylesheet | `Subsection] list +(** Authors may use the following recognized link types, listed here with + their conventional interpretations. A LinkTypes value refers to a + space-separated list of link types. White space characters are not + permitted within link types. These link types are case-insensitive, i.e., + ["Alternate"] has the same meaning as ["alternate"]. + + User agents, search engines, etc. may interpret these link types in a + variety of ways. For example, user agents may provide access to linked + documents through a navigation bar. + + {ul + {- [`Alternate]: + Designates substitute versions for the document in which the link occurs. + When used together with the hreflang attribute, it implies a translated + version of the document. When used together with the media attribute, + it implies a version designed for a different medium (or media).} + {- [`Stylesheet]: + Refers to an external style sheet. See the Style Module for details. + This is used together with the link type ["Alternate"] for user-selectable + alternate style sheets.} + {- [`Start]: + Refers to the first document in a collection of documents. + This link type tells search engines which document is considered + by the author to be the starting point of the collection.} + {- [`Next]: + Refers to the next document in a linear sequence of documents. + User agents may choose to pre-load the "next" document, to reduce + the perceived load time.} + {- [`Prev]: + Refers to the previous document in an ordered series of documents. + Some user agents also support the synonym "Previous".} + {- [`Contents]: + Refers to a document serving as a table of contents. Some user + agents also support the synonym ToC (from "Table of Contents").} + {- [`Index]: + Refers to a document providing an index for the current document.} + {- [`Glossary]: + Refers to a document providing a glossary of terms that pertain to + the current document.} + {- [`Copyright]: + Refers to a copyright statement for the current document.} + {- [`Chapter]: + Refers to a document serving as a chapter in a collection of documents.} + {- [`Section]: + Refers to a document serving as a section in a collection of documents.} + {- [`Subsection]: + Refers to a document serving as a subsection in a collection of documents.} + {- [`Appendix]: + Refers to a document serving as an appendix in a collection of documents.} + {- [`Help]: + Refers to a document offering help (more information, links to other + sources information, etc.)} + {- [`Bookmark]: + Refers to a bookmark. A bookmark is a link to a key entry point within + an extended document. The title attribute may be used, for example, to + label the bookmark. Note that several bookmarks may be defined in each + document.}} *) + + type mediadesc = + [ `All | `Aural | `Braille | `Handheld | `Print + | `Projection | `Screen | `TTY | `TV ] list +(** The MediaDesc attribute is a comma-separated list of media descriptors. + The following is a list of recognized media descriptors: + {ul + {- [`Screen]: + Intended for non-paged computer screens.} + {- [`TTY]: + Intended for media using a fixed-pitch character grid, such as + teletypes, terminals, or portable devices with limited display + capabilities.} + {- [`TV]: + Intended for television-type devices (low resolution, color, + limited scrollability).} + {- [`Projection]: + Intended for projectors.} + {- [`Handheld]: + Intended for handheld devices (small screen, monochrome, + bitmapped graphics, limited bandwidth).} + {- [`Print]: + Intended for paged, opaque material and for documents viewed + on screen in print preview mode.} + {- [`Braille]: + Intended for braille tactile feedback devices.} + {- [`Aural]: + Intended for speech synthesizers.} + {- [`All]: + Suitable for all devices.}} + + Future versions of XHTML may introduce new values and may allow + parameterized values. To facilitate the introduction of these + extensions, conforming user agents must be able to parse the media + attribute value as follows: + {ol + {- The value is a comma-separated list of entries. For example, + [media="screen, 3d-glasses, print and resolution > 90dpi"] + is mapped to: ["screen"], ["3d-glasses"], + ["print and resolution > 90dpi"].} + {- Each entry is truncated just before the first character that + isn't a US ASCII letter [\[a-zA-Z\]] (ISO 10646 hex 41-5a, + 61-7a), digit [\[0-9\]] (hex 30-39), or hyphen-minus (hex 2d). + In the example, this gives: ["screen"], ["3d-glasses"], ["print"].} + {- A case-insensitive match is then made with the set of media + types defined above. User agents may ignore entries that + don't match. In the example we are left with ["screen"] and + ["print"].}} + + Note. Style sheets may include media-dependent variations within them + (e.g., the [CSS \@media] construct). In such cases it may be appropriate + to use ["media=all"]. *) + + type multilength = [ length | `Relative of int ] +(** The value may be a Length or a relative length. A relative length + has the form ["i*"], where ["i"] is an integer. When allotting space + among elements competing for that space, user agents allot pixel + and percentage lengths first, then divide up remaining available + space among relative lengths. Each relative length receives a + portion of the available space that is proportional to the integer + preceding the ["*"]. The value ["*"] is equivalent to ["1*"]. Thus, if + 60 pixels of space are available after the user agent allots pixel + and percentage space, and the competing relative lengths are ["1*"], + ["2*"], and ["3*"], the ["1*"] will be allotted 10 pixels, the ["2*"] will be + allotted 20 pixels, and the ["3*"] will be allotted 30 pixels. *) + + type multilengths = multilength list (* comma-separated *) +(** A comma separated list of items of type MultiLength. *) + + type number = int +(** One or more digits. *) + + type pixels = int + +(** The value is an integer that represents the number of pixels of + the canvas (screen, paper). Thus, the value ["50"] means fifty + pixels. For normative information about the definition of a pixel, + please consult CSS2. + @see CSS2 *) + + type script = string +(** Script data can be the content of the ["script"] element and the + value of intrinsic event attributes. User agents must not evaluate + script data as HTML markup but instead must pass it on as data to a + script engine. + + The case-sensitivity of script data depends on the scripting + language. + + Please note that script data that is element content may not + contain character references, but script data that is the value of + an attribute may contain them. *) + + type shape = string +(** The shape of a region. *) + + type text = string +(** Arbitrary textual data, likely meant to be human-readable. *) + + type uri = string +(** A Uniform Resource Identifier, as per RFC2396. + @see RFC2396 *) + + type uris = uri +(** A space-separated list of Uniform Resource Identifiers, as per RFC2396. + @see RFC2396 *) + + +(** {1 Common Attributes} *) + + type 'a attrib + type 'a attribs + (** ['a] is known as a {i phantom type}. The implementation is + actually monomorphic (the different element types are distinguished + by a homogeneous variable, such as their textual representation) + and the type variable [`a] is just used by the type checker. + + NB: It might be possible to use polymorphic variants directly, without + phantom types, but the implementation is likely to be more involved. *) + +(** {2 Core} *) + + type core = [ `Class | `Id | `Title ] + + val a_class : nmtokens -> [>`Class] attrib +(** This attribute assigns a class name or set of class names to an + element. Any number of elements may be assigned the same class + name or names. *) + + val a_id : id -> [>`Id] attrib +(** This attribute assigns a name to an element. This name must be + unique in a document. *) + + val a_title : cdata -> [>`Title] attrib +(** This attribute offers advisory information about the element for + which it is set. *) + +(** Values of the title attribute may be rendered by user agents in a + variety of ways. For instance, visual browsers frequently display + the title as a {i tool tip} (a short message that appears when the + pointing device pauses over an object). Audio user agents may + speak the title information in a similar context. *) + +(** The title attribute has an additional role when used with the [link] + element to designate an external style sheet. Please consult the + section on links and style sheets for details. *) + +(** {2 I18N} *) + + type i18n = [ `XML_lang ] + val a_xml_lang : nmtoken -> [>`XML_lang] attrib + +(** {2 Style} + The Style collection is deprecated, because the Style Attribute Module is + deprecated. *) + + type common = [ core | i18n ] + +(** {1 Modules, Element Sets and Attributes } *) + +(** {2 5.2. Core Modules} *) + +(** {3 5.2.1. Structure Module} *) + + module STRUCTURE : + sig + type t = [ `Body | `Head | `Html | `Title ] + end + + val a_profile : uri -> [>`Profile] attrib + val a_version : cdata -> [>`Version] attrib + val a_xmlns : [< `W3_org_1999_xhtml ] -> [>`XMLns] attrib + +(** {3 5.2.2. Text Module} *) + + module TEXT : + sig + type heading = [ `H1 | `H2 | `H3 | `H4 | `H5 | `H6 ] + type block = [ `Address | `Blockquote | `Div | `P | `Pre ] + type inline = + [ `Abbr | `Acronym | `Br | `Cite | `Code | `Dfn + | `Em | `Kbd | `Q | `Samp | `Span | `Strong | `Var ] + type flow = [ heading | block | inline ] + end + + val a_cite : uri -> [>`Cite] attrib + val a_xml_space : [< `Preserve ] -> [>`XML_space] attrib + +(** {3 5.2.3. Hypertext Module} *) + + module HYPERTEXT : + sig + type inline = [ `A ] + type flow = inline + end + + val a_accesskey : character -> [>`Accesskey] attrib +(** This attribute assigns an access key to an element. An access key + is a single character from the document character + set. NB: authors should consider the input method of the + expected reader when specifying an accesskey. *) + + val a_charset : charset -> [>`Charset] attrib +(** This attribute specifies the character encoding of the resource + designated by the link. Please consult the section on character + encodings for more details. *) + + val a_href : uri -> [>`Href] attrib +(** This attribute specifies the location of a Web resource, thus + defining a link between the current element (the source anchor) + and the destination anchor defined by this attribute. *) + + val a_hreflang : languagecode -> [>`Hreflang] attrib +(** This attribute specifies the base language of the resource + designated by href and may only be used when href is specified. *) + + val a_rel : linktypes -> [>`Rel] attrib +(** This attribute describes the relationship from the current document + to the anchor specified by the href attribute. The value of this attribute + is a space-separated list of link types. *) + + val a_rev : linktypes -> [>`Rev] attrib +(** This attribute is used to describe a reverse link from the anchor specified + by the href attribute to the current document. The value of this attribute + is a space-separated list of link types. *) + + val a_tabindex : number -> [>`Tabindex] attrib +(** This attribute specifies the position of the current element in + the tabbing order for the current document. This value must be a + number between 0 and 32767. User agents should ignore leading + zeros. *) + + val a_type : contenttype -> [>`Type] attrib +(** This attribute gives an advisory hint as to the content type of + the content available at the link target address. It allows user + agents to opt to use a fallback mechanism rather than fetch the + content if they are advised that they will get content in a + content type they do not support.Authors who use this attribute + take responsibility to manage the risk that it may become + inconsistent with the content available at the link target + address. *) + +(** {3 5.2.3. List Module} *) + + module LIST : + sig + type list = [ `Dl | `Ol | `Ul ] + type t = [ `Dd | `Dt | `Li ] + type flow = list + end + +(** {2 5.3. Applet Module} + This module is deprecated. Similar functionality + can be found in the Object Module. *) + +(** {2 5.4. Text Extension Modules} *) + +(** {3 5.4.1. Presentation Module} *) + + module PRESENTATION : + sig + type block = [ `Hr ] + type inline = [ `B | `Big | `I | `Small | `Sub | `Sup | `Tt ] + end + +(** {3 5.4.2. Edit Module} *) + +(** {3 5.4.3. Bi-directional Text Module} *) + +(** {2 5.5. Forms Modules} *) + +(** {3 5.5.1. Basic Forms Module} *) + + module FORMS : + sig + type t = [ `Option ] + type form = [ `Form ] + type formctrl_sans_label = [ `Input | `Select | `Textarea ] + type formctrl = [ formctrl_sans_label | `Label ] + type block = form + type inline_sans_label = formctrl_sans_label + type inline = formctrl + type flow_sans_label = [block | inline_sans_label ] + type flow = [ block | inline ] + end + + val a_action : uri -> [>`Action] attrib +(** This attribute specifies a form processing agent. User agent + behavior for a value other than an HTTP URI is undefined. *) + + val a_checked : [< `Checked ] -> [>`Checked] attrib +(** When the [type] attribute has the value ["radio"] or ["checkbox"], + this boolean attribute specifies that the button is on. User + agents must ignore this attribute for other control types. *) + + val a_cols : number -> [>`Cols] attrib +(** This attribute specifies the visible width in average character + widths. Users should be able to enter longer lines than this, so + user agents should provide some means to scroll through the + contents of the control when the contents extend beyond the + visible area. User agents may wrap visible text lines to keep long + lines visible without the need for scrolling. *) + + val a_enctype : contenttype -> [>`Enctype] attrib + val a_for : idref -> [>`For] attrib + val a_maxlength : number -> [>`Maxlength] attrib + val a_method : [< `Get | `Post ] -> [>`Method] attrib + val a_multiple : [< `Multiple ] -> [>`Multiple] attrib + + val a_name : cdata -> [>`Name] attrib +(** This attribute assigns the control name. *) + + val a_rows : number -> [>`Rows] attrib +(** This attribute specifies the number of visible text lines. Users + should be able to enter more lines than this, so user agents + should provide some means to scroll through the contents of the + control when the contents extend beyond the visible area. *) + + val a_selected : [< `Selected ] -> [>`Selected] attrib +(** When set, this boolean attribute specifies that this option is pre-selected. *) + + val a_size : number -> [>`Size] attrib + val a_src : uri -> [>`Src] attrib + val a_input_type : + [< `Text | `Password | `Checkbox | `Radio | `Submit | `Reset | `Hidden ] -> + [>`Input_Type] attrib + + val a_value : cdata -> [>`Value] attrib +(** This attribute specifies the initial value of the control. If this + attribute is not set, the initial value is set to the contents of + the [option] element. *) + + +(** {3 5.5.2. Forms Module} *) + +(** {2 5.6. Table Modules} *) + +(** {3 5.6.1. Basic Tables Module} *) + + module TABLES : + sig + type t = [ `Caption | `Td | `Th | `Tr ] + type block = [ `Table ] + type flow = block + end + + val a_abbr : text -> [>`Abbr] attrib + val a_align : [< `Left | `Center | `Right | `Justify | `Char ] -> + [>`Align] attrib + val a_axis : cdata -> [>`Axis] attrib + val a_colspan : number -> [>`Colspan] attrib + val a_headers : idrefs -> [>`Headers] attrib + val a_rowspan : number -> [>`Rowspan] attrib + val a_scope : [< `Row | `Col | `Rowgroup | `Colgroup ] -> [>`Scope] attrib + val a_summary : text -> [>`Summary] attrib + val a_valign : [< `Top | `Middle | `Bottom | `Baseline ] -> + [>`Valign] attrib + +(** {3 5.6.2. Tables Module} *) + + val a_border : pixels -> [>`Border] attrib + val a_cellpadding : length -> [>`Cellpadding] attrib + val a_cellspacing : length -> [>`Cellspacing] attrib + val a_datapagesize : cdata -> [>`Datapagesize] attrib + val a_frame : + [< `Void | `Above | `Below | `Hsides | `LHS | `RHS + | `Vsides | `Box | `Border ] -> [>`Frame] attrib + val a_rules : [< `None | `Groups | `Rows | `Cols | `All ] -> [>`Rules] attrib + val a_char : character -> [>`Char] attrib + val a_charoff : length -> [>`Charoff] attrib + +(** {2 5.7. Image Module} *) + + module IMAGE : + sig + type inline = [ `Img ] + end + + val a_alt : text -> [>`Alt] attrib + val a_height : length -> [>`Height] attrib + val a_longdesc : uri -> [>`Longdesc] attrib + val a_width : length -> [>`Width] attrib + +(** {2 5.8. Client-side Image Map Module} *) + +(** {2 5.9. Server-side Image Map Module} *) + +(** {2 5.10. Object Module} *) + +(** {2 5.11. Frames Module} *) + + val a_fs_rows : multilengths -> [>`FS_Rows] attrib + val a_fs_cols : multilengths -> [>`FS_Cols] attrib + val a_frameborder : [< `Zero | `One ] -> [>`Frameborder] attrib + val a_marginheight : pixels -> [>`Marginheight] attrib + val a_marginwidth : pixels -> [>`Marginwidth] attrib + val a_noresize : [< `Noresize ] -> [>`Noresize] attrib + val a_scrolling : [< `Yes | `No | `Auto ] -> [>`Scrolling] attrib + +(** {2 5.12. Target Module} *) + + val a_target : frametarget -> [>`Target] attrib + +(** {2 5.13. Iframe Module} *) + +(** {2 5.14. Intrinsic Events Module} *) + +(** {2 5.15. Metainformation Module} *) + + module METAINFORMATION : + sig + type t = [ `Meta ] + end + + val a_content : cdata -> [>`Content] attrib + val a_http_equiv : nmtoken -> [>`Http_equiv] attrib + val a_scheme : cdata -> [>`Scheme] attrib + +(** {2 5.16. Scripting Module} *) + +(** {2 5.17. Style Sheet Module} *) + + module STYLE_SHEET : + sig + type t = [ `Style ] + end + + val a_media : mediadesc -> [>`Media] attrib + +(** {2 5.18. Style Attribute Module} *) + +(** {2 5.19. Link Module} *) + + module LINK : + sig + type t = [ `Link ] + end + +(** {2 5.20. Base Module} *) + + module BASE : + sig + type t = [ `Base ] + end + +(** {2 5.21. Name Identification Module} + This module is deprecated in XHTML 1.1, but supported for XHTML 1.0 + using [`Name_01_00] . *) + +(** {2 5.22. Legacy Module} *) + +(** {1 Combined Element Sets:} *) + + type block = + [ TEXT.block | PRESENTATION.block | FORMS.block | TABLES.block ] + type block_sans_form = + [ TEXT.block | PRESENTATION.block | TABLES.block ] + + type flow = + [ TEXT.flow | HYPERTEXT.flow | LIST.flow | FORMS.flow | TABLES.flow ] + type flow_sans_table = + [ TEXT.flow | HYPERTEXT.flow | LIST.flow | FORMS.flow ] + + type inline = + [ TEXT.inline | HYPERTEXT.inline | PRESENTATION.inline + | FORMS.inline | IMAGE.inline] + type inline_sans_a = + [ TEXT.inline | PRESENTATION.inline + | FORMS.inline | IMAGE.inline] + type inline_sans_label = + [ TEXT.inline | HYPERTEXT.inline | PRESENTATION.inline + | FORMS.inline_sans_label | IMAGE.inline] + + type heading = TEXT.heading + +(** {1 Elements} *) + + type 'a elt + +(** {2 Element Constructor Types} *) + + type ('a, 'b) nullary = ?a:('a attrib list) -> unit -> 'b elt + type ('a, 'b, 'c) unary = ?a:('a attrib list) -> 'b elt -> 'c elt + type ('a, 'b, 'c, 'd) binary = ?a:('a attrib list) -> 'b elt -> 'c elt -> 'd elt + + type ('a, 'b, 'c) star = ?a:('a attrib list) -> 'b elt list -> 'c elt +(** Star '*' denotes any number of children, uncluding zero. *) + + type ('a, 'b, 'c) plus = ?a:('a attrib list) -> 'b elt -> 'b elt list -> 'c elt +(** Plus '+' requires at least one child. *) + +(** {2 Structure} *) + + type html = [`Html] elt + + val html : ?a:([< i18n | `Version | `XMLns ] attrib list) -> + [< `Head ] elt -> [< `Body | `Frameset ] elt -> html + val head : ([< i18n | `Profile ], + [< `Title | `Meta | `Link | `Style | `Base ], [>`Head]) plus + val title : ([< i18n ], [< `PCDATA ], [>`Title]) unary + val body : ([< common ], [< heading | block | LIST.list ], [>`Body]) star + +(** {2 Data} *) + + val pcdata : string -> [>`PCDATA] elt + val entity : string -> [>`PCDATA] elt + val space : unit -> [>`PCDATA] elt + +(** {2 Text} *) + + val h1 : ([< common ], [< `PCDATA | inline ], [>`H1]) star + val h2 : ([< common ], [< `PCDATA | inline ], [>`H2]) star + val h3 : ([< common ], [< `PCDATA | inline ], [>`H3]) star + val h4 : ([< common ], [< `PCDATA | inline ], [>`H4]) star + val h5 : ([< common ], [< `PCDATA | inline ], [>`H5]) star + val h6 : ([< common ], [< `PCDATA | inline ], [>`H6]) star + + val address : ([< common ], [< `PCDATA | inline ], [>`Address]) star + val blockquote : ([< common | `Cite ], + [< `PCDATA | heading | block | LIST.list ], [>`Blockquote]) star + val div : ([< common ], [< `PCDATA | flow ], [>`Div]) star + val p : ([< common ], [< `PCDATA | inline ], [>`P]) star + val pre : ([< common | `XML_space ], [< `PCDATA | inline ], [>`Pre]) star + + val abbr : ([< common ], [< `PCDATA | inline ], [>`Abbr]) star + val acronym : ([< common ], [< `PCDATA | inline ], [>`Acronym]) star + val br : ([< core ], [>`Br]) nullary + val cite : ([< common ], [< `PCDATA | inline ], [>`Cite]) star + val code : ([< common ], [< `PCDATA | inline ], [>`Code]) star + val dfn : ([< common ], [< `PCDATA | inline ], [>`Dfn]) star + val em : ([< common ], [< `PCDATA | inline ], [>`Em]) star + val kbd : ([< common ], [< `PCDATA | inline ], [>`Kbd]) star + val q : ([< common | `Cite ], [< `PCDATA | inline ], [>`Q]) star + val samp : ([< common ], [< `PCDATA | inline ], [>`Samp]) star + val span : ([< common ], [< `PCDATA | inline ], [>`Span]) star + val strong : ([< common ], [< `PCDATA | inline ], [>`Strong]) star + +(** {2 Hypertext} *) + + val a : ([< common | `Accesskey | `Charset | `Href | `Hreflang + | `Name_01_00 | `Rel | `Rev | `Tabindex | `Target | `Type ], + [< `PCDATA | inline_sans_a ], [>`A]) star + +(** {2 List} *) + + val dl : ([< common ], [< `Dt | `Dd ], [>`Dl]) plus + val ol : ([< common ], [< `Li ], [>`Ol]) plus + val ul : ([< common ], [< `Li ], [>`Ul]) plus + val dd : ([< common ], [< `PCDATA | flow ], [>`Dd]) star + val dt : ([< common ], [< `PCDATA | inline ], [>`Dt]) star + val li : ([< common ], [< `PCDATA | flow ], [>`Li]) star + +(** {2 Presentation} *) + + val hr : ([< common ], [>`Hr]) nullary + val b : ([< common ], [< `PCDATA | inline ], [>`B]) star + val big : ([< common ], [< `PCDATA | inline ], [>`Big]) star + val i : ([< common ], [< `PCDATA | inline ], [>`I]) star + val small : ([< common ], [< `PCDATA | inline ], [>`Small]) star + val sub : ([< common ], [< `PCDATA | inline ], [>`Sub]) star + val sup : ([< common ], [< `PCDATA | inline ], [>`Sup]) star + val tt : ([< common ], [< `PCDATA | inline ], [>`Tt]) star + +(** {2 Forms} *) + +(** {3 Basic Forms} *) + +(** One can use [open Basic_Forms] to enable basic forms. *) + + module Basic_Forms : + sig + val form : action:uri -> + ([< common | `Enctype | `Method | `Name_01_00 | `Target ], + [< `PCDATA | heading | LIST.list | block_sans_form ], [>`Form]) star + val input : ([< common | `Accesskey | `Checked | `Maxlength | `Name | `Size + | `Src | `Tabindex | `Input_Type | `Value ], [>`Input]) nullary + val label : ([< common | `Accesskey | `For ], + [< `PCDATA | inline_sans_label ], [>`Label]) star + val option : ([< common | `Selected | `Value ], + [< `PCDATA ], [>`Option]) unary + val select : ([< common | `Multiple | `Name | `Size | `Tabindex ], + [< `Option ], [>`Select]) plus + val textarea : rows:number -> cols:number -> + ([< common | `Accesskey | `Name | `Tabindex ], + [< `PCDATA ], [>`Textarea]) unary + end + +(** {3 Forms} *) + +(** General forms are not implemented yet, but one can use [open Basic_Forms] + to enable basic forms. *) + +(** {2 Tables} *) + +(** {3 Basic Tables} *) + +(** One can use [open Basic_Tables] to switch globally to basic tables. *) + + module Basic_Tables : + sig + val a_align : [< `Left | `Center | `Right ] -> [>`Align] attrib + val a_scope : [< `Row | `Col ] -> [>`Scope] attrib + val a_valign : [< `Top | `Middle | `Bottom ] -> [>`Valign] attrib + + val caption : ([< common ], [< `PCDATA | inline ], [>`Caption]) star + val table : ?caption:([< `Caption ] elt) -> + ([< common | `Summary | `Width ], [< `Tr ], [>`Table]) plus + val td : ([< common | `Abbr | `Align | `Axis | `Colspan | `Headers | `Rowspan + | `Scope | `Valign ], [< `PCDATA | flow_sans_table ], [>`Td]) star + val th : ([< common | `Abbr | `Align | `Axis | `Colspan | `Headers | `Rowspan + | `Scope | `Valign ], [< `PCDATA | flow_sans_table ], [>`Th]) star + val tr : ([< common | `Align | `Valign ], [< `Td | `Th ], [>`Tr]) plus + end + +(** {3 Tables} *) + + val caption : ([< common ], [< `PCDATA | inline ], [>`Caption]) star + + val table : ?caption:([< `Caption ] elt) -> + ?columns:([< `Cols of ([< `Col ] elt list) + | `Colgroups of ([< `Colgroup ] elt list) ]) -> + ([< common | `Border | `Cellpadding | `Cellspacing | `Datapagesize + | `Frame | `Rules | `Summary | `Width ], [< `Tr ], [>`Table]) plus + + val tablex : ?caption:([< `Caption ] elt) -> + ?columns:([< `Cols of ([< `Col ] elt list) + | `Colgroups of ([< `Colgroup ] elt list) ]) -> + ?thead:([< `Thead ] elt) -> ?tfoot:([< `Tfoot ] elt) -> + ([< common | `Border | `Cellpadding | `Cellspacing | `Datapagesize + | `Frame | `Rules | `Summary | `Width ], [< `Tbody ], [>`Table]) plus + + val td : ([< common | `Abbr | `Align | `Axis | `Char | `Charoff + | `Colspan | `Headers | `Rowspan | `Scope | `Valign ], + [< `PCDATA | flow ], [>`Td]) star + val th : ([< common | `Abbr | `Align | `Axis | `Char | `Charoff + | `Colspan | `Headers | `Rowspan | `Scope | `Valign ], + [< `PCDATA | flow ], [>`Th]) star + val tr : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Td | `Th ], [>`Tr]) plus + + val col : ([< common | `Align | `Char | `Charoff + | `Span | `Valign | `Width ], [>`Col]) nullary + val colgroup : ([< common | `Align | `Char | `Charoff + | `Span | `Valign | `Width ], [< `Col ], [>`Colgroup]) star + val thead : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Tr ], [>`Thead]) plus + val tbody : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Tr ], [>`Tbody]) plus + val tfoot : ([< common | `Align | `Char | `Charoff | `Valign ], + [< `Tr ], [>`Tfoot]) plus + +(** {2 Image} *) + + val img : src:uri -> alt:text -> + ([< common | `Height | `Longdesc | `Name_01_00 | `Width ], [>`Img]) nullary + +(** {2 Frames} *) + + val frameset : ?noframes:([< `Noframes ] elt) -> + ([< core | `FS_Rows | `FS_Cols ], [< `Frameset | `Frame ], [>`Frameset]) plus + + val frame : src:uri -> + ([< core | `Frameborder | `Longdesc | `Marginheight | `Marginwidth + | `Name_01_00 | `Noresize | `Scrolling ], [>`Frame]) nullary + + val noframes : ([< common ], [< `Body ], [>`Noframes]) unary + +(** {2 Meta} *) + + val meta : content:cdata -> + ([< i18n | `Http_equiv | `Name | `Scheme ], [>`Meta]) nullary + +(** {2 Style Sheets} *) + + val style : contenttype:contenttype -> + ([< i18n | `Media | `Title | `XML_space ], [< `PCDATA ], [>`Style]) star + +(** {2 Link} *) + + val link : ([< common | `Charset | `Href | `Hreflang | `Media + | `Rel | `Rev | `Target | `Type ], [>`Link]) nullary + +(** {2 Base} *) + + val base : href:uri -> unit -> [>`Base] elt + +(** {1 Output} *) + +(** [?encode] maps strings to HTML and {e must} encode the unsafe characters + ['<'], ['>'], ['"'], ['&'] and the control characters 0-8, 11-12, 14-31, 127 + to HTML entities. [XML.encode_unsafe] is the default for [?encode] in [output] + and [pretty_print] below. Other implementations are provided by the module + [Netencoding] in the + {{:http://www.ocaml-programming.de/programming/ocamlnet.html}OcamlNet} library, e.g.: + [let encode = Netencoding.Html.encode ~in_enc:`Enc_iso88591 ~out_enc:`Enc_usascii ()], + Where national characters are replaced by HTML entities. + The user is of course free to write her own implementation. + @see OcamlNet *) + +(** [~encoding] is the official name of the external character set encoding that + is used by [outs : string -> unit]. *) + + val output : ?encode:(string -> string) -> ?encoding:string -> + (string -> unit) -> html -> unit + + val pretty_print : ?width:int -> + ?encode:(string -> string) -> ?encoding:string -> + (string -> unit) -> html -> unit + +(** {1 Tools} *) + + val version : string + val standard : uri + val validator : uri + val validator_icon : unit -> [>`A] elt +(** A hyperlink to the W3C validator, including the logo. + @see Validator *) + + val addto_class : string -> 'a elt -> 'a elt +(** Add the element and all its subelements to a class. Note that this + is only almost typesafe, because a few elements from the structure class + do not support the class attribute. On the other hand, listing all + allowed elements would be too tedious right now. *) + + val addto_class1 : string -> 'a elt -> 'a elt +(** Add the element to a class. *) + + val set_rowspan : int -> ([< `Th | `Td ] as 'a) elt -> 'a elt +(** Set the rowspan attribute for the element. *) + + val rewrite_hrefs : (string -> string) -> 'a elt -> 'a elt + val all_hrefs : 'a elt -> uri list + val all_anchors : 'a elt -> id list + +(* + val amap : (string -> 'a attribs -> 'a attribs) -> 'b elt -> 'b elt + val amap1 : (string -> 'a attribs -> 'a attribs) -> 'b elt -> 'b elt + + val rm_attrib : (string -> bool) -> 'a attribs -> 'a attribs + val rm_attrib_from_list : + (string -> bool) -> (string -> bool) -> 'a attribs -> 'a attribs + +(** Exporting the following will drive a hole through the type system, + because they allow to add any attribute to any element. *) + val add_int_attrib : string -> int -> 'a attribs -> 'a attribs + val add_string_attrib : string -> string -> 'a attribs -> 'a attribs + val add_comma_sep_attrib : string -> string -> 'a attribs -> 'a attribs + val add_space_sep_attrib : string -> string -> 'a attribs -> 'a attribs +*) + + end + +(** An alias for XHTML 1.1 (for symmetry): + @see XHTML 1.1 - Module-based XHTML *) +module type T_01_01 = T + +(** XHTML 1.0 includes some deprecated features that since + have been removed from XHTML 1.1: + @see Changes from XHTML 1.0 Strict + @see XHTML 1.0: The Extensible HyperText Markup Language *) +module type T_01_00 = + sig + include T + +(** XHTML 1.1 has removed the name attribute from several elements: *) + val a_name_01_00 : cdata -> [>`Name_01_00] attrib + end + + +module M : T +module M_01_01 : T_01_01 +module M_01_00 : T_01_00 + diff --git a/src/optimizer/xhtml/xML.ml b/src/optimizer/xhtml/xML.ml new file mode 100644 index 0000000..a2caa07 --- /dev/null +++ b/src/optimizer/xhtml/xML.ml @@ -0,0 +1,411 @@ +(* $Id: xML.ml,v 1.14 2004/12/13 14:57:45 ohl Exp $ + + Copyright (C) 2004 by Thorsten Ohl + + XHTML 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, or (at your option) + any later version. + + XHTML 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., 675 Mass Ave, Cambridge, MA 02139, USA. *) + +type separator = Space | Comma + +let separator_to_string = function + | Space -> " " + | Comma -> ", " + +type aname = string +type attrib = + | AInt of aname * int + | AStr of aname * string + | AStrL of separator * aname * string list +type attribs = attrib list + +let int_attrib name value = AInt (name, value) +let string_attrib name value = AStr (name, value) +let space_sep_attrib name values = AStrL (Space, name, values) +let comma_sep_attrib name values = AStrL (Comma, name, values) + +let attrib_to_string encode = function + | AInt (name, i) -> name ^ "=\"" ^ string_of_int i ^ "\"" + | AStr (name, s) -> name ^ "=\"" ^ encode s ^ "\"" + | AStrL (sep, name, slist) -> + name ^ "=\"" ^ encode (String.concat (separator_to_string sep) slist) ^ "\"" + +let rec get_int_attrib name = function + | [] -> raise Not_found + | AInt (name', value) :: tail when name' = name -> value + | _ :: tail -> get_int_attrib name tail + +let rec get_string_attrib name = function + | [] -> raise Not_found + | AStr (name', value) :: tail when name' = name -> value + | _ :: tail -> get_string_attrib name tail + +let rec get_attrib_list name = function + | [] -> raise Not_found + | AStrL (_, name', value) :: tail when name' = name -> value + | _ :: tail -> get_attrib_list name tail + +type ename = string +type elt = + | Empty + | Comment of string + | PCDATA of string + | Entity of string + | Leaf of ename * attrib list + | Node of ename * attrib list * elt list + +let amap1 f = function + | Empty | Comment _ | PCDATA _ | Entity _ as elt -> elt + | Leaf (name, attribs) -> Leaf (name, f name attribs) + | Node (name, attribs, elts) -> Node (name, f name attribs, elts) + +let rec amap f = function + | Empty | Comment _ | PCDATA _ | Entity _ as elt -> elt + | Leaf (name, attribs) -> Leaf (name, f name attribs) + | Node (name, attribs, elts) -> Node (name, f name attribs, List.map (amap f) elts) + +let rec add_int_attrib name value = function + | [] -> [AInt (name, value)] + | AInt (name', _) as head :: tail when name' = name -> + AInt (name, value) :: tail + | head :: tail -> head :: add_int_attrib name value tail + +let rec rm_attrib is_attrib = function + | [] -> [] + | (AInt (name, _) | AStr (name, _) | AStrL (_, name, _)) :: tail + when is_attrib name -> rm_attrib is_attrib tail + | head :: tail -> head :: rm_attrib is_attrib tail + +let rec map_int_attrib is_attrib f = function + | [] -> [] + | AInt (name, value) :: tail when is_attrib name -> + AInt (name, f value) :: map_int_attrib is_attrib f tail + | head :: tail -> head :: map_int_attrib is_attrib f tail + +let rec add_string_attrib name value = function + | [] -> [AStr (name, value)] + | AStr (name', _) :: tail when name' = name -> AStr (name, value) :: tail + | head :: tail -> head :: add_string_attrib name value tail + +let rec map_string_attrib is_attrib f = function + | [] -> [] + | AStr (name, value) :: tail when is_attrib name -> + AStr (name, f value) :: map_string_attrib is_attrib f tail + | head :: tail -> head :: map_string_attrib is_attrib f tail + +let rec add_space_sep_attrib name value = function + | [] -> [AStrL (Space, name, [value])] + | AStrL (Space, name', values') :: tail when name' = name -> + AStrL (Space, name, value :: values') :: tail + | head :: tail -> head :: add_space_sep_attrib name value tail + +let rec add_comma_sep_attrib name value = function + | [] -> [AStrL (Comma, name, [value])] + | AStrL (Comma, name', values') :: tail when name' = name -> + AStrL (Comma, name, value :: values') :: tail + | head :: tail -> head :: add_comma_sep_attrib name value tail + +let rec rm_attrib_from_list is_attrib is_value = function + | [] -> [] + | AStrL (sep, name, values) :: tail when is_attrib name -> + begin match List.filter (fun v -> not (is_value v)) values with + | [] -> tail + | values' -> AStrL (sep, name, values') :: tail + end + | head :: tail -> head :: rm_attrib_from_list is_attrib is_value tail + +let rec map_string_attrib_in_list is_attrib f = function + | [] -> [] + | AStrL (sep, name, values) :: tail when is_attrib name -> + AStrL (sep, name, List.map f values) :: map_string_attrib_in_list is_attrib f tail + | head :: tail -> head :: map_string_attrib_in_list is_attrib f tail + +let rec fold of_empty of_comment of_pcdata of_entity of_leaf of_node = function + | Empty -> of_empty () + | Comment s -> of_comment s + | PCDATA s -> of_pcdata s + | Entity s -> of_entity s + | Leaf (name, attribs) -> of_leaf name attribs + | Node (name, attribs, elts) -> + of_node name attribs + (List.map (fold of_empty of_comment of_pcdata of_entity of_leaf of_node) elts) + +(* (* is this AT ALL useful??? *) +let rec foldx of_empty of_comment of_pcdata of_entity of_leaf of_node update_state state = function + | Empty -> of_empty () + | Comment s -> of_comment s + | PCDATA s -> of_pcdata s + | Entity s -> of_entity s + | Leaf (name, attribs) -> of_leaf state name attribs + | Node (name, attribs, elts) -> + of_node state name attribs + (List.map (foldx of_empty of_comment of_pcdata of_entity of_leaf of_node + update_state (update_state name attribs state)) elts) +*) + +let all_attribs access ?(is_elt = fun ename -> true) aname elt = + let access' ename attribs = + if is_elt ename then + try [access aname attribs] with Not_found -> [] + else + [] in + fold (fun () -> []) (fun c -> []) (fun p -> []) (fun e -> []) access' + (fun ename attribs elts -> access' ename attribs @ List.flatten elts) + elt + +let all_int_attribs = all_attribs get_int_attrib +let all_string_attribs = all_attribs get_string_attrib +let all_attribs_list = all_attribs get_attrib_list + +let all_entities elt = + fold (fun () -> []) (fun c -> []) (fun p -> []) (fun e -> [e]) + (fun ename attribs -> []) (fun ename attribs elts -> List.flatten elts) + elt + +let empty () = Empty + +let comment c = Comment c + +let pcdata d = PCDATA d +let entity e = Entity e + +let leaf ?a name = + match a with + | Some a -> Leaf (name, a) + | None -> Leaf (name, []) + +let node ?a name children = + match a with + | Some a -> Node (name, a, children) + | None -> Node (name, [], children) + +let rec flatmap f = function + | [] -> [] + | x :: rest -> f x @ flatmap f rest + +let translate root_leaf root_node sub_leaf sub_node update_state state elt = + let rec translate' state = function + | (Empty | Comment _ | PCDATA _ | Entity _) as elt -> [elt] + | Leaf (name, attribs) -> + sub_leaf state name attribs + | Node (name, attribs, elts) -> + sub_node state name attribs + (flatmap (translate' (update_state name attribs state)) elts) in + match elt with + | (Empty | Comment _ | PCDATA _ | Entity _) as elt -> elt + | Leaf (name, attribs) -> + root_leaf name attribs + | Node (name, attribs, elts) -> + root_node name attribs (flatmap (translate' state) elts) + +(** {1 Output} *) + +module Elt_Set = + Set.Make (struct type t = ename let compare = compare end) + +let elt_set_of_list names = + List.fold_right + (fun n set -> Elt_Set.add (String.lowercase n) set) names Elt_Set.empty + +type io_state = + { preformatted : bool; + preformatted_elts : Elt_Set.t; + allow_break : bool; + no_break_elts : Elt_Set.t } + +let initial_io_state ?(preformatted = []) ?(no_break = []) () = + let preformatted = elt_set_of_list preformatted + and no_break = elt_set_of_list no_break in + { preformatted = false; + preformatted_elts = preformatted; + allow_break = true; + no_break_elts = Elt_Set.union no_break preformatted } + +let update_io_state name attribs ios = + { ios with + allow_break = not (Elt_Set.mem (String.lowercase name) ios.no_break_elts); + preformatted = Elt_Set.mem (String.lowercase name) ios.preformatted_elts } + +(** {2 No Pretty Printing} *) + +let is_control c = + let cc = Char.code c in + (cc <= 8 || cc = 11 || cc = 12 || (14 <= cc && cc <= 31) || cc = 127) + +let encode_unsafe s = + let b = Buffer.create (String.length s) in + String.iter (function + | '<' -> Buffer.add_string b "<" + | '>' -> Buffer.add_string b ">" + | '"' -> Buffer.add_string b """ + | '&' -> Buffer.add_string b "&" + | c when is_control c -> + Buffer.add_string b ("&#" ^ string_of_int (Char.code c) ^ ";") + | c -> Buffer.add_char b c) s; + Buffer.contents b + +let encode_unsafe_and_at s = + let b = Buffer.create (String.length s) in + String.iter (function + | '<' -> Buffer.add_string b "<" + | '>' -> Buffer.add_string b ">" + | '"' -> Buffer.add_string b """ + | '&' -> Buffer.add_string b "&" + | '@' -> Buffer.add_string b "@" + | c when is_control c -> + Buffer.add_string b ("&#" ^ string_of_int (Char.code c) ^ ";") + | c -> Buffer.add_char b c) s; + Buffer.contents b + +let newline ios outs = + if ios.allow_break then + outs "\n" + +let rec output' ios encode outs = function + | Empty -> () + | Comment c -> + outs (""); + newline ios outs + | PCDATA d -> + outs (encode d); + newline ios outs + | Entity e -> + outs ("&" ^ e ^ ";"); (* No {e not} encode these! *) + newline ios outs + | Leaf (name, attribs) -> + outs ("<" ^ name); + List.iter (fun a -> outs " "; outs (attrib_to_string encode a)) attribs; + outs " />"; + newline ios outs + | Node (name, attribs, children) -> + let ios_elt = update_io_state name attribs ios in + outs ("<" ^ name); + List.iter (fun a -> outs " "; outs (attrib_to_string encode a)) attribs; + outs ">"; + newline ios_elt outs; + List.iter (output' ios_elt encode outs) children; + outs (""); + newline ios outs + +let output ?preformatted ?no_break ?(encode = encode_unsafe) outs elt = + output' (initial_io_state ?preformatted ?no_break ()) encode outs elt + +(** {2 Pretty Printed} *) + +let force_newline ios f () = + if ios.allow_break then + Format.pp_force_newline f () + +let print_cut ios f () = + if ios.allow_break then + Format.pp_print_cut f () + +let open_box ios f n = + if ios.allow_break then + Format.pp_open_box f n + +let close_box ios f () = + if ios.allow_break then + Format.pp_close_box f () + +let is_white = function + | ' ' | '\t' | '\n' | '\r' -> true + | _ -> false + +let iter_words fword fwhite s = + let last = String.length s - 1 in + let rec skip_non_white c = + if c > last then + c + else if is_white s.[c] then + c + else + skip_non_white (succ c) in + let rec skip_white c = + if c > last then + c + else if is_white s.[c] then + skip_white (succ c) + else + c in + let rec iter_words' c = + if c > last then begin + () + end else if is_white s.[c] then begin + fwhite (); + iter_words' (skip_white (succ c)) + end else begin + let c' = skip_non_white (succ c) in + fword (String.sub s c (c' - c)); + iter_words' c' + end in + iter_words' 0 + +let print_string ios f s = + if ios.preformatted then + Format.pp_print_string f s + else + iter_words (Format.pp_print_string f) (Format.pp_print_space f) s + +let print_space ios f () = + Format.pp_print_space f () + +let rec to_formatter ios encode f = function + | Empty -> () + | Comment c -> + force_newline ios f (); + print_string ios f (""); + force_newline ios f () + | PCDATA d -> + print_string ios f (encode d); + print_cut ios f () + | Entity e -> + print_string ios f ("&" ^ e ^ ";"); (* NO encoding! *) + print_cut ios f () + | Leaf (name, attribs) -> + print_cut ios f (); + open_box ios f 4; + print_string ios f ("<" ^ name); + List.iter (fun a -> + print_space ios f (); + Format.pp_print_string f (attrib_to_string encode a)) attribs; + print_string ios f " />"; + close_box ios f (); + print_cut ios f () + | Node (name, attribs, children) -> + print_cut ios f (); + let ios_elt = update_io_state name attribs ios in + open_box ios f 2; + open_box ios f 4; + print_string ios f ("<" ^ name); + List.iter (fun a -> + print_space ios f (); + Format.pp_print_string f (attrib_to_string encode a)) attribs; + print_string ios f ">"; + close_box ios f (); + print_cut ios_elt f (); + List.iter (to_formatter ios_elt encode f) children; + close_box ios f (); + print_cut ios_elt f (); + print_string ios f (""); + print_cut ios f () + +let pretty_print ?(width = 132) ?preformatted ?no_break + ?(encode = encode_unsafe) outs element = + Format.pp_set_margin Format.str_formatter width; + to_formatter (initial_io_state ?preformatted ?no_break ()) + encode Format.str_formatter element; + outs (Format.flush_str_formatter ()) + +let decl ?(version = "1.0") ?(encoding = "ISO-8859-1") outs () = + outs ("\n") diff --git a/src/optimizer/xhtml/xML.mli b/src/optimizer/xhtml/xML.mli new file mode 100644 index 0000000..ae93364 --- /dev/null +++ b/src/optimizer/xhtml/xML.mli @@ -0,0 +1,126 @@ +(* $Id: xML.mli,v 1.15 2004/12/13 14:57:45 ohl Exp $ + + Copyright (C) 2004 by Thorsten Ohl + + XHTML 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, or (at your option) + any later version. + + XHTML 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., 675 Mass Ave, Cambridge, MA 02139, USA. *) + +type attrib +type aname = string +val int_attrib : aname -> int -> attrib +val string_attrib : aname -> string -> attrib +val space_sep_attrib : aname -> string list -> attrib +val comma_sep_attrib : aname -> string list -> attrib + +val get_int_attrib : aname -> attrib list -> int +val get_string_attrib : aname -> attrib list -> string +val get_attrib_list : aname -> attrib list -> string list + +type elt +type ename = string +val empty : unit -> elt + +val comment : string -> elt +val pcdata : string -> elt +val entity : string -> elt +(** Neither [comment], [pcdata] nor [entity] check their argument for invalid + characters. Unsafe characters will be escaped later by the output routines. *) + +val leaf : ?a:(attrib list) -> ename -> elt +val node : ?a:(attrib list) -> ename -> elt list -> elt +(** NB: [Leaf ("foo", []) -> ""], but [Node ("foo", [], []) -> ""] *) + +val encode_unsafe : string -> string +(** The encoder maps strings to HTML and {e must} encode the unsafe characters + ['<'], ['>'], ['"'], ['&'] and the control characters 0-8, 11-12, 14-31, 127 + to HTML entities. [encode_unsafe] is the default for [?encode] in [output] + and [pretty_print] below. Other implementations are provided by the module + [Netencoding] in the + {{:http://www.ocaml-programming.de/programming/ocamlnet.html}OcamlNet} library, e.g.: + [let encode = Netencoding.Html.encode ~in_enc:`Enc_iso88591 ~out_enc:`Enc_usascii ()], + Where national characters are replaced by HTML entities. + The user is of course free to write her own implementation. + @see OcamlNet *) + +val encode_unsafe_and_at : string -> string +(** In addition, encode ["@"] as ["@"] in the hope that this will fool + simple minded email address harvesters. *) + +val output : ?preformatted:ename list -> ?no_break:ename list -> + ?encode:(string -> string) -> (string -> unit) -> elt -> unit +val pretty_print : ?width:int -> + ?preformatted:ename list -> ?no_break:ename list -> + ?encode:(string -> string) -> (string -> unit) -> elt -> unit +(** Children of elements that are mentioned in [no_break] do not + generate additional line breaks for pretty printing in order not to + produce spurious white space. In addition, elements that are mentioned + in [preformatted] are not pretty printed at all, with all + white space intact. *) + +val decl : ?version:string -> ?encoding:string -> (string -> unit) -> unit -> unit +(** [encoding] is the name of the character encoding, e.g. ["US-ASCII"] *) + +type attribs = attrib list + +val amap : (ename -> attribs -> attribs) -> elt -> elt +(** Recursively edit attributes for the element and all its children. *) + +val amap1 : (ename -> attribs -> attribs) -> elt -> elt +(** Edit attributes only for one element. *) + +(** The following can safely be exported by higher level libraries, + because removing an attribute from a element is always legal. *) + +val rm_attrib : (aname -> bool) -> attribs -> attribs +val rm_attrib_from_list : (aname -> bool) -> (string -> bool) -> attribs -> attribs + +val map_int_attrib : + (aname -> bool) -> (int -> int) -> attribs -> attribs +val map_string_attrib : + (aname -> bool) -> (string -> string) -> attribs -> attribs +val map_string_attrib_in_list : + (aname -> bool) -> (string -> string) -> attribs -> attribs + +(** Exporting the following by higher level libraries would drive + a hole through a type system, because they allow to add {e any} + attribute to {e any} element. *) + +val add_int_attrib : aname -> int -> attribs -> attribs +val add_string_attrib : aname -> string -> attribs -> attribs +val add_comma_sep_attrib : aname -> string -> attribs -> attribs +val add_space_sep_attrib : aname -> string -> attribs -> attribs + +val fold : (unit -> 'a) -> (string -> 'a) -> (string -> 'a) -> (string -> 'a) -> + (ename -> attrib list -> 'a) -> (ename -> attrib list -> 'a list -> 'a) -> + elt -> 'a + +(* (* is this AT ALL useful??? *) +val foldx : (unit -> 'a) -> (string -> 'a) -> (string -> 'a) -> (string -> 'a) -> + ('state -> ename -> attrib list -> 'a) -> + ('state -> ename -> attrib list -> 'a list -> 'a) -> + (ename -> attrib list -> 'state -> 'state) -> 'state -> elt -> 'a +*) + +val all_int_attribs : ?is_elt:(string -> bool) -> string -> elt -> int list +val all_string_attribs : ?is_elt:(string -> bool) -> string -> elt -> string list +val all_attribs_list : ?is_elt:(string -> bool) -> string -> elt -> string list list + +val all_entities : elt -> string list + +val translate : + (ename -> attrib list -> elt) -> + (ename -> attrib list -> elt list -> elt) -> + ('state -> ename -> attrib list -> elt list) -> + ('state -> ename -> attrib list -> elt list -> elt list) -> + (ename -> attrib list -> 'state -> 'state) -> 'state -> elt -> elt diff --git a/test/.cvsignore b/test/.cvsignore new file mode 100755 index 0000000..4a3c2ef --- /dev/null +++ b/test/.cvsignore @@ -0,0 +1,2 @@ +Makefile +deputy.log* diff --git a/test/Makefile.in b/test/Makefile.in new file mode 100755 index 0000000..2d7c5b2 --- /dev/null +++ b/test/Makefile.in @@ -0,0 +1,62 @@ +# +# This is the Makefile for Deputy tests +# Use absolute paths only because we will include this file from +# other directories + +ifndef DEPUTYHOME + DEPUTYHOME = @DEPUTYHOME@ + # On cygwin, we want to remove the colon + ifeq ($(ARCHOS),x86_WIN32) + DEPUTYHOME:=$(shell cygpath -u $(DEPUTYHOME)) + endif +endif + +DEPUTYDIR := $(DEPUTYHOME) +DEPUTY := $(DEPUTYDIR)/bin/deputy +OPTIONS := --save-temps --strict-global-init -g --check-cil-invariants \ + $(EXTRAARGS) +RUNALL := $(DEPUTYDIR)/cil/ocamlutil/runall.pl + +$(DEPUTYHOME)/test/Makefile : $(DEPUTYHOME)/config.status \ + $(DEPUTYHOME)/test/Makefile.in + echo "Makefile out of date. Must run ./config.status." + cd $(DEPUTYHOME) && ./config.status + +Makefile: $(DEPUTYHOME)/test/Makefile + +# We'll use all optimizations unless you override OPT on the command line. +OPT ?= 3 +OPTIONS += --opt=$(OPT) + +ifdef DEPVERBOSE + OPTIONS += --verbose +endif +ifdef PARSEOUT + OPTIONS += --parse-out=$(PARSEOUT) +endif +ifdef NOINFER + OPTIONS += --no-infer +endif +ifdef INFEROUT + OPTIONS += --infer-out=$(INFEROUT) +endif + +INFERDETAIL := 3 +OPTIONS += --infer-out-detail=$(INFERDETAIL) +ifdef BYTECODE + OPTIONS += --bytecode +endif +ifdef STATS + OPTIONS += --stats +endif + +ifdef NODEPUTY + DEPUTY := gcc + OPTIONS := +endif + +small/%: small/%.c + $(MAKE) -C small runall/$* + +libc/%: libc/%.c + $(MAKE) -C libc runall/$* diff --git a/test/libc/.cvsignore b/test/libc/.cvsignore new file mode 100755 index 0000000..aaf029b --- /dev/null +++ b/test/libc/.cvsignore @@ -0,0 +1,7 @@ +*.exe +*.o +*.i +*.cil.c +*-tmp.c +*.stackdump +tout.c diff --git a/test/libc/Makefile b/test/libc/Makefile new file mode 100755 index 0000000..0923e3f --- /dev/null +++ b/test/libc/Makefile @@ -0,0 +1,22 @@ +include ../Makefile + +# The list of tests is in ../runtests.pl + +.PHONY: clean alltests + +alltests: + cd ..; ./testdeputy -r --nogroup slow --nogroup ALWAYS +# @echo -e "\n\nAll tests were successful. \n\n" + +clean: + rm -f *.cil.c *.i *.exe *.o *~ *.stackdump *-tmp.c + +ifndef NODEPUTY +OPTIONS := $(OPTIONS) --fail-stop +endif + +runall/%: %.c + COMMAND="$(DEPUTY) $(OPTIONS) \ + -o __BASENAME__.exe __FILE__ && ./__BASENAME__.exe" \ + COMMENT="//" \ + perl $(RUNALL) $*.c diff --git a/test/libc/crypt1.c b/test/libc/crypt1.c new file mode 100755 index 0000000..ffefbc0 --- /dev/null +++ b/test/libc/crypt1.c @@ -0,0 +1,28 @@ +// To get the crypt definition in unistd.h on Linux, we need this definition. +#define _XOPEN_SOURCE + +#include +#include + +#if defined(__CYGWIN__) +#include +#else +#include +#endif + +#define E(n) { printf("Error %d\n", n); exit(n); } +TESTDEF : success + + +int main() { + char salt[2] = {'a', 'b'}; + char shortsalt[1] = {'a'}; + char* pwd = crypt("", NTDROP("ab")); + pwd = crypt("Hello, world.", salt); + +IFTEST : error = will always fail + pwd = crypt("Hello, world.", shortsalt); +ENDIF + + printf("Success\n"); exit(0); +} diff --git a/test/libc/ctype1.c b/test/libc/ctype1.c new file mode 100644 index 0000000..e6cc0f9 --- /dev/null +++ b/test/libc/ctype1.c @@ -0,0 +1,26 @@ + +#include +#include + +// __USE_ISOC99 gives us 'isblank' +#define __USE_ISOC99 +#include + +#include "harness.h" + +int main() { + char c = 'a'; + if(! isalpha(c)) E(1); + if(isalpha('$')) E(2) + + if(isblank(c)) E(3); + if(! isblank(' ')) E(4); + + if(toupper(c) != 'A') E(5); + if(tolower('A') != c) E(6); + + if(isdigit(c)) E(7); + if(! isdigit('5')) E(8); + + return 0; +} diff --git a/test/libc/fwrite1.c b/test/libc/fwrite1.c new file mode 100755 index 0000000..3d175fe --- /dev/null +++ b/test/libc/fwrite1.c @@ -0,0 +1,14 @@ +#include + +TESTDEF baseline : success + +char a[] = { 'h', 'e', 'l', 'o' }; + +int main() { + char * buff = a; // This should be FSEQ + + fwrite(buff, 1, sizeof(a), stdout); // KEEP baseline + fwrite(buff, 2, sizeof(a), stdout); // KEEP : error = upper bound + + return 0; +} diff --git a/test/libc/getaddrinfo1.c b/test/libc/getaddrinfo1.c new file mode 100755 index 0000000..f8761e6 --- /dev/null +++ b/test/libc/getaddrinfo1.c @@ -0,0 +1,170 @@ +// getaddrinfo.c +// demonstrate problem calling getaddinfo and then using what +// it returns in subsequent socket calls; this comes from ftpd + +// TODO: eliminate spurious warning about missing wrappers +// for getaddrinfo and freeaddrinfo + +#include // getaddrinfo, connect +#include // getaddrinfo, connect +#include // getaddrinfo +#include // perror +#include // read, close +#include // memset, memcpy +#include // malloc + +#ifdef __CYGWIN__ +error: Cygwin does not support getaddrinfo +#endif + +// these two come from ftpd/extern.h +struct sockinet { + unsigned int si_family; + uint16_t si_port; +}; + +union sockunion { + struct sockinet su_si; + struct sockaddr_in su_sin; + struct sockaddr_in6 su_sin6; + char dirty_pool[32]; // for playing games later +}; + +#define SA_LEN(x) \ + (((x)->sa_family == AF_INET6) ? sizeof(struct sockaddr_in6) \ + : sizeof(struct sockaddr_in)) + + +int main(int argc, char * NTS argv[]) +{ + int err; // error code from getaddrinfo() + struct addrinfo *res; // getaddrinfo()'s return value (by reference) + struct addrinfo hints; // options passed to getaddrinfo() + + union sockunion data_dest; // address/port for issuing a connect() call + //struct sockaddr_in data_dest; // address/port for issuing a connect() call + + int s; // socket + char buf[80]; // for reading from the socket + int len; // return from read() + + // host/service + char const *name = "argus.eecs.berkeley.edu"; + char const *service = "13"; + if (argc >= 3) { + name = argv[1]; + service = argv[2]; + } + + // this struct is used to pass hints to getaddrinfo() about what + // kind of protocol family to use; here I'm supplying the same + // things that ftpd does + memset(&hints, 0, sizeof(hints)); + hints.ai_family = PF_INET; // IPv4 as opposed to IPv6 + hints.ai_socktype = SOCK_STREAM; // TCP as opposed to UDP + + // call getaddrinfo() to map a name/port combination to + // a sockaddr structure (and some other info); the 'res' argument + // will be set to point to the head of a linked list + err = getaddrinfo(name, service, &hints, &res); + if (err != 0) { + printf("getaddrinfo error %d: %s\n", err, gai_strerror(err)); + return 2; + } + + // for curiosity's sake, count the number of nodes in the list + { + int ct = 0; + struct addrinfo *p = res; + while (p) { + ct++; + p = p->ai_next; + } + printf("getaddrinfo returned %d addresses\n", ct); + } + printf("addrlen is %d\n", res->ai_addrlen); + + // new solution: try naming the fields explicitly.. + if (res->ai_addrlen == 16) { + // by taking address of 'su_sin', CCured is pacified + memcpy(&data_dest.su_sin, res->ai_addr, res->ai_addrlen); + } + else if (res->ai_addrlen == 28) { + // 'su_sin6' works similarly, but now there's a different + // problem--'ai_addr' is only declared to point at a 'sockaddr', + // and CCured will again complain about the sizes. I can't just + // use 'su_sin', because the memcpy wrapper will catch the length + // mismatch. Instead I must use George's mkptr_size trick... + // + // I wish my machine had IPv6 support working so I could test this.. + struct sockaddr_in6 *src = (struct sockaddr_in6 *)res->ai_addr; + memcpy(&data_dest.su_sin6, src, res->ai_addrlen); + } + else { + abort(); // unexpected size + } + + if (argc == 1) { + // no arguments explicitly supplied, don't actually do the network + // connection + printf("skipping connect() step since arguments were implicit\n"); + return 0; + } + + // now, use this address (IP address and port number) to establish + // a network connection + s = socket(AF_INET, SOCK_STREAM, 0 /*pick the reasonable one?*/); + if (s == -1) { + perror("socket"); + return 2; + } + + if (res->ai_addrlen == 16) { + if (0!=connect(s, (struct sockaddr *)&data_dest.su_sin, + SA_LEN((struct sockaddr *)&data_dest))) { + perror("connect"); + return 2; + } + } + else if (res->ai_addrlen == 28) { + // will this work? CCured is going to see an apparent cast + // from sockaddr_in6 to sockaddr.. no. so now I've apparently + // fixed it with the extra 4 bytes of padding, but still cannot + // test it due to my IPv6 situation.. + if (0!=connect(s, (struct sockaddr *)&data_dest.dirty_pool, + SA_LEN((struct sockaddr *)&data_dest))) { + perror("connect"); + return 2; + } + } + else { + abort(); + } + + + // just to be sure this really worked, read the first packet; since + // I've connected to the daytime socket, this should be the time of + // day in some ascii representation + printf("established connection! first packet:\n"); + len = read(s, buf, 79); + if (len < 0) { + perror("read"); + return 2; + } + buf[len] = 0; + printf("%d bytes: %s\n", len, buf); + + // close the connection + if (0!=close(s)) { + perror("close"); + return 2; + } + + // free the linked list that getaddrinfo() returned + freeaddrinfo(res); + + return 0; +} + + + diff --git a/test/libc/getpwnam1.c b/test/libc/getpwnam1.c new file mode 100755 index 0000000..fcb228c --- /dev/null +++ b/test/libc/getpwnam1.c @@ -0,0 +1,85 @@ +// getpwnam.c +// test getpwnam wrapper + +#include // exit, free +#include // getpwnam +#include // getgrnam +#include // uid_t? +#include // printf +#include // printf +#include // getuid + +#define E(n) { printf("Error %d\n", n); exit(n); } +#ifndef DEPUTY + #define NTS +#endif + +TESTDEF : success + +int main() +{ + int zero = 0; + struct passwd *pw = getpwuid(getuid()); + struct group *gr = getgrgid(getgid()); + char* username = strdup(pw->pw_name); + pw = getpwnam(username); + + printf("name: %s\n", pw->pw_name); + printf("uid: %d\n", pw->pw_uid); + printf("gid: %d\n", pw->pw_gid); + printf("passwd: %p\n", (unsigned long)pw->pw_passwd); + printf("passwd: %s\n", pw->pw_passwd); + + + + printf("gr name: %s\n", gr->gr_name); + printf("gid: %d\n", gr->gr_gid); + printf("passwd: %p\n", (unsigned long)gr->gr_passwd); + printf("gr_mem: %p\n", (unsigned long)gr->gr_mem); + + if(strcmp(pw->pw_name, username)) E(1); + if(pw->pw_uid != getuid()) E(2); + if(pw->pw_gid != getgid()) E(3); + + free(username); + + // make us infer non-simple representations + pw->pw_name += zero; + +IFTEST : error = will always fail + // We cannot decrement an NT pointer + pw->pw_passwd++; + pw->pw_passwd--; +ENDIF + + // Do the same for the group structure + gr->gr_name += zero; + gr->gr_mem += zero; // Make it FSEQ + if(gr->gr_mem && *gr->gr_mem) { + char * foo = *gr->gr_mem - zero; // Make that FAT + } + + + // List the members in my group + { + char * NTS * p = gr->gr_mem; + while(*p) { + // Check the group for this user + struct passwd *pw = getpwnam(*p); + printf(" group member: %s\n", *p); + printf(" name: %s\n", pw->pw_name); + printf(" uid: %d\n", pw->pw_uid); + printf(" gid: %d\n", pw->pw_gid); + printf(" passwd: %p\n", (unsigned long)pw->pw_passwd); + printf(" passwd: %s\n", pw->pw_passwd); + + + + if(strcmp(pw->pw_name, *p)) E(11); + // if(pw->pw_gid != gr->gr_gid) E(12); + // Try next user + p ++; + } + } + printf("Success\n"); exit(0); +} diff --git a/test/libc/glob1.c b/test/libc/glob1.c new file mode 100755 index 0000000..6c58ea8 --- /dev/null +++ b/test/libc/glob1.c @@ -0,0 +1,90 @@ +// glob.c +// test glob() function + +#include // glob, globfree +#include // memset +#include // printf +#include // chdir + + + +int entry() +{ + glob_t globbuf; + int flags; + int err; + int i; + + // clear the globbuf (will CCured complain?) + memset(&globbuf, 0, sizeof(globbuf)); + + // these are exactly the flags that ftpd uses, so I want to make + // sure they work first.. + flags = GLOB_BRACE | // shell-style brace expansion + GLOB_NOCHECK | // if no match, yield original pattern + GLOB_TILDE; // shell-style ~username expansion + + // call glob to find all *.c names + err = glob("*.c", flags, NULL /*errfunc*/, &globbuf); + switch (err) { + case 0: // no error + break; + + case GLOB_NOSPACE: + printf("glob: out of memory\n"); + return 2; + +#ifndef __CYGWIN__ + case GLOB_ABORTED: + printf("glob: read error\n"); + return 2; + + case GLOB_NOMATCH: + // not really an error as far as glob is concerned, except that + // I know there are files matching *.c so something must have + // gone wrong.. + printf("glob: no matches\n"); + return 2; +#endif + + default: + // interestingly, the libc glob.h header does in fact declare + // some additional codes, implying they might be returned.. + printf("glob: unknown error code: %d\n", err); + return 2; + } + + // print some of what was matched + printf("got %d matches; printing up to 10:\n", globbuf.gl_pathc); + + for (i=0; i < 10 && i < globbuf.gl_pathc; i++) { + char const *p = globbuf.gl_pathv[i]; + printf("match %d: %s\n", i, p); + } + + // free the memory + globfree(&globbuf); + + return 0; +} + + +int main() +{ + int err; + + // since this is often run from cil/test, move into cil/test/small2 + // (if that's really where we are) for a little less degeneracy + if (0==chdir("small2")) { + printf("moved into small2/ for less degeneracy\n"); + } + + err = entry(); + if (err) return err; + + // do it again just to be sure + err = entry(); + if (err) return err; + + return 0; +} diff --git a/test/libc/harness.h b/test/libc/harness.h new file mode 100755 index 0000000..5bfa267 --- /dev/null +++ b/test/libc/harness.h @@ -0,0 +1,13 @@ +// This file contains macros for the libc Deputy tests. + +#ifndef HARNESS_H +#define HARNESS_H + +extern int printf(const char * NTS format, ...); +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); } + +#endif // HARNESS_H diff --git a/test/libc/hostent1.c b/test/libc/hostent1.c new file mode 100755 index 0000000..a681c9b --- /dev/null +++ b/test/libc/hostent1.c @@ -0,0 +1,49 @@ + +#include +#include +#include + + +#include + +#define HOST "www.cs.berkeley.edu" + +TESTDEF : success + +int main() { + struct hostent *res = gethostbyname(HOST); + char *p = res->h_name; + int i; + //does HOST match any alias? + int lookupSucceeded = strcmp(res->h_name, HOST) == 0; + + printf("Host is %s\n", res->h_name); + for (i = 0; res->h_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, res->h_aliases[i]); + if(strcmp(res->h_aliases[i], HOST)== 0) { + lookupSucceeded = 1; + } +IFTEST ubound_hostent : error = upper bound check + printf("Next alias = %s\n", res->h_aliases[i + 2]); +ENDIF +IFTEST ubound_hostent2 : error = nullterm write check + res->h_aliases[i + 1] = "foo"; +ENDIF + } + + for (i = 0; res->h_addr_list[i] != NULL; i++) { + printf(" addr[%d] is %u.%u.%u.%u\n", i, + (unsigned char)res->h_addr_list[i][0], + (unsigned char)res->h_addr_list[i][1], + (unsigned char)res->h_addr_list[i][2], + (unsigned char)res->h_addr_list[i][3]); +IFTEST ubound_hostent3 : error = upper bound check + printf("Next addr = %d\n", res->h_addr_list[i + 2][0]); +ENDIF + } + + if(!lookupSucceeded) { + exit(1); + } + return 0; +} diff --git a/test/libc/hostent2.c b/test/libc/hostent2.c new file mode 100755 index 0000000..85ceb01 --- /dev/null +++ b/test/libc/hostent2.c @@ -0,0 +1,99 @@ +#include +#include +#include +#include //exit + + +#define MANJU "manju.cs.berkeley.edu" +#define E(n) { printf("Error %d\n", n); exit(n); } + +#if defined __CYGWIN__ || defined _MSVC +error: Cygwin and MSVC do not support gethostbyname_r +#endif + +char* NTS addrToString(char* COUNT(4) addr) +{ + static char (NT buffer)[128]; + sprintf(buffer, "%d.%d.%d.%d", + (unsigned char)addr[0], (unsigned char)addr[1], + (unsigned char)addr[2], (unsigned char)addr[3]); + return buffer; +} + +// dsw: see +// http://www.gnu.org/manual/glibc-2.2.3/html_node/libc_309.html#IDX1688 +// for documentation +int main() { + struct hostent res, *pres; + char buf[1024]; + int err, i; + char addr[4]; + + // + // gethostbyname_r + // + + //lookup manju by name: + gethostbyname_r(MANJU, &res, buf, 1024, &pres, &err); + if(pres == NULL) { + E(1); + } + if(strcmp(pres->h_name, MANJU)) { + E(2); + } + printf("%s\n", pres->h_name); + for (i = 0; pres->h_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, pres->h_aliases[i]); + } + memcpy(addr, pres->h_addr_list[0], sizeof addr); + printf("%s has address %s\n", + pres->h_name, addrToString(addr)); + + //lookup localhost by name: + gethostbyname_r("localhost", &res, buf, 1024, &pres, &err); + printf("%s\n", pres->h_name); + for (i = 0; pres->h_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, pres->h_aliases[i]); + } + for (i = 0; pres->h_addr_list[i] != NULL; i++) { + printf(" address[%d] is %s\n", i, addrToString(pres->h_addr_list[i])); + } + + // + // gethostbyaddr_r + // + + //now look up manju using the address we got earlier. + printf("test gethostbyaddr_r\n"); + gethostbyaddr_r(addr, 4, AF_INET, &res, buf, 1024, &pres, &err); + printf("lookup manju(%s): %s\n", + addrToString(addr), + pres->h_name); + if(strcmp(pres->h_name, "manju.CS.Berkeley.EDU")) { + E(3); + } + for (i = 0; pres->h_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, pres->h_aliases[i]); + } + + //now look up localhost using 127.0.0.1 + printf("test gethostbyaddr_r on localhost\n"); + addr[0] = 127; // localhost + addr[1] = 0; + addr[2] = 0; + addr[3] = 1; + gethostbyaddr_r(addr, 4, AF_INET, &res, buf, 1024, &pres, &err); + printf("localhost: %s\n", pres->h_name); + for (i = 0; pres->h_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, pres->h_aliases[i]); + } + //h_name will probably be "localhost" or "localhost.SOME_DOMAIN" + if(strncmp(pres->h_name, "localhost", 9)) { + // On the latest incarnation of manju, the localname is manju + // E(4); + } + + printf("success\n"); + return 0; +} + diff --git a/test/libc/malloc1.c b/test/libc/malloc1.c new file mode 100644 index 0000000..78e1288 --- /dev/null +++ b/test/libc/malloc1.c @@ -0,0 +1,21 @@ +// KEEP baseline: success + +#include + +int main() { + int *p; + int **pp; + + p = (int *) malloc(3 * sizeof(int)); + p[2] = 42; + + pp = (int **) realloc(p, 5 * sizeof(int*)); // KEEP e1: error = changes type + p = (int *) realloc(p, 5 * sizeof(int)); + p[4] = 42; + + int res = p[4] - p[2]; + + free(p); + + return res; +} diff --git a/test/libc/malloc2.c b/test/libc/malloc2.c new file mode 100644 index 0000000..0af9591 --- /dev/null +++ b/test/libc/malloc2.c @@ -0,0 +1,15 @@ +// Makes sure that NT doesn't flow through free. + +#include + +int main() { + int *p = malloc(12); + char * NT q = malloc(12); + + free(p); + free(q); + + p[2] = 42; + + return 0; +} diff --git a/test/libc/memset1.c b/test/libc/memset1.c new file mode 100755 index 0000000..f1705c4 --- /dev/null +++ b/test/libc/memset1.c @@ -0,0 +1,10 @@ +#include + +int main() { + unsigned char buff[128]; + + memset(buff, 0, sizeof(buff)); // KEEP : success + + memset((char*)buff, 0, sizeof(buff)); // KEEP : success + +} diff --git a/test/libc/popen1.c b/test/libc/popen1.c new file mode 100644 index 0000000..fffae89 --- /dev/null +++ b/test/libc/popen1.c @@ -0,0 +1,239 @@ +/* $OpenBSD: popen.c,v 1.11 1999/12/08 13:15:21 itojun Exp $ */ +/* $NetBSD: popen.c,v 1.5 1995/04/11 02:45:00 cgd Exp $ */ + +/* + * Copyright (c) 1988, 1993, 1994 + * The Regents of the University of California. All rights reserved. + * + * This code is derived from software written by Ken Arnold and + * published in UNIX Review, Vol. 6, No. 8. + * + * 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. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 REGENTS 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. + * + */ + +// sm: hack to avoid problem with __typeof in WIFEXITED macro +// sm: later, with different (?) libc, this made it not work.. +//#define __STRICT_ANSI__ + +#ifdef CCURED + // this should not be necessary anymore.. and indeed it's not! + //#define glob wrapped_glob + //#define globfree wrapped_globfree +#else + #define __HEAPIFY +#endif + +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include + +//#include +//#include "extern.h" + +/* + * Special version of popen which avoids call to shell. This ensures noone + * may create a pipe to a hidden program as a side effect of a list or dir + * command. + */ +static int * COUNT(pids_count) pids; +static int pids_count; + +static int fds; + +#define MAX_ARGV 100 +#define MAX_GARGV 1000 + +void fatal(char const * NTS msg) +{ + fprintf(stderr, "fatal: %s\n", msg); + exit(4); +} + +FILE * +ftpd_popen(program, type) + char * NTS program, * NTS type; +{ + char *cp; + FILE *iop; + int argc, gargc, pdes[2], pid; + char * NTS *pop, * NTS argv[MAX_ARGV], * NTS gargv[MAX_GARGV]; + + char *tmp; + + + if ((*type != 'r' && *type != 'w') || type[1]) + return (NULL); + + if (!pids) { + if ((fds = getdtablesize()) <= 0) + return (NULL); + pids_count = fds; + if ((pids = (int *)malloc((u_int)(fds * sizeof(int)))) == NULL) + return (NULL); + memset(pids, 0, fds * sizeof(int)); + } + if (pipe(pdes) < 0) + return (NULL); + + /* break up string into pieces */ + for (argc = 0, cp = program;argc < MAX_ARGV-1; cp = NULL) + if (!(argv[argc++] = strtok(cp, " \t\n"))) + break; + argv[MAX_ARGV-1] = NULL; + + /* glob each piece */ + gargv[0] = argv[0]; + for (gargc = argc = 1; argv[argc]; argc++) { + glob_t gl; + int flags = GLOB_BRACE|GLOB_NOCHECK|GLOB_TILDE; + + + memset(&gl, 0, sizeof(gl)); + if (glob(argv[argc], flags, NULL, &gl)) { + if (gargc < MAX_GARGV-1) { + gargv[gargc++] = (tmp = strdup(argv[argc])); + if (gargv[gargc -1] == NULL) + fatal ("Out of memory"); + } + + } else + for (pop = gl.gl_pathv; *pop && gargc < MAX_GARGV-1; pop++) { + printf("glob answer %d: %s\n", gargc, *pop); + gargv[gargc++] = (tmp = strdup(*pop)); + if (gargv[gargc - 1] == NULL) + fatal ("Out of memory"); + } + globfree(&gl); + } + gargv[gargc] = NULL; + printf("globbing yielded %d answers\n", gargc-1); + + iop = NULL; + + switch(pid = fork()) { + case -1: /* error */ + (void)close(pdes[0]); + (void)close(pdes[1]); + goto pfree; + /* NOTREACHED */ + case 0: /* child */ + if (*type == 'r') { + if (pdes[1] != STDOUT_FILENO) { + dup2(pdes[1], STDOUT_FILENO); + (void)close(pdes[1]); + } + dup2(STDOUT_FILENO, STDERR_FILENO); /* stderr too! */ + (void)close(pdes[0]); + } else { + if (pdes[0] != STDIN_FILENO) { + dup2(pdes[0], STDIN_FILENO); + (void)close(pdes[0]); + } + (void)close(pdes[1]); + } + closelog(); + + printf("running %s\n", gargv[0]); + execv(gargv[0], gargv); + perror("execv"); + _exit(1); + } + /* parent; assume fdopen can't fail... */ + if (*type == 'r') { + iop = fdopen(pdes[0], type); + (void)close(pdes[1]); + } else { + iop = fdopen(pdes[1], type); + (void)close(pdes[0]); + } + pids[fileno(iop)] = pid; + + pfree: for (argc = 1; gargv[argc] != NULL; argc++) + free(gargv[argc]); + + return (iop); +} + +int +ftpd_pclose(iop) + FILE *iop; +{ + int fdes, status; + pid_t pid; + sigset_t sigset, osigset; + + /* + * pclose returns -1 if stream is not associated with a + * `popened' command, or, if already `pclosed'. + */ + if (pids == 0 || pids[fdes = fileno(iop)] == 0) + return (-1); + (void)fclose(iop); + sigemptyset(&sigset); + sigaddset(&sigset, SIGINT); + sigaddset(&sigset, SIGQUIT); + sigaddset(&sigset, SIGHUP); + sigprocmask(SIG_BLOCK, &sigset, &osigset); + while ((pid = waitpid(pids[fdes], &status, 0)) < 0 && errno == EINTR) + continue; + sigprocmask(SIG_SETMASK, &osigset, NULL); + pids[fdes] = 0; + if (pid < 0) + return (pid); + if (WIFEXITED(status)) + return (WEXITSTATUS(status)); + return (1); +} + + +int main() +{ + FILE *fp; + char buf[80] ; + char cmd[80] = "/bin/ls ~/tmp/tmp/""*"; + + fp = ftpd_popen(cmd, "r"); + while (fgets(buf, 80, fp)) { + printf("output: %s", buf); // buf has \n in it + } + ftpd_pclose(fp); + + return 0; +} + + diff --git a/test/libc/printf1.c b/test/libc/printf1.c new file mode 100755 index 0000000..08240f5 --- /dev/null +++ b/test/libc/printf1.c @@ -0,0 +1,28 @@ + +#include + +TESTDEF baseline : success = hello + +char a[8]; + +int main() { + char * s = "hello"; + + printf("int=%02d, float=%f, str=\"%s\"\n", 5, 3.4, "hello"); + printf("char=%c\n", 'a'); + + printf("int=%p\n", (int)s); + + // TODO: We might want to produce an error in this case. Deputy inserts + // a cast from pointer to integer here, which may change the behavior of + // the code on 64-bit machines. + printf("int=%d\n", s); // KEEP str_d: success + + printf("str=%s\n", 5); // KEEP : error = Type mismatch + + printf("str=%s\n", a); // KEEP nt1 : error = from ordinary pointer to nullterm + + printf(s, 1); // KEEP nonlit: success = non-literal format string + + return 0; +} diff --git a/test/libc/printf2.c b/test/libc/printf2.c new file mode 100644 index 0000000..34c39ed --- /dev/null +++ b/test/libc/printf2.c @@ -0,0 +1,6 @@ +#include + +int main() { + printf("%d%%c", 42); + return 0; +} diff --git a/test/libc/readv1.c b/test/libc/readv1.c new file mode 100755 index 0000000..b148c10 --- /dev/null +++ b/test/libc/readv1.c @@ -0,0 +1,95 @@ +// DO NOT CHANGE THIS LINE +// Test that read and readv work. + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifndef DEPUTY +#define TC(x) (x) +#define NTDROP(x) (x) +#endif + +#define myassert(I) do { \ + if(!(I)) { \ + printf("%s:%d **************** assertion failure\n", __FILE__, __LINE__); \ + abort(); \ + } \ +} while(0) + +void test_read() { + const int size = 8; + char *buf = malloc((size+1) * sizeof buf[0]); + int in = open("readv1.c", O_RDONLY); + myassert(buf!=0); + if (in<0) { + printf("**** error opening file\n"); + abort(); + } + + // read + { + int num_left = size; + while(num_left) { + int num_read = read(in, NTDROP(buf+size-num_left), num_left); + num_left -= num_read; + } + buf[size] = '\0'; + myassert(close(in)==0); + } + + // check it is what we expect. + myassert(strcmp(buf, "// DO NO")==0); + + printf("success\n"); +} + +void test_readv() { + int in; + const int size = 8; + struct iovec iov[2]; + int i; + for(i=0; i<2; ++i) { + iov[i].iov_len = size; + iov[i].iov_base = malloc(size * sizeof iov[i].iov_base[0]); + myassert(iov[i].iov_base != 0); + } + + in = open("readv1.c", O_RDONLY); + if (in<0) { + printf("**** error opening file\n"); + abort(); + } + + // readv + // NOTE: we assume that it maximally fills the buffers. + { + int num_read = readv(in, iov, 2); + printf("num_read = %d\n", num_read); + myassert(num_read = 2 * size); + for(i=0; i<2; ++i) { + ((char*)(iov[i].iov_base))[size-1] = '\0'; + } + myassert(close(in)==0); + } + + // check it is what we expect. + myassert(strcmp(TC(iov[0].iov_base), "// DO N")==0); + myassert(strcmp(TC(iov[1].iov_base), "T CHANG")==0); + + printf("success\n"); +} + +int main() { + printf("test read\n"); + test_read(); + printf("test readv\n"); + test_readv(); + return 0; +} diff --git a/test/libc/servent1.c b/test/libc/servent1.c new file mode 100755 index 0000000..d99c89e --- /dev/null +++ b/test/libc/servent1.c @@ -0,0 +1,41 @@ +#include +#include +#include + +#include "harness.h" + +#include + +// dsw: see +// http://www.gnu.org/manual/glibc-2.2.3/html_node/libc_309.html#IDX1688 +// for documentation +void dump_servent(struct servent *s) { + int i; + short short_port; + printf("%s\n", s->s_name); + for (i = 0; s->s_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, s->s_aliases[i]); + } + short_port = s->s_port; + printf("%d\n", ntohs(short_port)); + printf("%s\n", s->s_proto); +} + +int main() { + struct servent res, *pres; + char buf[1024]; + char *name = "qotd"; +// char *name = "www"; + char *proto = "tcp"; + + printf("looking up name:%s, proto:%s\n", name, proto); + { // non-reentrant way + struct servent *s = getservbyname(name, proto); + dump_servent(s); + } + + printf("done\n"); + + return 0; +} + diff --git a/test/libc/servent2.c b/test/libc/servent2.c new file mode 100755 index 0000000..7f63fba --- /dev/null +++ b/test/libc/servent2.c @@ -0,0 +1,45 @@ +#include +#include +#include + +#include "harness.h" + +#include + +// dsw: see +// http://www.gnu.org/manual/glibc-2.2.3/html_node/libc_309.html#IDX1688 +// for documentation +void dump_servent(struct servent *s) { + int i; + short short_port; + printf("%s\n", s->s_name); + for (i = 0; s->s_aliases[i] != NULL; i++) { + printf(" alias[%d] is %s\n", i, s->s_aliases[i]); + } + short_port = s->s_port; + printf("%d\n", ntohs(short_port)); + printf("%s\n", s->s_proto); +} + +int main() { + struct servent res, *pres; + char buf[1024]; + char *name = "qotd"; +// char *name = "www"; + char *proto = "tcp"; + + printf("looking up name:%s, proto:%s\n", name, proto); + + // reentrant way + getservbyname_r(name, proto, &res, buf, 1024, &pres); + { + short short_port = pres->s_port; + if(ntohs(short_port) != 17) E(1); + } + dump_servent(pres); + + printf("done\n"); + + return 0; +} + diff --git a/test/libc/sockaddr1.c b/test/libc/sockaddr1.c new file mode 100755 index 0000000..72a9e04 --- /dev/null +++ b/test/libc/sockaddr1.c @@ -0,0 +1,113 @@ +// sockunion.c +// demonstrate problem with ftpd's 'union sockunion' + +//#include // getaddrinfo, connect +//#include // getaddrinfo, connect +//#include // getaddrinfo +//#include // read, close +//#include // malloc + +#include // perror, printf +#include // memset, memcpy + +// stdint.h +typedef unsigned char uint8_t; +typedef unsigned short int uint16_t; +typedef unsigned int uint32_t; + +// bits/sockaddr.h +typedef unsigned short int sa_family_t; + +// netinet/in.h +typedef uint16_t in_port_t; + +// netinet/in.h +typedef uint32_t in_addr_t; +struct in_addr { + in_addr_t s_addr; +}; + +// bits/socket.h: 16 bytes +struct sockaddr { + sa_family_t sa_family ; + char sa_data[14]; +}; + +// netinet/in.h: 2+2+4+8 = 16 bytes +struct sockaddr_in { + sa_family_t sin_family ; + in_port_t sin_port; + struct in_addr sin_addr; + + unsigned char sin_zero[sizeof (struct sockaddr) - + (sizeof (unsigned short int)) - + sizeof (in_port_t) - + sizeof (struct in_addr)]; +}; + + +// netinet/in.h: 16 bytes +struct in6_addr { + union { + uint8_t u6_addr8[16]; + uint16_t u6_addr16[8]; + uint32_t u6_addr32[4]; + } in6_u; +}; + +// netinet/in.h: 2+2+4+16+4 = 28 bytes +struct sockaddr_in6 { + sa_family_t sin6_family ; + in_port_t sin6_port; + uint32_t sin6_flowinfo; + struct in6_addr sin6_addr; + uint32_t sin6_scope_id; +}; + + +// ftpd/extern.h: 2+2 = 4 bytes +struct sockinet { + sa_family_t si_family; + uint16_t si_port; +}; + +// ftpd/extern.h: max(4,16,28) = 28 bytes +union sockunion { + struct sockinet su_si; // not needed to provoke problem + struct sockaddr_in su_sin; + struct sockaddr_in6 su_sin6; +}; + + +int zero = 0; + +int main() +{ + struct sockaddr someAddr; + struct sockaddr_in6 someAddr6; + union sockunion data_dest; + int sz; + int wanted_size = 16; + + printf("sizeof(sockaddr_in): %d\n", sizeof(struct sockaddr_in)); + printf("sizeof(sockunion): %d\n", sizeof(union sockunion)); + + // here's a possibly improved version; unfortunately this might + // only postpone the playing of games until I deal with 'someAddr' + // in the full generality that ftpd has, but for now this is my + // prototype solution + if (wanted_size == 16) { + memcpy(&data_dest.su_sin, &someAddr, wanted_size); + } + else if (wanted_size == 28) { + memcpy(&data_dest.su_sin6, &someAddr6, wanted_size); + } + else { + abort(); // unexpected size + } + + sz = sizeof(&data_dest); + printf("sizeof(&data_dest): %d\n", sz); + + return 0; +} diff --git a/test/libc/socket1.c b/test/libc/socket1.c new file mode 100755 index 0000000..abdca11 --- /dev/null +++ b/test/libc/socket1.c @@ -0,0 +1,123 @@ +// sockets.c +TESTDEF succ : success +// test some socket function wrappers (and others..) + +#include // setsockopt +#include // setsockopt, .. +#include // getnameinfo +#include // sockaddr_in + +#include // printf +#include // exit +#include // strdup + +#if defined(__CYGWIN__) +//error: This test case does not work on cygwin because getnameinfo is missing +#endif + +void fail(int val) +{ + printf("fail(%d)\n", val); + exit(val); +} + + +void t_setsockopt() +{ + int tmp=1; + setsockopt(0, 0, 0, (char*)&tmp, sizeof(tmp)); +IFTEST : error = blah blah ubound + setsockopt(0, 0, 0, (char*)&tmp + 1, sizeof(tmp)); +ENDIF +} + +void t_bind() +{ + struct sockaddr_in addr; + void *p = &addr; + bind(0, p, sizeof(addr)); + p = (char*)p+1; + bind(0, p, sizeof(addr)); // KEEP : error = Ubound +} + +void t_accept() +{ + struct sockaddr_in addr; + void *p = &addr; + int len = sizeof(addr); + accept(0, p, &len); + p = (char*)p+1; + accept(0, p, &len); // KEEP : error = Ubound +} + +void t_getpeername() +{ + struct sockaddr_in addr; + void *p = &addr; + int len = sizeof(addr); + getpeername(0, p, &len); + p = (char*)p+1; + getpeername(0, p, &len); // KEEP : error = Ubound +} + +void t_getsockname() +{ + struct sockaddr_in addr; + void *p = &addr; + int len = sizeof(addr); + getsockname(0, p, &len); + p = (char*)p+1; + getsockname(0, p, &len); // KEEP : error = Ubound +} + +#ifndef __CYGWIN__ +// CYGWIN does not have getnameifo +void t_getnameinfo() +{ + struct sockaddr_in addr; + void *p = &addr; + char host[40]; + char serv[40]; + getnameinfo(p, sizeof(addr), host, 40, serv, 40, 0); + p = (char*)p+1; + getnameinfo(p, sizeof(addr), host, 40, serv, 40, 0); // KEEP : error = Ubound +} +#endif + +char * NTS t_strdup() +{ + char buf[7] = "fhello"; + char *p = buf; + char *q; + char c; + + q++; // seq + p++; // seq + + c = p[4]; // the 'o', definitely ok + c = p[5]; // we allow this? + p[5] = 0; // this? + p[5] = 4; // KEEP : error = Ubound + p[5] = 0; // restore + + q = strdup(p); + c = q[10]; // KEEP : error = Ubound + q = strdup(p+10); // KEEP : error = Ubound + return q; +} + +int main() +{ + t_setsockopt(); + t_bind(); + t_accept(); + t_getpeername(); + t_getsockname(); + t_getnameinfo(); + t_strdup(); + + printf("no failure\n"); + return 0; +} + + diff --git a/test/libc/stat1.c b/test/libc/stat1.c new file mode 100755 index 0000000..45e9164 --- /dev/null +++ b/test/libc/stat1.c @@ -0,0 +1,25 @@ + +#include +#include +#include + +#define E(n) {printf("Error %d\n", n); exit(n); } + +TESTDEF : success + +int main() { + struct stat sb1, sb2, sb3; + + if(stat("stat1.c", &sb1)) E(1); + + if(lstat("stat1.c", &sb2)) E(2); + + if(sb1.st_size != sb2.st_size) E(3); + + // Try to invoke with a null pointer +IFTEST err : error = non-null check + stat(0, &sb3); +ENDIF + + return 0; +} diff --git a/test/libc/strchr1.c b/test/libc/strchr1.c new file mode 100755 index 0000000..c7b5dd5 --- /dev/null +++ b/test/libc/strchr1.c @@ -0,0 +1,22 @@ +#include "harness.h" +#include // strchr + +char (NT ch)[] = { 'f', 'a', 'r', 'a', 0 }; + +int main() { + char * NTS s = &ch[0]; + char * NTS t = strchr(s, 'a'); + t+=3; + + if(*t) E(1); // read the 0 + + t = strrchr(s, 'a'); + t ++; + + if(*t) E(2); + + t = strchr(s, 'b'); + if(t) E(3); + + SUCCESS; +} diff --git a/test/libc/strcpy.c b/test/libc/strcpy.c new file mode 100755 index 0000000..e77fa14 --- /dev/null +++ b/test/libc/strcpy.c @@ -0,0 +1,26 @@ +#include +#include "harness.h" + +char* NTS global = "Foo"; + +TESTDEF baseline: success + +void foo(char* NT COUNT(len) buf, int len) { + //unsafe API. Should fail statically + strcpy(buf, foo); //KEEP strcpy: success = Calls to strcpy are unsafe + + //we change this to strncpy(buf, "Hi, there", 9), based on the length of + // the string literal. + strcpy(buf, "Hi, there"); + strcpy(buf, "Hi, there."); //KEEP strcpy_toolong: error = Assertion failed + + + strcpy(buf, "Hi"); + if (strcmp(buf, "Hi") != 0) E(2) +} + +int main() { + char stringbuf[10]; + foo(stringbuf, sizeof(stringbuf)-1); + SUCCESS; +} diff --git a/test/libc/strerror1.c b/test/libc/strerror1.c new file mode 100755 index 0000000..8d3a56d --- /dev/null +++ b/test/libc/strerror1.c @@ -0,0 +1,10 @@ +#include // strerror +#include // printf + +int main() +{ + char * NTS s = strerror(2); // file not found + s++; + printf("string: %s\n", s); + return 0; +} diff --git a/test/libc/string1.c b/test/libc/string1.c new file mode 100755 index 0000000..0992b28 --- /dev/null +++ b/test/libc/string1.c @@ -0,0 +1,16 @@ +#include + +int main() { + char (NT buffer1)[16]; + char buffer2[16]; // We do not need NT annotations on local buffers + char * NTS res; + + res = strncpy(buffer1, "a string", sizeof(buffer1) - 1); // KEEP t1: success + + // The size argument must not include the null terminator. + strncpy(buffer1, "a string", sizeof(buffer1)); // KEEP e1: error = upper bound + + strncpy(buffer2, "a string", 1); // KEEP t2: success + + return 0; +} diff --git a/test/libc/string2.c b/test/libc/string2.c new file mode 100755 index 0000000..ece2b63 --- /dev/null +++ b/test/libc/string2.c @@ -0,0 +1,28 @@ +#include +#include + +typedef char * NT string; + +char * NTS getparam(char * NTS name) +{ + int i, len; + string def; + char (NT buf)[128]; + string userv; + + strncpy(buf, name, sizeof(buf) - 1); + len = strlen(buf); + + userv = (string) malloc(len+1); + strncpy(userv, buf, len); + + if(strcmp(userv, buf)) exit(1); + + return userv; +} + +int main() { + getparam("a string"); + + return 0; +} diff --git a/test/libc/string3.c b/test/libc/string3.c new file mode 100755 index 0000000..72ca7ef --- /dev/null +++ b/test/libc/string3.c @@ -0,0 +1,25 @@ +#include +#include +#include + +#define E(n) { printf("Error %d\n", n); exit(n); } + +char * NT str = "a string"; + +TESTDEF : success + +int main() { + int len = strlen(str); + char * dest; + // Forget about the last character + len --; // KEEP : error = upper bound + dest = (char*)malloc(len + 1); // Allocate a buffer for string + NULL + strncpy(dest, str, strlen(str)); + + if(strcmp(dest, str)) E(1); + + // Make sure that we still have 0 at the end of dest + if(dest[len] != 0) E(2); + + return 0; +} diff --git a/test/libc/string4.c b/test/libc/string4.c new file mode 100755 index 0000000..514d9aa --- /dev/null +++ b/test/libc/string4.c @@ -0,0 +1,33 @@ +// String tests from Bill. + +#include +#include + +int main() { + const char * NTS name = "foo!bar"; + char * NT prefix; // prefix is a buffer + char * NTS suffix; + int i, len, end; + + len = strlen(name); + end = -1; + for (i=0; i +#include + + +IFTEST docstring-1 : success + +void separate_short_docstring(char * NT str, + char *NT *short_s, + char *NT *long_s) +{ + char *dot, *at; + + if(str == NULL) { + *short_s = NULL; + *long_s = NULL; + return; + } + + /* find the first period, followed by whitespace, or the first '@', preceded by whitespace */ + dot = str; + do { + dot = strchr(dot,'.'); + if(dot == NULL) break; + dot++; + } while(*dot != '\0' && *dot != ' ' && *dot != '\t' && *dot != '\r' && *dot != '\n'); + + at = str-2; + do { + at = strchr(at+2,'@'); + if(at == NULL) break; + at--; + if(at < str) at++; + } while(*at != ' ' && *at != '\t' && *at != '\r' && *at != '\n'); + + if(at && at < dot) + dot = at; + + + /* check for the beginning of the next sentance */ + if(dot != NULL) { + dot += strspn(dot, " \t\n\r."); + if( *dot == '\0' ) + dot = NULL; + } + + /* short description only */ + if(dot == NULL) { + *short_s = str; + *long_s = NULL; + } + + /* both short and long descriptions */ + else { + *(dot - 1)= '\0'; + *short_s = strdup(str); + *(dot - 1)= ' '; + *long_s = str; + } +} + +void test(char *NT str) +{ + char *shorts, *longs; + + separate_short_docstring(strdup(str), &shorts, &longs); + + printf("long: %s\n short: %s\n\n", longs ? longs : "", shorts); +} + +int main(int argc, char *NT *argv) +{ + test("Simple."); + test("With long. Longer"); + test("This is a short with a.dot."); + test("The @marks the beginning of long, but this example reveals a bug"); + test("The @marks the beginning of long. Works with more than one sentence"); + test("But@not always"); + return 0; +} + +ENDIF + + +// ==================================== +IFTEST docstring-2 : success + +int issep(char c) +{ + return c == '\0' || c == ' ' || c == '\t' || c == '\n' || c == '\r'; +} + +void separate_short_docstring(char *NT str, char *NT *short_s, char *NT *long_s) +{ + char *dot, *at; + + if (str == NULL) + { + *short_s = NULL; + *long_s = NULL; + return; + } + + /* find the first period, followed by whitespace, or the first '@', + preceded by whitespace */ + dot = str; + for (;;) + { + dot = strchr(dot,'.'); + if(dot == NULL) + break; + dot++; + if (issep(*dot)) + break; + } + + at = str; + for (;;) + { + at = strchr(at, '@'); + if (at == NULL) + break; + if (at > str && issep(at[-1])) + { + at--; + break; + } + at++; + } + + if (at && (!dot || at < dot)) + dot = at; + + /* move to the beginning of the next sentance */ + if (dot) + { + dot += strspn(dot, " \t\n\r."); + if (*dot == '\0') + dot = NULL; + } + + if (!dot) + { + /* short description only */ + *short_s = str; + *long_s = NULL; + } + else + { + /* both short and long descriptions */ + dot[-1] = '\0'; + *short_s = strdup(str); + dot[-1] = ' '; + *long_s = str; + } +} + +void test(char *NT str) +{ + char *shorts, *longs; + + separate_short_docstring(strdup(str), &shorts, &longs); + + printf("long: %s\n short: %s\n\n", longs ? longs : "", shorts); +} + +int main(int argc, char *NT *argv) +{ + test("Simple."); + test("With long. Longer"); + test("This is a short with a.dot."); + test("The @marks the beginning of long, but this example reveals a bug"); + test("The @marks the beginning of long. Works with more than one sentence"); + test("But@not always"); + return 0; +} + +ENDIF + +// =========================================== +IFTEST int2str : success + +/* integers are 31 bits long, in base 2 this makes 31 characters + + sign + null byte + 1 for luck */ +#define INTSTRLEN 34 +#define FALSE 0 +#define TRUE 1 + +#include + +typedef uint32_t u32; +typedef int32_t i32; + +static char basechars[17] = "0123456789abcdef"; + +char *int2str(char * str, int base, u32 n, int is_signed) +/* Requires: base be 2, 8, 10 or 16. str be at least INTSTRLEN characters long. + Effects: Prints the ASCII representation of n in base base to the + string str. + If is_signed is TRUE, n is actually an i32 + Returns: A pointer to the start of the result. +*/ +{ + char *pos; + int minus; + + /* ints are 32 bits, the longest number will thus be + 32 digits (in binary) + 1(sign) characters long */ + pos = str + INTSTRLEN - 1; + *--pos = '\0'; + + if (is_signed && (i32)n < 0) + { + minus = TRUE; + if ((i32)n <= -16) + { + /* this is to take care of LONG_MIN */ + *--pos = basechars[abs((long)n % base)]; + n = (int32_t)n / base; + } + n = -(i32)n; + } + else minus = FALSE; + + do { + *--pos = basechars[n % base]; + n /= base; + } while (n > 0); + if (minus) *--pos = '-'; + + return pos; +} + +void testu(int base, uint32_t n) +{ + char buf[INTSTRLEN]; + + printf("%s\n", int2str(buf, base, n, FALSE)); +} + +void testi(int base, int32_t n) +{ + char buf[INTSTRLEN]; + + printf("%s\n", int2str(buf, base, (uint32_t)n, TRUE)); +} + +int main(int argc, char *NT *argv) +{ + uint32_t i; + + for (i = 0x80000000; i; i >>= 1) + { + testu(10, i); + testi(10, i); testi(10, -i); + + testu(2, i); testu(8, i); testu(16, i); + testi(10, i + 375); + } +} + +ENDIF + diff --git a/test/libc/string6.c b/test/libc/string6.c new file mode 100755 index 0000000..0534a58 --- /dev/null +++ b/test/libc/string6.c @@ -0,0 +1,332 @@ +// String tests from Ilya. + +#include +#include +#include +#include + +/* + * do_div() is NOT a C function. It wants to return + * two values (the quotient and the remainder), but + * since that doesn't work very well in C, what it + * does is: + * + * - modifies the 64-bit dividend _in_place_ + * - returns the 32-bit remainder + * + * This ends up being the most efficient "calling + * convention" on x86. + */ +#if 0 +#define do_div(n,base) ({ \ + unsigned long __upper, __low, __high, __mod, __base; \ + __base = (base); \ + asm("":"=a" (__low), "=d" (__high):"A" (n)); \ + __upper = __high; \ + if (__high) { \ + __upper = __high % (__base); \ + __high = __high / (__base); \ + } \ + asm("divl %2":"=a" (__low), "=d" (__mod):"rm" (__base), "0" (__low), "1" (__upper)); \ + asm("":"=A" (n):"a" (__low),"d" (__high)); \ + __mod; \ +}) +#else +unsigned long do_div_func(unsigned long long * n, unsigned long base) { + unsigned long long res = *n / base; + unsigned rem = *n - res * base; + *n = res; + return rem; +} +#define do_div(n,base) do_div_func(&(n), (base)) +#endif + + +/** + * simple_strtoul - convert a string to an unsigned long + * @cp: The start of the string + * @endp: A pointer to the end of the parsed string will be placed here + * @base: The number base to use + */ +unsigned long simple_strtoul(const char * NTS cp, + char * NTS * endp, unsigned int base) +{ + unsigned long result = 0,value; + + if (!base) { + base = 10; + if (*cp == '0') { + base = 8; + cp++; + if ((toupper(*cp) == 'X') && isxdigit(cp[1])) { + cp++; + base = 16; + } + } + } else if (base == 16) { + if (cp[0] == '0' && toupper(cp[1]) == 'X') + cp += 2; + } + while (isxdigit(*cp) && + (value = isdigit(*cp) ? *cp-'0' : toupper(*cp)-'A'+10) < base) { + result = result*base + value; + cp++; + } + if (endp) + *endp = (char *)cp; + return result; +} + + /** + * simple_strtoull - convert a string to an unsigned long long + * @cp: The start of the string + * @endp: A pointer to the end of the parsed string will be placed here + * @base: The number base to use + */ +unsigned long long simple_strtoull(const char * NTS cp, + char * NTS * endp,unsigned int base) +{ + unsigned long long result = 0,value; + + if (!base) { + base = 10; + if (*cp == '0') { + base = 8; + cp++; + if ((toupper(*cp) == 'X') && isxdigit(cp[1])) { + cp++; + base = 16; + } + } + } else if (base == 16) { + if (cp[0] == '0' && toupper(cp[1]) == 'X') + cp += 2; + } + while (isxdigit(*cp) && (value = isdigit(*cp) ? *cp-'0' : (islower(*cp) + ? toupper(*cp) : *cp)-'A'+10) < base) { + result = result*base + value; + cp++; + } + if (endp) + *endp = (char *)cp; + return result; +} + +/** + * simple_strtoll - convert a string to a signed long long + * @cp: The start of the string + * @endp: A pointer to the end of the parsed string will be placed here + * @base: The number base to use + */ +long long simple_strtoll(const char * NTS cp, + char * NTS * endp,unsigned int base) +{ + if(*cp=='-') + return -simple_strtoull(cp+1,endp,base); + return simple_strtoull(cp,endp,base); +} + + +static int skip_atoi(const char * NTS * s) +{ + int i=0; + + while (isdigit(**s)) + i = i*10 + *((*s)++) - '0'; + return i; +} + +#define ZEROPAD 1 /* pad with zero */ +#define SIGN 2 /* unsigned/signed long */ +#define PLUS 4 /* show plus */ +#define SPACE 8 /* space if plus */ +#define LEFT 16 /* left justified */ +#define SPECIAL 32 /* 0x */ +#define LARGE 64 /* use 'ABCDEF' instead of 'abcdef' */ + +// buf - the buffer where to write the number +// end - the last character in buffer towrite ? +// num - the number to convert +// base - +// size - seems to be the size of the representation. +// precision - +// type - +// Now do we say that the return value is related to the argument ? +static char * number(char * BND(__this, end+1) buf, + char * SNT end, unsigned long long num, + int base, int size, int precision, int type) +{ + char c,sign,tmp[66]; // This will break if we work with larger numbers + const char *digits; + static const char small_digits[] = + "0123456789abcdefghijklmnopqrstuvwxyz"; + static const char large_digits[] = + "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + int i; + + digits = (type & LARGE) ? large_digits : small_digits; + if (type & LEFT) + type &= ~ZEROPAD; + if (base < 2 || base > 36) + return NULL; + c = (type & ZEROPAD) ? '0' : ' '; + sign = 0; + if (type & SIGN) { + if ((signed long long) num < 0) { + sign = '-'; + num = - (signed long long) num; + size--; + } else if (type & PLUS) { + sign = '+'; + size--; + } else if (type & SPACE) { + sign = ' '; + size--; + } + } + if (type & SPECIAL) { + if (base == 16) + size -= 2; + else if (base == 8) + size--; + } + i = 0; + if (num == 0) + tmp[i++]='0'; + else while (num != 0) + tmp[i++] = digits[do_div(num,base)]; + if (i > precision) + precision = i; + size -= precision; + if (!(type&(ZEROPAD+LEFT))) { + while(size-->0) { + if (buf <= end) + *buf = ' '; + ++buf; + } + } + if (sign) { + if (buf <= end) + *buf = sign; + ++buf; + } + if (type & SPECIAL) { + if (base==8) { + if (buf <= end) + *buf = '0'; + ++buf; + } else if (base==16) { + if (buf <= end) + *buf = '0'; + ++buf; + if (buf <= end) + *buf = digits[33]; + ++buf; + } + } + if (!(type & LEFT)) { + while (size-- > 0) { + if (buf <= end) + *buf = c; + ++buf; + } + } + while (i < precision--) { + if (buf <= end) + *buf = '0'; + ++buf; + } + + while (i-- > 0) { + if (buf <= end) + *buf = tmp[i]; + ++buf; + } + while (size-- > 0) { + if (buf <= end) + *buf = ' '; + ++buf; + } + return buf; +} + +TESTDEF number-ok : success +IFTEST number-ok +int main(int argc, char* argv[]) +{ + char* buf = malloc(18); + number(buf, buf + 17, 7777777, 10, 10, 5, SIGN); + return 0; +} +ENDIF + +TESTDEF number-fail : error +IFTEST number-fail +int main(int argc, char* argv[]) +{ + char* buf = malloc(18); + // We are passing an end pointer that is too far. + number(buf, buf + 18, 7777777, 10, 10, 5, SIGN); + return 0; +} +ENDIF + +TESTDEF number-fail2 : error +IFTEST number-fail +int main(int argc, char* argv[]) +{ + char* buf = malloc(8); + // The size parameter is too large + number(buf, buf + 7, 7777777, 10, 10, 5, SIGN); + return 0; +} +ENDIF + +TESTDEF skip-ok : success +IFTEST skip-ok +int main(int argc, char* argv[]) +{ + const char* buf1 = strdup("123456"); + skip_atoi(&buf1); + return 0; +} +ENDIF + +TESTDEF skip-fail : error +IFTEST skip-fail +int main(int argc, char* argv[]) +{ + char * NT buf = malloc(8); + memcpy(buf, "12345678", 8); + skip_atoi(&buf); + return 0; +} +ENDIF + +TESTDEF strtoul-ok : success +IFTEST strtoul-ok +int main(int argc, char* argv[]) +{ + char* buf = malloc(32); + char* end; + + strncpy(buf, "1234\0", sizeof(buf)); + simple_strtoul(buf, &end, 10); + return 0; +} +ENDIF + + +TESTDEF strtoul-fail : error +IFTEST strtoul-fail +int main(int argc, char* argv[]) +{ + char* buf = malloc(4); + char* end; + + memcpy(buf, "1234\0", 4); + simple_strtoul(buf, &end, 10); + return 0; +} +ENDIF + diff --git a/test/libc/string7.c b/test/libc/string7.c new file mode 100755 index 0000000..4a41796 --- /dev/null +++ b/test/libc/string7.c @@ -0,0 +1,390 @@ +// String tests from Zach. + +#include +#include +#include + +IFTEST str-qs-1 : success +#define NUMSTRINGS 11 +char *NTS strings[] = { "abracadabra", + "bamboozled", + "Canada Dry Ginger Ale", + "boston champion", + "Shostakovich: Symphony No. 10", + "PRINTED LINING FOR PRIVACY", + "www.asus.com", + "Curiously Strong Peppermints", + "o", + "\0", + "" }; + +void reverse(char *NTS s) +{ + int c, i, j; + + for(i = 0, j = strlen(s) - 1; i < j; i++, j--) { + c = s[i]; + s[i] = s[j]; + s[j] = c; + } +} + +//s must have room for '-' and a 10 digit number +char *itoa(int n, char * COUNT(11) s, int w) +{ + int i, sign; + + if ( (sign = n) < 0 ) { + n = -n; + } + + i = 0; + do { + s[i++] = n % 10 + '0'; + } while ( (n /= 10) > 0 ); + + if (sign < 0) { + s[i++] = '-'; + } + + while(i < w) { + s[i++] = ' '; + } + + s[i]= '\0'; + + reverse(s); + return s; +} + +int str_compare(const void *v1, const void *v2) +{ + char *s1 = *(char **)v1; + char *s2 = *(char **)v2; + int s1l = strlen(s1); + int s2l = strlen(s2); + int n1 = atoi(s1 + s1l - 2); + int n2 = atoi(s2 + s2l - 2); + + if( n1 > n2 ) + return 1; + if( n2 > n1 ) + return -1; + return 0; +} + +void test() +{ + char *copy[NUMSTRINGS]; + char num[3]; + int i, j, l, sum; + + for( i = 0; i < NUMSTRINGS; i++ ) { + l = strlen(strings[i]); + copy[i] = malloc( l + 3 ); + strncpy( copy[i], strings[i], l ); + + sum = 0; + for( j = 0; j < l; j++ ) { + sum += 11 * copy[i][j] + 7; + } + sum %= 97; + + itoa( sum, num, 2 ); + strncat( copy[i], num, 2 ); + } + + qsort( copy, NUMSTRINGS, sizeof(copy[1]), str_compare ); + + for( i = 0; i < NUMSTRINGS; i++ ) { + + printf( "%s\n", copy[i] ); + + } + + return; +} + +int main() +{ + test(); + return 0; +} +ENDIF + +TESTDEF str-qsf-1 : error +IFTEST str-qsf-1 +#define NUMSTRINGS 11 +char * NTS +strings[] = { "abracadabra", + "bamboozled", + "Canada Dry Ginger Ale", + "boston champion", + "Shostakovich: Symphony No. 10", + "PRINTED LINING FOR PRIVACY", + "www.asus.com", + "Curiously Strong Peppermints", + "o", + "\0", + "" }; + +void reverse(char * NTS s) +{ + int c, i, j; + + for(i = 0, j = strlen(s) - 1; i < j; i++, j--) { + c = s[i]; + s[i] = s[j]; + s[j] = c; + } +} + +char * NTS itoa(int n, char * NT COUNT(w) s, int w) +{ + int i, sign; + + if ( (sign = n) < 0 ) { + n = -n; + } + + i = 0; + do { + s[i++] = n % 10 + '0'; + } while ( (n /= 10) > 0 ); + + if (sign < 0) { + s[i++] = '-'; + } + + while(i < w) { + s[i++] = ' '; + } + + s[i]= '\0'; + + reverse(s); + return s; +} + +int str_compare(char * NTS * v1, char * NTS * v2) +{ + char *s1 = *(char * NTS *)v1; + char *s2 = *(char * NTS *)v2; + int s1l = strlen(s1); + int s2l = strlen(s2); + int n1 = atoi(s1 + s1l - 2); + int n2 = atoi(s2 + s2l - 2); + + if( n1 > n2 ) + return 1; + if( n2 > n1 ) + return -1; + return 0; +} + +void test() +{ + char *copy[NUMSTRINGS]; + char num[3]; + int i, j, l, sum; + + for( i = 0; i < NUMSTRINGS; i++ ) { + l = strlen(strings[i]); + copy[i] = malloc( l + 3 ); + strncpy( copy[i], strings[i], l ); + + sum = 0; + for( j = 0; j <= l + 3; j++ ) { + sum += 11 * copy[i][j] + 7; + } + sum %= 97; + + itoa( sum, num, 2 ); + strncat( copy[i], num, 2 ); + } + + qsort( copy, NUMSTRINGS, sizeof(copy[1]), str_compare ); + + for( i = 0; i < NUMSTRINGS; i++ ) { + + printf( "%s\n", copy[i] ); + + } + + return; +} + +int main() +{ + test(); + return 0; +} +ENDIF + +TESTDEF "str-wl-1" : success +IFTEST "str-wl-1" +#define NUMSTRINGS 9 +char *NTS strings[] = { "abracadabra", + "bamboozled", + "Canada Dry Ginger Ale", + "boston champion", + "Shostakovich: Symphony No. 10", + "PRINTED LINING FOR PRIVACY", + "www.asus.com", + "Curiously Strong Peppermints", + "o"}; + +void test() +{ + char *copy[NUMSTRINGS]; + int i, l; + + for( i = 0; i < NUMSTRINGS; i++ ) { + l = strlen( strings[i] ); + //matth: we don't support this + copy[i] = malloc( l + 2 ); + strncpy( copy[i], strings[i], l ); + + copy[i][l] = copy[i][l-1]; + copy[i][l+1] = '\0'; + printf( "%s\n", copy[i] ); + } + + return; +} + +int main() +{ + test(); + return 0; +} +ENDIF + +TESTDEF "str-wlf-1" : error +IFTEST "str-wlf-1" +#define NUMSTRINGS 11 +char * NTS +strings[] = { "abracadabra", + "bamboozled", + "Canada Dry Ginger Ale", + "boston champion", + "Shostakovich: Symphony No. 10", + "PRINTED LINING FOR PRIVACY", + "www.asus.com", + "Curiously Strong Peppermints", + "o", + "\0", + "" }; + +void test() +{ + char * NTS copy[NUMSTRINGS]; + int i, l; + + for( i = 0; i < NUMSTRINGS; i++ ) { + l = strlen( strings[i] ); + copy[i] = malloc( l + 2 ); + strncpy( copy[i], strings[i], l ); + + copy[i][l] = copy[i][l-1]; + copy[i][l+1] = '\0'; + printf( "%s\n", copy[i] ); + } + + return; +} + +int main() +{ + test(); + return 0; +} +ENDIF + +TESTDEF "str-wsqpp-1" : success +IFTEST "str-wsqpp-1" +#define NUMSTRINGS 11 +char * NTS strings[] = { "abracadabra", + "bamboozled", + "Canada Dry Ginger Ale", + "boston champion", + "Shostakovich: Symphony No. 10", + "PRINTED LINING FOR PRIVACY", + "www.asus.com", + "Curiously Strong Peppermints", + "o", + "\0", + "" }; + +void test() +{ + char * NTS copy[NUMSTRINGS]; + char *q; + int i, j, l, sum; + + for( i = 0; i < NUMSTRINGS; i++ ) { + l = strlen( strings[i] ); + copy[i] = strdup( strings[i] ); + strncpy( copy[i], strings[i], l ); + + sum = 0; + q = copy[i]; + while( *q++ ) { + sum += *(q - 1); + *(q - 1) = 'A'; + } + } + + return; +} + +int main() +{ + test(); + return 0; +} +ENDIF + +TESTDEF "str-wsqppf-1" : error +IFTEST "str-wsqppf-1" +#define NUMSTRINGS 11 +char *strings[] = { "abracadabra", + "bamboozled", + "Canada Dry Ginger Ale", + "boston champion", + "Shostakovich: Symphony No. 10", + "PRINTED LINING FOR PRIVACY", + "www.asus.com", + "Curiously Strong Peppermints", + "o", + "\0", + "" }; + +void test() +{ + char *copy[NUMSTRINGS]; + char *q; + int i, j, l, sum; + + for( i = 0; i < NUMSTRINGS; i++ ) { + l = strlen( strings[i] ); + copy[i] = strdup( strings[i] ); + strncpy( copy[i], strings[i], l ); + + sum = 0; + q = copy[i]; + while( *q++ ) { + sum += *(q); + *(q) = 'A'; + } + } + + return; +} + +int main() +{ + test(); + return 0; +} +ENDIF diff --git a/test/libc/strlcpy.c b/test/libc/strlcpy.c new file mode 100755 index 0000000..7f1d11f --- /dev/null +++ b/test/libc/strlcpy.c @@ -0,0 +1,29 @@ +#include +#include "harness.h" + +//Test strlcpy. This test is not in the regression suite, because +//strlcpy doesn't work on Manju. + + +char* NTS global = "Really long string. etc., etc., etc."; + +TESTDEF baseline: success + +int main() { + char buf[10]; + + //The buffer size is 10, so we should pass 9 to strncpy and 10 to strlcpy + + strncpy(buf, global, 9); + strncpy(buf, global, 10); //KEEP strncpy: error = Assertion failed + + strlcpy(buf, global, 10); + if (buf[9] != 0) E(3); + + //make sure strlcat works too + buf[5] = 0; + strlcat(buf, global, 10); + if (buf[9] != 0) E(4); + + SUCCESS; +} diff --git a/test/libc/strncpy1.c b/test/libc/strncpy1.c new file mode 100644 index 0000000..6df94e9 --- /dev/null +++ b/test/libc/strncpy1.c @@ -0,0 +1,19 @@ +// KEEP baseline: success + +#include +#include + +int main() { + char (NT foo)[10]; + int i; + + foo[8] = 42; + strncpy(foo, "blah blah blah", 7); + + // We're not allowed to specify 10 here, because strncpy can overwrite + // the final zero otherwise. + strncpy(foo, "blah blah blah", 10); // KEEP e1: error = nullterm upper bound + + // Make sure item 8 was not overwritten. + return (foo[8] == 42) ? 0 : 1; +} diff --git a/test/libc/strpbrk1.c b/test/libc/strpbrk1.c new file mode 100755 index 0000000..3c83441 --- /dev/null +++ b/test/libc/strpbrk1.c @@ -0,0 +1,14 @@ +// demonstrate strpbrk problem, and workaround + +#include // strpbrk + +int main() +{ + char * NTS s = "foo"; + char * NTS accept = "o"; + char * NTS w; + + w = strpbrk(s, accept); + + return !( *w == 'o' && (w-s == 1) ); +} diff --git a/test/libc/strspn.c b/test/libc/strspn.c new file mode 100755 index 0000000..6d3225d --- /dev/null +++ b/test/libc/strspn.c @@ -0,0 +1,16 @@ + +#include +#include +#include + +#define E(n) { printf("Error %d\n", n); exit(n); } + +int main() { + char * str = "aabbcccdef"; + + if(strspn(str, "abc") != 7) E(1); + + if(strcspn(str, "cdef") != 4) E(2); + + return 0; +} diff --git a/test/libc/strtok1.c b/test/libc/strtok1.c new file mode 100644 index 0000000..7c3e278 --- /dev/null +++ b/test/libc/strtok1.c @@ -0,0 +1,92 @@ +// models.c +// tests of models and wrappers + +#include // strchr +#include // assert +#include // printf + +TESTDEF : success + +void t_strchr() +{ + char buf[40] = "hello world"; + char *p = buf; + char *q; + + q = strchr(p, 'w'); + assert(q == p+6); +} + + +void t_strdup() +{ + char c[2] = "a"; + char *p = c; // nominally safe (?) + char *q; + + q = strdup(p); // strdup_fs without the model + assert(q != NULL); // use q somehow +} + + +void t_strpbrk_sff() +{ + char buf[10] = "abcdefghi"; + char *b = buf; + char *p; + + //p++; // fseq + //b++; // fseq + p = strpbrk(b, "gfe"); + p++; // seq? + p--; + assert(p == buf+4); + printf("strpbrk_sff ok\n"); +} + +// Try an unannotated global buffer +IFTEST : error = Cast from ordinary pointer to nullterm: globuf + char globuf[10] = "abcdefghi"; +ELSE + char (NT globuf)[10] = "abcdefghi"; +ENDIF +void t_strpbrk_fff() +{ + char *b = globuf; + char *p; + + b++; // fseq + p = strpbrk(b, "gfe"); + assert(p == globuf+4); + printf("strpbrk_fff ok\n"); +} + +void t_strtok() +{ + char buf[80] = "xabc def ghi"; + char *b = buf; + char *p; + + p = strtok(b, " "); + printf("abc: %s\n", p); + p = strtok(NULL, " "); + printf("def: %s\n", p); + p = strtok(NULL, " "); + printf("ghi: %s\n", p); + p = strtok(NULL, " "); + assert(p == NULL); +} + + +int main() +{ + t_strchr(); + t_strdup(); + t_strpbrk_sff(); + t_strpbrk_fff(); + t_strtok(); + + return 0; +} + + diff --git a/test/libc/vararg1.c b/test/libc/vararg1.c new file mode 100644 index 0000000..2ee6de3 --- /dev/null +++ b/test/libc/vararg1.c @@ -0,0 +1,29 @@ +// KEEP baseline: success + +#include + +int foo(int n, ...) TRUSTED { + int i; + int sum = 0; + va_list ap; + + va_start(ap, n); + for (i = 0; i < n; i++) { + sum += va_arg(ap, int); + } + va_end(ap); + + return sum; +} + +int main() { + int * SAFE z = 0; + int sum = 0; + + sum += foo(0); + sum += foo(1, 1); + sum += foo(3, 1, 2, 3); + sum += foo(1, *z); // KEEP err1: error = non-null + + return (sum != 7) ? 1 : 0; +} diff --git a/test/libc/writev1.c b/test/libc/writev1.c new file mode 100644 index 0000000..59531a0 --- /dev/null +++ b/test/libc/writev1.c @@ -0,0 +1,113 @@ +// DO NOT CHANGE THIS LINE +// Test that read and readv work. + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include + +#define myassert(I) do { \ + if(!(I)) { \ + printf("%s:%d **************** assertion failure\n", __FILE__, __LINE__); \ + abort(); \ + } \ +} while(0) + +# define MSG0 "HI THERE" +# define MSG1 "BYE NOW!" +# define TESTFILE "writev_test.tmp" + +void delete_file(char * NTS name) { + if(!(unlink(TESTFILE)==0)) { + if (errno!=ENOENT) perror("error unlinking"); + } + errno = 0; + { + struct stat s; + int statval = stat(TESTFILE, &s); + myassert(statval == -1); + myassert(errno == ENOENT); + } +} + +void test_writev() { + int in; + int out; + int num_written; + int num_left; + char *buf; + const int size = 8; + struct iovec iov[2]; + char *dummy; + iov[0].iov_len = 8; + iov[0].iov_base = NTDROP("HI THERE"); + myassert(iov[0].iov_len == size); + dummy = "asdfasdf"; // attempt to break string contiguity + iov[1].iov_len = 8; + iov[1].iov_base = NTDROP("BYE NOW!"); + myassert(iov[1].iov_len == size); + + // Get rid of the testfile. + delete_file(TESTFILE); + + out = open(TESTFILE, O_WRONLY | O_TRUNC | O_CREAT, S_IRUSR | S_IWUSR); + if (out==-1) { + perror("**** error opening file for writing"); + abort(); + } + + // NOTE: we assume that it maximally flushes the buffers. + { + num_written = writev(out, iov, 2); + myassert(num_written = 2 * size); + myassert(close(out)==0); + } + printf("wrote file\n"); + + // check it is what we expect. + { + buf = malloc((2*size+1) * sizeof buf[0]); + in = open(TESTFILE, O_RDONLY); + myassert(buf!=0); + if (in==-1) { + perror("**** error opening file for reading"); + abort(); + } + + // read + printf("trying to read file\n"); + { + num_left = 2*size; + while(num_left) { + int num_read = read(in, NTDROP(buf)+(2*size)-num_left, num_left); + num_left -= num_read; + } + buf[2*size] = '\0'; + myassert(num_left==0); + myassert(close(in)==0); + } + + // check it is what we expect. + // NOTE: strings literals concatenate at compile time + printf("read:%s:\n", buf); + myassert(strcmp(TC(buf), MSG0 MSG1)==0); + printf("success\n"); + + // Get rid of the testfile. + delete_file(TESTFILE); +} +} + +int main() { + printf("test writev\n"); + test_writev(); + return 0; +} diff --git a/test/small/.cvsignore b/test/small/.cvsignore new file mode 100755 index 0000000..aaf029b --- /dev/null +++ b/test/small/.cvsignore @@ -0,0 +1,7 @@ +*.exe +*.o +*.i +*.cil.c +*-tmp.c +*.stackdump +tout.c diff --git a/test/small/Makefile b/test/small/Makefile new file mode 100755 index 0000000..26fadfe --- /dev/null +++ b/test/small/Makefile @@ -0,0 +1,25 @@ +include ../Makefile + +CC = gcc + +# The list of tests is in ../runtests.pl + +.PHONY: clean alltests + +alltests: + cd ..; ./testdeputy -r --nogroup slow --nogroup ALWAYS +# @echo -e "\n\nAll tests were successful. \n\n" + +clean: + rm -f *.cil.c *.i *.exe *.o *~ *.stackdump *-tmp.c + +ifndef NODEPUTY +OPTIONS := $(OPTIONS) --fail-stop +endif + +runall/%: %.c testlib.o + COMMAND="$(DEPUTY) $(OPTIONS) \ + -o __BASENAME__.exe __FILE__ testlib.o && \ + ./__BASENAME__.exe" \ + COMMENT="//" \ + perl $(RUNALL) $*.c diff --git a/test/small/abstract1.c b/test/small/abstract1.c new file mode 100644 index 0000000..cd9f33d --- /dev/null +++ b/test/small/abstract1.c @@ -0,0 +1,28 @@ +//Deputy's optimizer ran into trouble here because of the abstract type. + +struct abstract; + +//in testlib.c: +extern struct abstract* get_abstract(); +extern void check_abstract(struct abstract* p); + +//We don't yet support annotating abstract pointers with a length (even 1) +//because there's no way to insert runtime checks that don't use arithmetic. +struct abstract* SAFE global; + +int main() { + struct abstract *d; + int * p = 0; + + if ((d = get_abstract()) == ((void *) 0)) + { + } + check_abstract(d); //KEEP baseline: success + check_abstract(d+1); //KEEP arith: error = Arithmetic on abstract pointer + check_abstract(p); //KEEP wrongtype: error = Error: Type mismatch + + global = d; + + return 0; +} + diff --git a/test/small/addrof1.c b/test/small/addrof1.c new file mode 100644 index 0000000..3a56305 --- /dev/null +++ b/test/small/addrof1.c @@ -0,0 +1,7 @@ +int main() { + int i; + int * SAFE p = &i; + *p = 0; + + return 0; +} diff --git a/test/small/addrof2.c b/test/small/addrof2.c new file mode 100644 index 0000000..be09365 --- /dev/null +++ b/test/small/addrof2.c @@ -0,0 +1,11 @@ +void foo(int * SAFE p) { + *p = 0; +} + +int main() { + int i; + int * SAFE p = &i; + foo(p); + + return 0; +} diff --git a/test/small/addrof3.c b/test/small/addrof3.c new file mode 100644 index 0000000..146d8a3 --- /dev/null +++ b/test/small/addrof3.c @@ -0,0 +1,14 @@ +// KEEP baseline: success + +int main(int argc, char** argv) { + int i; + int two = argc+1; + int * SAFE p = &i; // KEEP baseline + //Assign &i to a pointer of type COUNT(2). We'll catch this at + // either compile time or run time + int * COUNT(2) p = &i; // KEEP size1: error = will always fail + int * COUNT(two) p = &i; // KEEP size2: error = Assertion + *p = 0; + + return 0; +} diff --git a/test/small/addrof4.c b/test/small/addrof4.c new file mode 100644 index 0000000..797a01f --- /dev/null +++ b/test/small/addrof4.c @@ -0,0 +1,14 @@ +// KEEP baseline: success + +void foo(int * COUNT(2) p) { + *p = 0; + *p = 1; +} + +int main() { + int i; + int * SAFE p = &i; + foo(p); // KEEP size1: error = will always fail + + return 0; +} diff --git a/test/small/addrof5.c b/test/small/addrof5.c new file mode 100644 index 0000000..9ace547 --- /dev/null +++ b/test/small/addrof5.c @@ -0,0 +1,11 @@ +//This test should fail +//KEEP baseline: error = address of lval + +int main() { + int i; + int * COUNT(i) q = 0; + int * SAFE p = 0; + p = &i; + + return 0; +} diff --git a/test/small/addrof6.c b/test/small/addrof6.c new file mode 100644 index 0000000..3d37f1b --- /dev/null +++ b/test/small/addrof6.c @@ -0,0 +1,6 @@ +int main() { + int * SAFE p = 0; + int * SAFE * SAFE q = &p; + + return 0; +} diff --git a/test/small/addrof7.c b/test/small/addrof7.c new file mode 100644 index 0000000..59f2760 --- /dev/null +++ b/test/small/addrof7.c @@ -0,0 +1,10 @@ +//This test should fail +//KEEP baseline: error = address of lval + +int main() { + int * BND(r,r) p = 0; + int * SAFE r = 0; + int * SAFE * SAFE q = &p; + + return 0; +} diff --git a/test/small/align1.c b/test/small/align1.c new file mode 100644 index 0000000..688e52f --- /dev/null +++ b/test/small/align1.c @@ -0,0 +1,24 @@ +int main() { + int a[5]; + int * COUNT(5) b = a; + int * SNT e = b + 5; + + int * BND(b, e) p = b + 2; + + int * SNT b1 = b + 1; + int * SNT e1 = b + 4; + + int * BND(b1, e1) p1 = p; + + int * SNT b2 = (int * SNT)((char * COUNT(20)) b + 2); + int * SNT e2 = (int * SNT)((char * COUNT(20)) b + 18); + int * SNT e2 = (int * SNT)((char * COUNT(20)) b + 18); + + int * BND(b2, e2) p2 = p; // KEEP align1: success + + //we'll allow misaligned pointers, if they aren't dereferenced + int * BND(b2, e2) p3 = b+4; + int x = *p3; // KEEP align2: error = will always fail + + return 0; +} diff --git a/test/small/align2.c b/test/small/align2.c new file mode 100644 index 0000000..a0fef8f --- /dev/null +++ b/test/small/align2.c @@ -0,0 +1,42 @@ +#include "harness.h" +//Test case that shows that we need to keep the upper bound of an NT pointer +// correctly aligned. + +int garbage1 = 0xaaaaaaaa; +//An array of safe pointers. +int (NT array)[2] = {-1, 0}; +int garbage2 = 0x55555555; + +TESTDEF baseline: success + +int main() { + + { TRUSTEDBLOCK + //Make sure the first byte of array[2] and the last byte of array[0] + // are nonzero, or this test won't work. + if ( *((char*)(&array[2])) == 0) { + printf("Problem with the test case: *((char*)(&array[2])) == 0\n"); + exit(-1); + } + if ( *(((char*)array)+3) == 0) { + printf("Problem with the test case: *(((char*)array)+3) == 0\n"); + exit(-1); + } + } + + unsigned long b = ((unsigned long)array); + unsigned long e = ((unsigned long)array) + 3; + unsigned long e_bad = ((unsigned long)array) + 11; + int * NT BND(b,e) p = array; + + //Because e is unaligned, the NT extension of the bounds to e_bad will + //succeed. + int * NT BND(b,e_bad) illegal = p+2; //KEEP badNT: error = some error message + + //Now we can illegally read/write p[2] a.k.a. garbage2 + int tmp = *illegal; //KEEP badNT + printf("p[2] == 0x%x\n", tmp); //KEEP badNT + *illegal = 5; //KEEP badNT + + return 0; +} diff --git a/test/small/alloc1.c b/test/small/alloc1.c new file mode 100755 index 0000000..96d3526 --- /dev/null +++ b/test/small/alloc1.c @@ -0,0 +1,18 @@ +//This test should work without any changes. +//KEEP baseline: success + +#include "harness.h" + +int * COUNT(42) myalloc() { + int len = 50; + int * COUNT(len) p; + len = 41; //KEEP wronglen: error + p = alloc(int, len); + p[12] = 12; + return p; +} + +int main() { + int * COUNT(42) p = myalloc(); + return 0; +} diff --git a/test/small/alloc10.c b/test/small/alloc10.c new file mode 100644 index 0000000..99264de --- /dev/null +++ b/test/small/alloc10.c @@ -0,0 +1,90 @@ +// Makes sure allocations are properly initialized. + +#include "harness.h" + +void stack_garbage() { + int a[10]; + a[0] = 42; + a[9] = 42; +} + +void stack_test1() { + int *a[10]; + if (a[0] != 0) E(1); + if (a[9] != 0) E(2); +} + +void stack_test2() { + int (NT a)[10]; + if (a[9] != 0) E(3); +} + +void * (DALLOC(10 * sizeof(int)) my_alloc)() { + static int a[10]; + a[0] = 42; + a[9] = 42; + return a; +} + +void alloc_test1() { + int **p = my_alloc(); + if (p[0] != 0) E(4); + if (p[9] != 0) E(5); +} + +void alloc_test2() { + int * NT p = my_alloc(); + if (p[9] != 0) E(6); +} + +void * (DREALLOC(p, 20 * sizeof(int)) my_realloc)(void *p) { + static int a[20]; + int *old = (int * COUNT(10)) TC(p); + int i; + for (i = 0; i < 10; i++) { + a[i] = old[i]; + } + a[19] = 42; + return a; +} + +void realloc_test1() { + int **p = my_alloc(); + int **q; + int i; + p[0] = &i; + p[9] = &i; + q = my_realloc(p); + if (q[0] != &i) E(7); + if (q[9] != &i) E(8); + // TODO: Currently don't test zeros in "new" memory. +} + +void realloc_test2() { + int * NT p = my_alloc(); + int * NT q; + int i; + p[0] = 1337; + p[8] = 1337; + q = my_realloc(p); + if (q[0] != 1337) E(9); + if (q[8] != 1337) E(10); + if (q[9] != 0) E(11); + if (q[19] != 0) E(12); +} + +int main() { + stack_garbage(); + stack_test1(); + + stack_garbage(); + stack_test2(); + + alloc_test1(); + alloc_test2(); + + realloc_test1(); + realloc_test2(); + + return 0; +} diff --git a/test/small/alloc11.c b/test/small/alloc11.c new file mode 100644 index 0000000..7aaaa2d --- /dev/null +++ b/test/small/alloc11.c @@ -0,0 +1,9 @@ +// Make sure we get something reasonable when we cast malloc's result to +// an integer type. + +#include "harness.h" + +int main() { + unsigned long start = (unsigned long) malloc(100); + return 0; +} diff --git a/test/small/alloc12.c b/test/small/alloc12.c new file mode 100644 index 0000000..75295f7 --- /dev/null +++ b/test/small/alloc12.c @@ -0,0 +1,13 @@ + + +void *(DALLOC(size) mymalloc)(unsigned int size) { + return (void *)0; +} + +int main() +{ + char * NTC(10) str = mymalloc(10); + + + return 0; +} diff --git a/test/small/alloc2.c b/test/small/alloc2.c new file mode 100755 index 0000000..63d373a --- /dev/null +++ b/test/small/alloc2.c @@ -0,0 +1,20 @@ +//This test should work without any changes. +//KEEP baseline: success + +#include "harness.h" + +int main() { + int len = 260; + int * COUNT(len) p; + p = alloc(int, len); + p = alloc(int, len-1); //KEEP wronglen: error + p = alloc(char, len); //KEEP wrongtype: error = Assertion failed + p = alloc(int*, len); + + //Don't strip the cast to char! We shouldn't think we're allocating + //260 ints when we really only allocate four. + p = alloc(int, (char)len); //KEEP cast: error = Assertion failed + + p[12] = 12; + return 0; +} diff --git a/test/small/alloc3.c b/test/small/alloc3.c new file mode 100644 index 0000000..06f414f --- /dev/null +++ b/test/small/alloc3.c @@ -0,0 +1,30 @@ +// KEEP baseline: success + +extern void *(DALLOC(size) malloc)(unsigned int size); +extern void *(DALLOC(size1 * size2) calloc)(unsigned int size1, unsigned int size2); + +void *(DALLOC(size) my_malloc)(int dummy, int size) { + return malloc(size); +} + +void *(DALLOC(size1 * size2) my_calloc)(int dummy, int size2, int size1) { + int size = size1 * size2; + return malloc(size); +} + +int * SAFE NULL = 0; + +int main() { + int * COUNT(10) p; + int * SAFE z = NULL; + + p = my_malloc(5 * sizeof(int), 10 * sizeof(int)); + p = my_malloc(10 * sizeof(int), 5 * sizeof(int)); // KEEP arg1: error = Assertion + p = my_malloc(*z, 10 * sizeof(int)); // KEEP arg2: error = Assertion + + p = my_calloc(5, sizeof(int), 10); + p = my_calloc(10, sizeof(int), 5); // KEEP arg3: error = Assertion + p = my_calloc(*z, sizeof(int), 10); // KEEP arg4: error = Assertion + + return 0; +} diff --git a/test/small/alloc4.c b/test/small/alloc4.c new file mode 100644 index 0000000..a7e6758 --- /dev/null +++ b/test/small/alloc4.c @@ -0,0 +1,16 @@ +// This test checks that we set bounds properly when allocating a weird +// number of elements. + +// KEEP baseline: success + +#include "harness.h" + +int main() { + int * SAFE p; + + p = alloc(char, 6); + p[0] = 0; + p[1] = 0; // KEEP bounds: error = will always fail + + return 0; +} diff --git a/test/small/alloc5.c b/test/small/alloc5.c new file mode 100644 index 0000000..cf65d61 --- /dev/null +++ b/test/small/alloc5.c @@ -0,0 +1,27 @@ +#include "harness.h" + +//When allocating an NT buffer, subtract one from the length. + +//KEEP baseline: success + +void my_strlcpy(char* COUNT(n-1) NT dest, char* NTS src, int n) { + int position; + for (position = 0; position < n-1 && *src != 0; src++, position++) { + dest[position] = *src; + } + if (position < n) { + *dest = 0; + } +} + +int main() { + int len = 5; + char * NT buf = alloc(char, len); + buf[0] = buf[1] = buf[2] = buf[3] = 'a'; + buf[4] = 0; + buf[4] = 'b'; //KEEP write: error = nullterm write check + + my_strlcpy(buf, "Hola", 5); + my_strlcpy(buf, "Hello", 6); //KEEP call: error = nullterm upper bound + return 0; +} diff --git a/test/small/alloc6.c b/test/small/alloc6.c new file mode 100755 index 0000000..cc2a63f --- /dev/null +++ b/test/small/alloc6.c @@ -0,0 +1,22 @@ +#include "harness.h" + +int to_alloc; +int ** COUNT(to_alloc) to_nodes; +double * COUNT(to_alloc) coeffs; + + +int global; + +int main() { + + int degree = 8; + + to_alloc = degree; + to_nodes = (int **) malloc(degree*(sizeof(int *))); + coeffs = (double *) malloc(degree*sizeof(double)); + + coeffs[7] = 2.0; + to_nodes[7] = & global; + + return 0; +} diff --git a/test/small/alloc7.c b/test/small/alloc7.c new file mode 100755 index 0000000..6f4e0fc --- /dev/null +++ b/test/small/alloc7.c @@ -0,0 +1,21 @@ +#include "harness.h" + +struct node { + struct node * next; + int * COUNT(len) buf; + int len; +}; + +int main() { + struct node n[2]; + int i; + + for (i = 0; i < 2; i++) { + struct node *p = &n[i]; + int *tmp; + + p->len = i + 1; + tmp = malloc(p->len * sizeof(int)); + p->buf = tmp; + } +} diff --git a/test/small/alloc8.c b/test/small/alloc8.c new file mode 100755 index 0000000..a9932b5 --- /dev/null +++ b/test/small/alloc8.c @@ -0,0 +1,26 @@ +#include "harness.h" + +TESTDEF baseline : success + +char * NTS NONNULL +cpy(char * NT NONNULL COUNT(sz) buff, char * NTS str, int sz) { + + int i; + for(i=0;ia; +} diff --git a/test/small/array1.c b/test/small/array1.c new file mode 100755 index 0000000..dfff41c --- /dev/null +++ b/test/small/array1.c @@ -0,0 +1,64 @@ +//KEEP baseline: success + +// +//Excercise nested struct/array offsets. +// + +#include "harness.h" + +struct bar { + int p[10][50]; +}; + +struct foo1 { + int len; + struct bar* COUNT(len) bars; +}; + +struct foo2 { + int data; + struct foo1 foo1; +}; + +void foo2_init(struct foo2 * COUNT(5) f) { + struct bar* COUNT(len) bars; + for (int i = 0; i < 5; i++) { + f[i].data =42; + bars = 0; + int len = i+1; + bars = alloc(struct bar, len); + f[i].foo1.len = len; + f[i].foo1.bars = bars; + } +} + + +int main() { + struct foo2 f[5]; + foo2_init(f); + struct foo2 * SAFE middle = &f[3]; //test addr of array element. + + struct foo2 * COUNT(2) middle1 = &f[3]; //test addr of array element. + + int i = 4; //index into f + int j = i; //index into foo1.bars + int k = 9; //first index into bar.p + int k2 = 49; //second index into bar.p + i++; //KEEP i: error + j++; //KEEP j: error + k++; //KEEP k: error + k2++; //KEEP k2: error + i = -1; //KEEP ineg: error = will always fail + j = -1; //KEEP jneg: error = will always fail + k = -1; //KEEP kneg: error = will always fail + k2 = -1;//KEEP k2neg: error = Assertion failed + + //Make sure each offset is checked correctly: + int x = f[i].foo1.bars[j].p[k][k2]; + + f[i].foo1.bars[j].p[k][k2] = x+1; //KEEP set: success + + middle->data = middle1->data; + + return 0; +} diff --git a/test/small/array2.c b/test/small/array2.c new file mode 100644 index 0000000..5ef4ff5 --- /dev/null +++ b/test/small/array2.c @@ -0,0 +1,12 @@ +// This test ensures that the appropriate substitution is applied to the +// base type of an array. + +int main() { + int * SAFE a[1]; + int * SAFE p; + + a[0] = 0; + p = a[0]; + + return 0; +} diff --git a/test/small/array3.c b/test/small/array3.c new file mode 100644 index 0000000..0b88455 --- /dev/null +++ b/test/small/array3.c @@ -0,0 +1,15 @@ +#define NDIM 3 +double distv(double * COUNT(NDIM) v) +{ + // So we could increment it + double *w = v; + return *w; +} + +int main() { + double v[NDIM] = { 1.0, 2.0, 3.0 }; + if (1.0 != distv(v)) { + return 1; + } + return 0; +} diff --git a/test/small/array4.c b/test/small/array4.c new file mode 100755 index 0000000..455b175 --- /dev/null +++ b/test/small/array4.c @@ -0,0 +1,29 @@ +#include "harness.h" + +#define E(n) { printf("Error %d\n", n); exit(n); } + +int array[8] = { 0, 1, 2, 3, 4, 5, 6, 7}; // A global array + + +// A pointer in the array +int * BND(array, array + 8) parray; // KEEP : success +int * BND(array, & array[8]) parray; // KEEP : success + +// A couple of errors +int * BND(& 1, 0) parray; // KEEP : error = Address-of used on a non-lvalue +int * BND(array[0][0], 0) parray; // KEEP : error = Index used on a non-array + + +int main() { + parray = & array[5]; + + // Access the start and the end of the array + if(parray[-5] != 0) E(1); + if(parray[2] != 7) E(2); + + parray ++; + + if(* parray != 6) E(3); + + return 0; +} diff --git a/test/small/array5.c b/test/small/array5.c new file mode 100755 index 0000000..38c6298 --- /dev/null +++ b/test/small/array5.c @@ -0,0 +1,14 @@ +typedef struct +{ + char data[1]; +} cc1000_header_t; + +char array[10]; + +int main(void) +{ + char * p = &array[5]; + //sizeof is unsigned, so CIL treats this as p += 4294967295 + p = p - sizeof(cc1000_header_t); + return *p; +} diff --git a/test/small/array6.c b/test/small/array6.c new file mode 100644 index 0000000..29d781f --- /dev/null +++ b/test/small/array6.c @@ -0,0 +1,19 @@ +#include "harness.h" + +#include "harness.h" + +int array[8] = { 0, 1, 2, 3, 4, 5, 6, 7}; // A global array + + +// Make sure we give good error messages for assignments that will always fail. +int * COUNT(8) parray; // KEEP : success +int * COUNT(9) parray; // KEEP : error = array + 9 <= array + 8 + + +int main() { + parray = array; + + if(parray[6] != 6) E(3); + + return 0; +} diff --git a/test/small/array7.c b/test/small/array7.c new file mode 100644 index 0000000..06592f1 --- /dev/null +++ b/test/small/array7.c @@ -0,0 +1,11 @@ +// Make sure we use bounds in array parameters to functions. + +int foo(int a[4]) { + return a[3]; +} + +int main() { + int a[4]; + a[3] = 0; + return foo(a); +} diff --git a/test/small/auto1.c b/test/small/auto1.c new file mode 100755 index 0000000..813d03d --- /dev/null +++ b/test/small/auto1.c @@ -0,0 +1,68 @@ + +#include "harness.h" + +#define EFAT BND(__this, __auto) +#define FAT BND(__auto, __auto) + +int a[] = { 0, 1, 2, 3}; + +int * FAT g; + +int * EFAT gf; + +int main() { + int * EFAT pf; + // Test assignment split to split + pf = & a[2]; + + if(pf[0] != 2) E(1); + if(pf[1] != 3) E(2); + pf[-1] = 0; // KEEP low1 : error = will always fail + pf[2] = 0; // KEEP high1 : error = access check + + + // Test assignment split to fat + g = &a[2]; + + if(g[-2] != 0) E(11); + if(g[1] != 3) E(12); + g[-3] = 0; // KEEP low2 : error = lower bound + g[2] = 0; // KEEP high2 : error = Assertion failed + + // Test assignment fat to split, from FAT to FSEQ + pf = g; + + if(pf[0] != 2) E(21); + if(pf[1] != 3) E(22); + pf[-1] = 0; // KEEP low3 : error = will always fail + pf[2] = 0; // KEEP high3 : error = Assertion failed + + + // Test assignment split to fat, from EFAT to SEQ + g = pf; + + if(g[0] != 2) E(31); + if(g[1] != 3) E(32); + g[-1] = 0; // KEEP low4 : error = lower bound + g[2] = 0; // KEEP high4 : error = Assertion failed + + // Test assignment fat to fat, from FAT to FSEQ + gf = g; + + if(gf[0] != 2) E(41); + if(gf[1] != 3) E(42); + gf[-1] = 0; // KEEP low5 : error = will always fail + gf[2] = 0; // KEEP high5 : error = Assertion failed + + + // Test assignment fat to fat, from EFAT to SEQ + g = gf; + + if(g[0] != 2) E(51); + if(g[1] != 3) E(52); + g[-1] = 0; // KEEP low6 : error = lower bound + g[2] = 0; // KEEP high6 : error = Assertion failed + + + return 0; +} diff --git a/test/small/auto2.c b/test/small/auto2.c new file mode 100755 index 0000000..78a6e37 --- /dev/null +++ b/test/small/auto2.c @@ -0,0 +1,58 @@ + +#include "harness.h" + +#define EFAT BND(__this, __auto) +#define FAT BND(__auto, __auto) + +int a[] = { 0, 1, 2, 3}; + +int * FAT g; + +struct fat { + int * FAT s; + int * EFAT f; + int * FAT as[4]; +} gstruct; + +int main() { + int * EFAT * pf; + + struct fat * EFAT ps; + + // Test assignment to struct + gstruct.s = & a[2]; + + if(gstruct.s[-2] != 0) E(1); + if(gstruct.s[1] != 3) E(2); + gstruct.s[-3] = 0; // KEEP low1 : error = Assertion failed + gstruct.s[2] = 0; // KEEP high1 : error = Assertion failed + + gstruct.f = gstruct.s; + + pf = & gstruct.f; + + if((*pf)[0] != 2) E(11); + if((*pf)[1] != 3) E(12); + (*pf)[-1] = 0; // KEEP low2 : error = will always fail + (*pf)[2] = 0; // KEEP high2 : error = Assertion failed + + gstruct.as[2] = * pf; + + if(gstruct.as[2][0] != 2) E(21); + if(gstruct.as[2][1] != 3) E(22); + gstruct.as[2][-1] = 0; // KEEP low3 : error = Assertion failed + gstruct.as[2][2] = 0; // KEEP high3 : error = Assertion failed + + { + int * EFAT p = & a[2]; + + pf = & p; + + if((*pf)[0] != 2) E(31); + if((*pf)[1] != 3) E(32); + (*pf)[-1] = 0; // KEEP low4 : error = will always fail + (*pf)[2] = 0; // KEEP high4 : error = Assertion failed + } + + return 0; +} diff --git a/test/small/auto3.c b/test/small/auto3.c new file mode 100755 index 0000000..199aa92 --- /dev/null +++ b/test/small/auto3.c @@ -0,0 +1,66 @@ + +#include "harness.h" + +#define EFAT BND(__this, __auto) +#define FAT BND(__auto, __auto) + +TESTDEF baseline : success + +int a[] = { 0, 1, 2, 3}; + +int * FAT g; + +struct fat { + int * FAT s; + int * EFAT f; + int * FAT as[4]; +} gstruct; + +// A function that returns a fat +int * FAT ret_fat() { + return &a[2]; +} + +// A function that returns a split +int * BND(__this, __this + 2) ret_split() { + return &a[2]; +} + +int main() { + + int * p; + + // Return from fat to split + p = ret_fat(); + + if(p[-2] != 0) E(1); + if(p[1] != 3) E(2); + p[-3] = 0; // KEEP low1 : error = lower bound + p[2] = 0; // KEEP high1 : error = Assertion failed + + // Return from fat to fat + g = ret_fat(); + + if(g[-2] != 0) E(11); + if(g[1] != 3) E(12); + g[-3] = 0; // KEEP low2 : error = lower bound + g[2] = 0; // KEEP high2 : error = Assertion failed + + // Return from split to fat + p = ret_split(); + + if(p[0] != 2) E(21); + if(p[1] != 3) E(22); + p[-1] = 0; // KEEP low3 : error = will always fail + p[2] = 0; // KEEP high3 : error = will always fail + + // Return from split to fat + g = ret_split(); + + if(g[0] != 2) E(31); + if(g[1] != 3) E(32); + g[-1] = 0; // KEEP low4 : error = lower bound + g[2] = 0; // KEEP high4 : error = Assertion failed + + return 0; +} diff --git a/test/small/auto4.c b/test/small/auto4.c new file mode 100644 index 0000000..be1f5f2 --- /dev/null +++ b/test/small/auto4.c @@ -0,0 +1,12 @@ +// KEEP baseline: success + +void foo(char * FAT * SAFE p) { +} + +int main() { + char * FAT p; + char * COUNT(0) q; + + foo(&p); + foo(&q); // KEEP e1: error = nice error message +} diff --git a/test/small/auto5.c b/test/small/auto5.c new file mode 100755 index 0000000..502ea12 --- /dev/null +++ b/test/small/auto5.c @@ -0,0 +1,22 @@ + + +#include "harness.h" + +#define EFAT BND(__this, __auto) + +char (NT str)[] = "test"; + +char * EFAT NT gnt; // Try to conflate a NT with a non NT + +char array[] = { 0, 1, 2, 3 }; + +char * EFAT g; + +int main() { + + gnt = str; + + g = array; // This will generate a cast from NT to ordinary pointer + + return 0; +} diff --git a/test/small/auto6.c b/test/small/auto6.c new file mode 100755 index 0000000..eccf210 --- /dev/null +++ b/test/small/auto6.c @@ -0,0 +1,45 @@ + +#include "harness.h" + +#define EFAT BND(__this, __auto) +#define FAT BND(__auto, __auto) + +// Test initializers for auto +int a[] = { 0, 1, 2, 3}; + +int * EFAT gf = & a[2]; + +struct fat { + int * FAT g; + int * FAT ga[2]; +} gstruct = { & a[2], & a[1], & a[2] }; + + +int main() { + + if(gf[0] != 2) E(1); + if(gf[1] != 3) E(2); + gf[-1] = 0; // KEEP low1 : error = will always fail + gf[2] = 0; // KEEP high1 : error = Assertion failed + + + if(gstruct.g[-2] != 0) E(11); + if(gstruct.g[1] != 3) E(12); + gstruct.g[-3] = 0; // KEEP low2 : error = lower bound + gstruct.g[2] = 0; // KEEP high2 : error = Assertion failed + + + if(gstruct.ga[0][-1] != 0) E(21); + if(gstruct.ga[0][2] != 3) E(22); + gstruct.ga[0][-2] = 0; // KEEP low3 : error = lower bound + gstruct.ga[0][3] = 0; // KEEP high3 : error = Assertion failed + + + if(gstruct.ga[1][-2] != 0) E(31); + if(gstruct.ga[1][1] != 3) E(32); + gstruct.ga[1][-3] = 0; // KEEP low4 : error = lower bound + gstruct.ga[1][2] = 0; // KEEP high4 : error = Assertion failed + + + return 0; +} diff --git a/test/small/auto7.c b/test/small/auto7.c new file mode 100644 index 0000000..972e51d --- /dev/null +++ b/test/small/auto7.c @@ -0,0 +1,15 @@ +// Misc tests for proper auto behavior. + +struct foo { + int f; +}; + +int main() { + int * SAFE p; + struct foo f; + // Make sure we don't add new variables inside sizeof. + int n = sizeof(*((int * FAT)p)); + // Also make sure we handle auto bounds properly inside addrof. + int m = &((struct foo * SAFE) TC(&f))->f; + return 0; +} diff --git a/test/small/auto8.c b/test/small/auto8.c new file mode 100644 index 0000000..679c67e --- /dev/null +++ b/test/small/auto8.c @@ -0,0 +1,5 @@ +static char * NT BND(__this, __auto) yy_c_buf_p = (char * NTS) 0; + +int main() { + return (int) yy_c_buf_p; +} diff --git a/test/small/auto9.c b/test/small/auto9.c new file mode 100644 index 0000000..2c475b6 --- /dev/null +++ b/test/small/auto9.c @@ -0,0 +1,24 @@ +#include "harness.h" + +void foo (int n) +{ + int *FAT *COUNT(n) ar; + int i,j; + + ar = malloc (n * sizeof(int * FAT)); + + for(i = 0; i < n; i++) + ar[i] = (int * FAT)malloc(n * sizeof(int)); + + for (i=0; if_p++; +} diff --git a/test/small/builtin1.c b/test/small/builtin1.c new file mode 100644 index 0000000..40d69f0 --- /dev/null +++ b/test/small/builtin1.c @@ -0,0 +1,4 @@ +int main() { + void * SNT p = __builtin_return_address(0); + return 0; +} diff --git a/test/small/call1.c b/test/small/call1.c new file mode 100644 index 0000000..bc241fe --- /dev/null +++ b/test/small/call1.c @@ -0,0 +1,10 @@ +void bar(int * COUNT(m) q, int m) { +} + +void foo(int * COUNT(n) p, int n) { + bar(p, n); +} +int main() { + foo(0,10); + return 0; +} diff --git a/test/small/call2.c b/test/small/call2.c new file mode 100644 index 0000000..721fb87 --- /dev/null +++ b/test/small/call2.c @@ -0,0 +1,13 @@ +#include "harness.h" + +void bar(int * SAFE q) { +} + +void foo(int * SAFE p) { + bar(p); +} +int main() { + int * SAFE p = alloc(int, 1); + foo(p); + return 0; +} diff --git a/test/small/call3.c b/test/small/call3.c new file mode 100644 index 0000000..e3708c1 --- /dev/null +++ b/test/small/call3.c @@ -0,0 +1,14 @@ +#include "harness.h" + +void bar(int * SAFE q) { +} + +void foo(int * COUNT(n) p, int n) { + bar(p + 1); +} +int main() { + int len = 42; + int * COUNT(len) p = alloc(int, len); + foo(p, len); + return 0; +} diff --git a/test/small/call4.c b/test/small/call4.c new file mode 100644 index 0000000..5a8d2ee --- /dev/null +++ b/test/small/call4.c @@ -0,0 +1,14 @@ +#include "harness.h" + +void bar(int * BND(b,e) q, int * BND(b,b) b, int * BND(e,e) e) { +} + +void foo(int * COUNT(n) p, int n) { + bar(p + 5, p, p + n); +} + +int main() { + int * COUNT(20) p = alloc(int, 20); + foo(p, 20); + return 0; +} diff --git a/test/small/call5.c b/test/small/call5.c new file mode 100755 index 0000000..d89aa0b --- /dev/null +++ b/test/small/call5.c @@ -0,0 +1,11 @@ +#include "harness.h" + +int* COUNT(2) bar(int * COUNT(3) q) { + return q; +} + +int main() { + int * COUNT(4) p = alloc(int, 5); + int* SAFE q = bar(p); + return *q; +} diff --git a/test/small/call6.c b/test/small/call6.c new file mode 100755 index 0000000..9cc7cd2 --- /dev/null +++ b/test/small/call6.c @@ -0,0 +1,29 @@ +// KEEP baseline: success + +int id(int n) { + return n; +} + +struct foo { + int * COUNT(len) data; + int len; +}; + +void * (DALLOC(sz) allocate)(int sz) { + return 0; +} + +int main() { + int a[5]; + struct foo f; + + f.data = 0; + f.len = id(5); + f.data = a; + f.len = id(3); + f.len = id(10); // KEEP err1: error = Assertion + + f.data = 0; f.data = (int *)allocate(f.len * sizeof(int)); // KEEP err2 : success + + return 0; +} diff --git a/test/small/call7.c b/test/small/call7.c new file mode 100644 index 0000000..6de93f8 --- /dev/null +++ b/test/small/call7.c @@ -0,0 +1,15 @@ +// Makes sure that & works properly with arguments that the return type +// depends upon. + +int *BND(__this, rlen) foo(int *cmd, int *rlen) { + return 0; +} + +int main() { + int rcmd; + int rlen; + int *SAFE response; + response = foo(&rcmd, &rlen); // KEEP t1: success + response = foo(0, &rlen); // KEEP t2: success + return 0; +} diff --git a/test/small/call8.c b/test/small/call8.c new file mode 100644 index 0000000..9a7e3f0 --- /dev/null +++ b/test/small/call8.c @@ -0,0 +1,10 @@ +int *COUNT(n) foo(int n) { + return 0; +} + +int main() { + int i = 42; + foo(i); // KEEP t1: success + foo(&i); // KEEP e1: error + return 0; +} diff --git a/test/small/cast1.c b/test/small/cast1.c new file mode 100644 index 0000000..f446212 --- /dev/null +++ b/test/small/cast1.c @@ -0,0 +1,8 @@ +struct foo { + int * SAFE f; +}; + +int main() { + int i = (int) &((struct foo * SAFE) 0)->f; + return 0; +} diff --git a/test/small/cast10.c b/test/small/cast10.c new file mode 100644 index 0000000..2bb48e1 --- /dev/null +++ b/test/small/cast10.c @@ -0,0 +1,19 @@ +// zf: this is from similar code in isofs/rock.c + +struct S { + char * COUNT(len1) s1; + char * COUNT(len2) s2; + unsigned char * COUNT(len3) s3; + int len1; + int len2; + int len3; +}; + +int main() { + struct S s; + // This works. + s.s1 = s.s2; + // This should also work but doesn't + s.s3 = s.s1; + return 0; +} diff --git a/test/small/cast11.c b/test/small/cast11.c new file mode 100644 index 0000000..698432e --- /dev/null +++ b/test/small/cast11.c @@ -0,0 +1,12 @@ +struct foo { + int a; + int b; +}; + +int main() { + struct foo st; + char * s1 = &st; + char * COUNT(8) s2 = s1; + + return 0; +} diff --git a/test/small/cast12.c b/test/small/cast12.c new file mode 100755 index 0000000..98329cf --- /dev/null +++ b/test/small/cast12.c @@ -0,0 +1,9 @@ +int foo(double d1, double d2) { + if(d1 == d2) return 1; + return 0; +} + +int main() { + return foo(5.0, 4.0); +} + diff --git a/test/small/cast13.c b/test/small/cast13.c new file mode 100755 index 0000000..28880e3 --- /dev/null +++ b/test/small/cast13.c @@ -0,0 +1,12 @@ +#include "harness.h" + +typedef int * intptr; + +void * (DALLOC(sz) allocate)(int sz) { + return malloc(sz); +} + +int main() { + intptr p = (intptr) allocate(4 * sizeof(int)); + return 0; +} diff --git a/test/small/cast14.c b/test/small/cast14.c new file mode 100755 index 0000000..85a6dcd --- /dev/null +++ b/test/small/cast14.c @@ -0,0 +1,9 @@ + +int main() { + int x = 3; + + // Cast from int to double + double c = x * 3.14; + + return 0; +} diff --git a/test/small/cast15.c b/test/small/cast15.c new file mode 100755 index 0000000..0fbceaf --- /dev/null +++ b/test/small/cast15.c @@ -0,0 +1,21 @@ + +// Physical subtyping + +struct host { + struct child { + struct nephew { + int data; + } n; + int * data1; + } c; + int * data2; +} x; + +int main() { + struct child * c = (struct child*) &x; + struct newphew * n = (struct nephew*) &x; + + if(c != n || c != &x) return 1; + + return 0; +} diff --git a/test/small/cast16.c b/test/small/cast16.c new file mode 100755 index 0000000..a9d8d18 --- /dev/null +++ b/test/small/cast16.c @@ -0,0 +1,20 @@ + +struct foo { + char * COUNT(len) buf; + int len; +}; + +TESTDEF default : success + +int main() { + struct foo f; + int n; + char * COUNT(n) p = 0; + + // If we do not use n, then it gets eliminated !!! + n = 2; // KEEP : success + + f.buf = p; + + return 0; +} diff --git a/test/small/cast17.c b/test/small/cast17.c new file mode 100644 index 0000000..ea6969a --- /dev/null +++ b/test/small/cast17.c @@ -0,0 +1,8 @@ +void foo(void * COUNT(n) buf, int n) { +} + +int main() { + int a; + foo(&a, sizeof(int)); + return 0; +} diff --git a/test/small/cast18.c b/test/small/cast18.c new file mode 100755 index 0000000..ad82ce1 --- /dev/null +++ b/test/small/cast18.c @@ -0,0 +1,38 @@ +#include "harness.h" + +typedef struct { + struct { + int * subp; + } stuff; +} cell, * cellptr; + + +int i = 345; +cell c = { { &i } }; + + +int main() { +IFTEST safe : success + { + cellptr q = &c; + int * SAFE p = TC(q->stuff.subp); + + if(*p != 345) E(1); + } +ENDIF + +IFTEST array : success + { + int array[10] = { 0, 1, 2, 3, 4, 5, 6, 7, 8, 9}; + + // Are the bounds properly propagated ? + int * FAT p = TC(&array[5]); + + if(*(p - 5) != 0) E(2); + + if(*(p + 4) != 9) E(3); + + } +ENDIF + return 0; +} diff --git a/test/small/cast19.c b/test/small/cast19.c new file mode 100644 index 0000000..3c94183 --- /dev/null +++ b/test/small/cast19.c @@ -0,0 +1,14 @@ +// We need a nice error message when casting from pointer to struct +// (accidentally or not). + +// KEEP t: error = illegal cast + +struct s { + int n; +}; + +int main() { + unsigned long tmp = (struct s) (void *) 0; + + return 0; +} diff --git a/test/small/cast2.c b/test/small/cast2.c new file mode 100644 index 0000000..e24f9d5 --- /dev/null +++ b/test/small/cast2.c @@ -0,0 +1,7 @@ +int main() { + int a[2]; + int * SAFE p = a; + int * q = (int * SAFE)((char * TRUSTED) p + 4); + int * SAFE r = q; + return 0; +} diff --git a/test/small/cast20.c b/test/small/cast20.c new file mode 100755 index 0000000..6579441 --- /dev/null +++ b/test/small/cast20.c @@ -0,0 +1,17 @@ +#include "harness.h" + + +int foo(unsigned long px) { + * (int * SAFE)(void * TRUSTED)px += 1; +} + +int main() { + int x = 2; + + foo(& x); + + if(x != 3) E(1); + + return 0; +} + diff --git a/test/small/cast3.c b/test/small/cast3.c new file mode 100644 index 0000000..40cadbc --- /dev/null +++ b/test/small/cast3.c @@ -0,0 +1,8 @@ +#include "harness.h" + +int main() { + int * COUNT(4) p = alloc(int, 4); + int * COUNT(2) q = p + 1; + int * SAFE r = (int * SAFE) (int * BND(q, q + 2)) (p + 2); + return 0; +} diff --git a/test/small/cast4.c b/test/small/cast4.c new file mode 100644 index 0000000..910aa5c --- /dev/null +++ b/test/small/cast4.c @@ -0,0 +1,17 @@ +// KEEP baseline: success + +#include "harness.h" + +int main() { + int * COUNT(10) pi; + int * COUNT(5) pj; + char * COUNT(20) pc; + + pi = alloc(int, 10); + pc = (char * COUNT(20)) pi; + pj = (int * COUNT(5)) pc; + pi = (int * COUNT(5)) pc; // KEEP size1: error = Assertion + pi = (int * COUNT(10)) pc; // KEEP size2: error = Assertion + + return 0; +} diff --git a/test/small/cast5.c b/test/small/cast5.c new file mode 100644 index 0000000..811a92d --- /dev/null +++ b/test/small/cast5.c @@ -0,0 +1,6 @@ +// KEEP baseline: success + +int main() { + int * COUNT(10) p = (void*) 0; + return 0; +} diff --git a/test/small/cast6.c b/test/small/cast6.c new file mode 100644 index 0000000..656e9d9 --- /dev/null +++ b/test/small/cast6.c @@ -0,0 +1,26 @@ +// This check ensures that bad casts from void* to some larger type are +// caught at compile time instead of run time. + +// KEEP baseline: success + +int main() { + int i; + + int * SAFE p1; + int * SAFE p2; + + void * SAFE q1; + void * q2; + + p1 = &i; + q1 = TC(p1); + q2 = q1; + + p2 = TC(q1); + p2 = TC(q2); + + p2 = q1; // KEEP size1: error = will always fail + p2 = q2; // KEEP size2: error = will always fail + + return 0; +} diff --git a/test/small/cast7.c b/test/small/cast7.c new file mode 100644 index 0000000..bf689c4 --- /dev/null +++ b/test/small/cast7.c @@ -0,0 +1,17 @@ +// This check ensures that bad casts from void* to some larger type are +// caught at compile time instead of run time. + +// KEEP baseline: success + +int main() { + int i; + int * SAFE p1; + int * SAFE p2; + void * SAFE q; + + p1 = &i; + q = TC(p1); + p2 = q; // KEEP size1: error = will always fail + + return 0; +} diff --git a/test/small/cast8.c b/test/small/cast8.c new file mode 100644 index 0000000..0e0fe5d --- /dev/null +++ b/test/small/cast8.c @@ -0,0 +1,18 @@ +// This test makes sure that we can cast between pointers to signed and +// unsigned data. + +int main() { + char * SAFE pc; + unsigned char * SAFE qc; + + int * SAFE pi; + unsigned int * SAFE qi; + + pc = 0; + qc = pc; + + pi = 0; + qi = pi; + + return 0; +} diff --git a/test/small/cast9.c b/test/small/cast9.c new file mode 100644 index 0000000..054ec6a --- /dev/null +++ b/test/small/cast9.c @@ -0,0 +1,21 @@ +struct foo { + int * SAFE p; // KEEP baseline: success + int * SAFE p; // KEEP cast1: error = Type mismatch + int a; + int b; +}; + +struct foo f; + +void * SAFE get() { + f.a = 5; + return TC(&f); +} + +int main() { + struct foo * SAFE p = TC(get()); // KEEP baseline + struct foo *p = get(); // KEEP cast1 + struct foo *p = get(); // KEEP cast2: error = Assertion + struct foo * SAFE p = get(); // KEEP cast3: error = Assertion + return p->a != 5; +} diff --git a/test/small/deref1.c b/test/small/deref1.c new file mode 100644 index 0000000..054a255 --- /dev/null +++ b/test/small/deref1.c @@ -0,0 +1,9 @@ +#include "harness.h" + +int main() { + int * SAFE p = alloc(int, 1); + int i; + i = *p; + + return 0; +} diff --git a/test/small/deref2.c b/test/small/deref2.c new file mode 100644 index 0000000..022a03c --- /dev/null +++ b/test/small/deref2.c @@ -0,0 +1,10 @@ +#include "harness.h" + +int main() { + int * COUNT(10) p; + int * SAFE * SAFE q; + p = alloc(int, 10); + q = alloc(int * SAFE, 1); + *q = p; + return 0; +} diff --git a/test/small/deref3.c b/test/small/deref3.c new file mode 100644 index 0000000..f6cbe1a --- /dev/null +++ b/test/small/deref3.c @@ -0,0 +1,21 @@ +// Here's a random attempt to circumvent Deputy's type system. It is +// prevented by the substitution Deputy uses during an assignment. + +// KEEP baseline: error = Assertion failed in upper bound check + +int main() { + int * BND(b, e) b; + int * SNT e; + + int j; + char * SAFE p = &j; + int i; + + e = &i; + b = &j; // This assignment should fail. + b[1] = 0xdeadbeef; + + *p = 0; + + return 0; +} diff --git a/test/small/enum1.c b/test/small/enum1.c new file mode 100644 index 0000000..f66a181 --- /dev/null +++ b/test/small/enum1.c @@ -0,0 +1,10 @@ +enum foo { + FOO = 1 +}; + +int main() { + int a[2]; + enum foo e = FOO; + a[1] = 0; + return a[e]; +} diff --git a/test/small/extern1.c b/test/small/extern1.c new file mode 100644 index 0000000..b1136b3 --- /dev/null +++ b/test/small/extern1.c @@ -0,0 +1,12 @@ +extern char extern1buf[]; // KEEP t1: error = extern1buf needs a length +extern char (NT extern1buf)[]; // KEEP t2: error = extern1buf needs a length +extern char (NTS extern1buf)[]; // KEEP t3: success +extern char (NT COUNT(3) extern1buf)[]; // KEEP t4: success + +int main() { + extern char (NTS extern1buf)[]; // KEEP t5: success + if (extern1buf[3] != 0) return -1; + extern1buf[2] = 'z'; + extern1buf[3] = 0; + return 0; +} diff --git a/test/small/extern2.c b/test/small/extern2.c new file mode 100755 index 0000000..98fcb51 --- /dev/null +++ b/test/small/extern2.c @@ -0,0 +1,13 @@ +TESTDEF baseline: success + +//Test that CIL does not delete extern globals that are only used in +//annotations. + +extern char * COUNT(extern_count) extern_p; +extern int extern_count; + +int main() { + extern_p++; //KEEP incr: error = will always fail + extern_p[2] = 0; + return extern_p[3]; +} diff --git a/test/small/extern3.c b/test/small/extern3.c new file mode 100644 index 0000000..c20847b --- /dev/null +++ b/test/small/extern3.c @@ -0,0 +1,5 @@ +extern char (COUNT(4) extern1buf)[]; + +int main() { + return (extern1buf[1] == 'a'); +} diff --git a/test/small/extinline1.c b/test/small/extinline1.c new file mode 100755 index 0000000..8fdc0d4 --- /dev/null +++ b/test/small/extinline1.c @@ -0,0 +1,15 @@ +TESTDEF noext : success + +// We want this annotation to be merged with the extern inline +extern int myfoo(char * NTS str); + +IFTEST ext : success +extern inline +ENDIF +char myfoo(char * str) { + return str[0]; +} + +int main() { + return ('A' != myfoo("A string")) ? 1 : 0; +} diff --git a/test/small/field1.c b/test/small/field1.c new file mode 100644 index 0000000..8f8fe8b --- /dev/null +++ b/test/small/field1.c @@ -0,0 +1,17 @@ +#include "harness.h" + +struct bar { + int * SAFE p; +}; + +void foo(struct bar * SAFE b) { + int i; + i = *b->p; +} + +int main() { + struct bar * SAFE b = alloc(struct bar, 1); + b->p = alloc(int, 1); + foo(b); + return 0; +} diff --git a/test/small/field2.c b/test/small/field2.c new file mode 100644 index 0000000..020baaf --- /dev/null +++ b/test/small/field2.c @@ -0,0 +1,18 @@ +// KEEP baseline: success + +#include "harness.h" + +struct bar { + int * SAFE p; +}; + +void foo(struct bar * SAFE b) { + b->p = b->p + 1; // KEEP size1: error = will always fail +} + +int main() { + struct bar * SAFE b = alloc(struct bar, 1); + b->p = alloc(int, 1); + foo(b); + return 0; +} diff --git a/test/small/field3.c b/test/small/field3.c new file mode 100644 index 0000000..a0863cf --- /dev/null +++ b/test/small/field3.c @@ -0,0 +1,18 @@ +// KEEP baseline: success + +#include "harness.h" + +struct bar { + int * COUNT(2) p; +}; + +void foo(struct bar * SAFE b) { + b->p = b->p + 1; // KEEP size1: error = will always fail +} + +int main() { + struct bar * SAFE b = alloc(struct bar, 1); + b->p = alloc(int, 2); + foo(b); + return 0; +} diff --git a/test/small/field4.c b/test/small/field4.c new file mode 100755 index 0000000..7808bf9 --- /dev/null +++ b/test/small/field4.c @@ -0,0 +1,57 @@ +//KEEP baseline: success + +// +//Excercise nested struct offsets. +// + +#include "harness.h" + +struct bar { + int n; + int * COUNT(n) p; +}; + +struct foo1 { + int len; + struct bar* COUNT(len) bars; +}; + +struct foo2 { + int data; + struct foo1 foo1; +}; + +struct foo2 * COUNT(5) foo2_init() { + struct foo2 * COUNT(5) f = alloc(struct foo2, 5); + struct bar* COUNT(len) bars; + for (int i = 0; i < 5; i++) { + f[i].data =42; + bars = 0; + int len = i+1; + bars = alloc(struct bar, len); + for (int j = 0; j < len; j++){ + int len2 = 10; + bars[j].n = len2; + bars[j].p = alloc(int, len2); + } + f[i].foo1.len = len; + f[i].foo1.bars = bars; + } + return f; +} + + +int main() { + struct foo2 * COUNT(5) f = foo2_init(); + int i = 4; //index into f + int j = i; //index into bars + int k = 9; //index into p + i++; //KEEP i: error + i= -1; //KEEP ineg: error + j++; //KEEP j: error + k++; //KEEP k: error + + //Make sure each offset is checked correctly: + int x = f[i].foo1.bars[j].p[k]; + return 0; +} diff --git a/test/small/field5.c b/test/small/field5.c new file mode 100644 index 0000000..a19ba6d --- /dev/null +++ b/test/small/field5.c @@ -0,0 +1,18 @@ +// Test automatic bounds for fields. +// KEEP baseline: success + +struct foo { + int * BND(__auto, __auto) p; +}; + +int main() { + struct foo f; + int a[10]; + + f.p = a; + + f.p[0] = 42; + f.p[9] = 42; + + return 0; +} diff --git a/test/small/func1.c b/test/small/func1.c new file mode 100755 index 0000000..d9f7c2b --- /dev/null +++ b/test/small/func1.c @@ -0,0 +1,14 @@ + +int foo(int * COUNT(n), int n); + +// Now change the name of the variables. We must handle this gracefully. +int foo(int * COUNT(m) p, int m) { + p[2] = 1; +} + + +int main() { + int buff[8]; + foo(buff, 8); + return 0; +} diff --git a/test/small/func2.c b/test/small/func2.c new file mode 100755 index 0000000..2f76e13 --- /dev/null +++ b/test/small/func2.c @@ -0,0 +1,51 @@ + +#include "harness.h" + +// Test dependencies of return on the function arguments +TESTDEF baseline : success + +int * COUNT(n) gettable(int n, int * SAFE pn) { + int * res; + + (*pn)--; + + // Make sure that we use the original value of n for the return + n --; // KEEP : error = upper bound coercion + + res = (int *)malloc(n * sizeof(int)); + + res ++; // KEEP : error = upper bound coercion + + return res; +} + + +int main() { + int n; + int * SAFE pn = &n; + + int * + COUNT(8) // KEEP : success + p; + + p = gettable(8, pn); + + // Try to access the memory + p[0] = 0; + p[7] = 7; + + // Access past the array + p[8] = 8; // KEEP : error = will always fail + + // Now make sure that we use the value of the argument when the function + // is called (not when it returns) in the bounds. + *pn = 8; + p = gettable(*pn, pn); + + p[0] = 0; + p[7] = 7; + + p[8] = 8; // KEEP : error = pointer access check + + return 0; +} diff --git a/test/small/func3.c b/test/small/func3.c new file mode 100755 index 0000000..3714d0a --- /dev/null +++ b/test/small/func3.c @@ -0,0 +1,50 @@ + +#include "harness.h" + + +int carray; // Count of elements +int * COUNT(8) array; + +TESTDEF baseline : success + +int side(int incr) { + carray += incr; + return carray; +} + +// Allow a function to refer to global variables +void access_array(int * BND(__this - off, __this - off + carray) parray, + int off, int extra) { + if(parray[-off] != 0) E(1); + + // Try to decrease the global carray. + side(-5); // KEEP side1 : success + + // We should be allowed to access 8 elements + if(parray[7-off] != 8) E(2); + + // Try to increase carray + side(2);if(parray[-off+carray] != carray) E(2); // KEEP side2 : error = Blah + + +} + +int main() { + int i; + + carray = 8; + array = (int*)malloc(carray * sizeof(*array)); + for(i=0;ip; + int * qx = b->q; + int i; + for (i = 0; i < b->len; i++) { + *qx++ = *px; + } +} + +int main() { + int i; + int a[10]; + + bar b; + b.len = 10; + b.q = a; + b.p = &i; + + foo(&b); + + return 0; +} diff --git a/test/small/infer5.c b/test/small/infer5.c new file mode 100644 index 0000000..ef56cc1 --- /dev/null +++ b/test/small/infer5.c @@ -0,0 +1,12 @@ +#include "harness.h" + +int * SAFE foo(int * SAFE p) { + return p; +} + +int main() { + int * SAFE p = alloc(int, 1); + int * q = foo(p); + *q = 0; + return 0; +} diff --git a/test/small/infer6.c b/test/small/infer6.c new file mode 100644 index 0000000..04c4c74 --- /dev/null +++ b/test/small/infer6.c @@ -0,0 +1,12 @@ +// This is a test where we set the upper bound of q to be p+1, even though +// p = 0. This requires special handling of sentinels. + +int main() { + int * SAFE p; + int * q; + + p = 0; + q = p; + + return 0; +} diff --git a/test/small/infer7.c b/test/small/infer7.c new file mode 100644 index 0000000..fe4e9f0 --- /dev/null +++ b/test/small/infer7.c @@ -0,0 +1,20 @@ +// This test checks for a bug where the second assignment to a variable +// with inferred bounds is checked against the previous bounds, and thus +// fails the check. + +int main() { + int i1; + int i2; + + int * SAFE p1; + int * SAFE p2; + int * q; + + p1 = &i1; + p2 = &i2; + + q = p1; + q = p2; + + return 0; +} diff --git a/test/small/infer8.c b/test/small/infer8.c new file mode 100644 index 0000000..030ddf3 --- /dev/null +++ b/test/small/infer8.c @@ -0,0 +1,17 @@ +struct foo { + int a; + int b; +}; + +int main() { + struct foo f; + int * SAFE p; + struct foo * q; + struct foo * SAFE r; + + p = &f.b; + q = (struct foo * SAFE)((char * TRUSTED) p - (int) &(((struct foo *)0))->b); + r = q; + + return 0; +} diff --git a/test/small/infer9.c b/test/small/infer9.c new file mode 100644 index 0000000..626bf97 --- /dev/null +++ b/test/small/infer9.c @@ -0,0 +1,13 @@ +// This test ensures that metadata is properly set by allocators. + +#include "harness.h" + +int main() { + int * p; + int * SAFE q; + + p = alloc(int, 10); + q = p; + + return 0; +} diff --git a/test/small/init1.c b/test/small/init1.c new file mode 100755 index 0000000..d93827e --- /dev/null +++ b/test/small/init1.c @@ -0,0 +1,39 @@ + +#include "harness.h" + +// Test global initializers +TESTDEF baseline : success + + +int x, a[8]; + +int * NONNULL gnonnull = &x; + +int * EFAT px = & x; + +int * FAT px1 = 0; + +int * NONNULL g1; // KEEP nonnull : error = non-null + +int * COUNT(3) g2 = & a[4]; +int * COUNT(4) g3 = & a[5]; // KEEP ubound1 : error = will always fail +int * SAFE g4 = & a[-1]; // KEEP lbound1 : error = will always fail + +int * NT g5 = & a[3]; // KEEP nt : error = from ordinary pointer to nullterm + +// Try an array of non-null pointers without enough initializers +int * NONNULL arr1[4] = { &x, &x }; // KEEP nonnull2: error = non-null + +struct opt { + char (NT shname)[8]; + int * NTS lgname; + char pad[4]; +} options[2] = { + { { 0, 1, 2, 3, 4, 5, 6, 7} } // KEEP nt2 : error = CWriteNT + { { }, &x } // KEEP nt3 : error = from ordinary pointer to nullterm +}; + + +int main() { + return 0; +} diff --git a/test/small/init2.c b/test/small/init2.c new file mode 100755 index 0000000..dd3fabf --- /dev/null +++ b/test/small/init2.c @@ -0,0 +1,17 @@ + +#include "harness.h" + +// Test global initializers. Make sure the checks are discharged statically. +TESTDEF baseline : success + +char *NTS (NT CompileOptions)[] = +{ + "ALLOW_255", + "DNSMAP", + "EGD", + 0 +}; + +int main() { + return 0; +} diff --git a/test/small/live1.c b/test/small/live1.c new file mode 100755 index 0000000..de972b0 --- /dev/null +++ b/test/small/live1.c @@ -0,0 +1,47 @@ +#include "harness.h" + +void exit(int code) __attribute__((noreturn)); + +int global; + +TESTDEF baseline: success + +int foo(int * SAFE x) { + int *y; + + if (*x) { + return 0; //DROP ret: error = y may be used without being + } else { + y=x; + } + x = y; + return *y; +} + +int bar() { + int *x; + int z; + switch(global) { + case 0: + case 1: + x = & global; + break; + case 2: + x = malloc(*x);//KEEP arg: error = x may be used without being + //FALLTHROUGH + case 3: + z = *x; //KEEP deref: error = x may be used without being + //FALLTHROUGH + case 4: + //Sizeof is okay: + x = malloc(sizeof(*x)); + break; + + default: exit(0); //DROP default: error = x may be used without being + } + return foo(x); +} + +int main() { + return bar(); +} diff --git a/test/small/live2.c b/test/small/live2.c new file mode 100755 index 0000000..6e94e3e --- /dev/null +++ b/test/small/live2.c @@ -0,0 +1,30 @@ +#include "harness.h" + +int a[] = {0,1,2,3,4}; + +//Dependencies are tricky. If A depends on B, then an assignment to A +//is a use of B. + + +int foo() { + //test that defining q is a use of n. + int * COUNT(n) q = 0; //KEEP N: success = Warning: Variable n may be used without being defined + + //This is the same test as above, but use memset to set q = 0 + int * COUNT(n) q; //KEEP memset: success = Warning: Variable n may be used without being defined + memset(&q,0,sizeof(int*)); //KEEP memset + + //Finally, the declaration of n. + int n = 5; + return 0; +} + +int main() { + int * BND(p, p+n) q; + q = 0; //KEEP q: error = p may be used without being defined + int n = 5; + int * COUNT(n) p = a; + q = p+2; + + return *q-2; +} diff --git a/test/small/live3.c b/test/small/live3.c new file mode 100644 index 0000000..0888818 --- /dev/null +++ b/test/small/live3.c @@ -0,0 +1,16 @@ +int main() +{ + char * SNT p__b; + char * SNT p__e; + char * BND(p__b, p__e) p; + + p__b = 0; + p__e = 0; + p = 0; + + p__b = 0; + p__e = 0; + p = p; + + return 0; +} diff --git a/test/small/local1.c b/test/small/local1.c new file mode 100755 index 0000000..b79a8a4 --- /dev/null +++ b/test/small/local1.c @@ -0,0 +1,26 @@ +#include "harness.h" + +//On the second time around the loop, we get an assertion failure +// when assigning size=11, because ptr depends on size. It's unintuitive +// to have a failure on ptr before it's declared! +// I'd like to have at least better error message for this, but I don't know +// how to do that. + +// This was fixed by only considering the context to be only live +// locals, not all locals. + +//KEEP baseline: success + +int main() { + for (int i = 10; i < 15; i++) { + int size = i; + int * COUNT(size) ptr = malloc(size*sizeof(int)); + ptr[size-1] = i; + + //This workaround ought to fix the problem, but it doesn't because + // CIL introduces a temp var for ptr. We'd need to set that var + // to zero too, but we can't because it can't be named. + ptr = 0; //KEEP workaround: success + } + return 0; +} diff --git a/test/small/memcmp1.c b/test/small/memcmp1.c new file mode 100644 index 0000000..2f3c431 --- /dev/null +++ b/test/small/memcmp1.c @@ -0,0 +1,60 @@ +// This test checks out our special fancy memcmp support. +// KEEP baseline: success + +#include "harness.h" + +struct foo { + int a; + int b; +}; + +struct bar { + int a; + int *b; +}; + +int (DMEMCMP(1, 2, 3) my_memcmp)(void *dst, void *src, int sz) { + return 0; +} + +int main() { + char * COUNT(10) pc1 = alloc(char, 10); + char * COUNT(10) pc2 = alloc(char, 10); + + int * COUNT(10) pi1 = alloc(int, 10); + int * COUNT(10) pi2 = alloc(int, 10); + + struct foo * COUNT(10) pf1 = alloc(struct foo, 10); + struct foo * COUNT(10) pf2 = alloc(struct foo, 10); + + struct bar * COUNT(10) pb1 = alloc(struct bar, 10); + struct bar * COUNT(10) pb2 = alloc(struct bar, 10); + + + my_memcmp(pc1, pc2, 10); + my_memcmp(pc1, pc2, 4); + my_memcmp(pc1, pc2, 12); // KEEP len1: error = will always fail + + my_memcmp(pi1, pi2, 10 * sizeof(int)); + my_memcmp(pi1, pi2, 4 * sizeof(int)); + my_memcmp(pi1, pi2, 12 * sizeof(int)); // KEEP len2: error = will always fail + + my_memcmp(pi1, pc1, 10); + my_memcmp(pc1, pi1, 10); + + my_memcmp(pi1, pc1, 10 * sizeof(int)); // KEEP len3: error = will always fail + my_memcmp(pc1, pi1, 10 * sizeof(int)); // KEEP len4: error = will always fail + + my_memcmp(pf1, pf2, 10 * sizeof(struct foo)); + my_memcmp(pf1, pf2, 4); + my_memcmp(pf1, pf2, 12 * sizeof(struct foo)); // KEEP len5: error = will always fail + + my_memcmp(pb1, pb2, 10 * sizeof(struct bar)); + my_memcmp(pb1, pb2, 4); + my_memcmp(pb1, pb2, 12 * sizeof(struct bar)); // KEEP len5: error = will always fail + + my_memcmp(pf1, pb1, 10 * sizeof(struct bar)); + my_memcmp(pb1, pf1, 10 * sizeof(struct bar)); + + return 0; +} diff --git a/test/small/memcmp2.c b/test/small/memcmp2.c new file mode 100755 index 0000000..173167f --- /dev/null +++ b/test/small/memcmp2.c @@ -0,0 +1,36 @@ +#include "harness.h" + +int (DMEMCMP(1, 2, 3) memcmp)(void* s1, void* s2, int sz); + +//Call memcmp on NTS pointers, to make sure that we correctly expand the NT. +int three = 3; +int chars(char* NTS s, int what){ + char *wibble = NTDROP(NTEXPAND("wibble")); + char *s2 = NTDROP(NTEXPAND(s)); + // Sadly, this doesn't work because we don't allow access to the final 0: + //memcmp(s,s,4); + if(what == 0) + return memcmp(s2,s2,three); + else + return memcmp(s2,wibble,3); +} + +int six = 3*sizeof(int); +int ints(int* NTS s, int what){ + int *barbara = NTDROP(NTEXPAND(L"barbara")); + int *s2 = NTDROP(NTEXPAND(s)); + if(what == 0) + return memcmp(s2,s2,six); + else + return memcmp(s2,barbara,3*sizeof(int)); +} + +int main() { + char* foo = "foo"; + int (NT bar)[4] = {'b', 'a', 'r', 0}; + if (chars(foo, 0) != 0) E(1); + if (chars(foo, 1) >= 0) E(2); + if (ints(bar, 0) != 0) E(3); + if (ints(bar, 1) != 0) E(4); + SUCCESS +} diff --git a/test/small/memcpy1.c b/test/small/memcpy1.c new file mode 100644 index 0000000..39f0ea1 --- /dev/null +++ b/test/small/memcpy1.c @@ -0,0 +1,60 @@ +// This test checks out our special fancy memcpy support. +// KEEP baseline: success + +#include "harness.h" + +struct foo { + int a; + int b; +}; + +struct bar { + int a; + int *b; +}; + +void * (DMEMCPY(1, 2, 3) my_memcpy)(void *dst, void *src, int sz) { + return dst; +} + +int main() { + char * COUNT(10) pc1 = alloc(char, 10); + char * COUNT(10) pc2 = alloc(char, 10); + + int * COUNT(10) pi1 = alloc(int, 10); + int * COUNT(10) pi2 = alloc(int, 10); + + struct foo * COUNT(10) pf1 = alloc(struct foo, 10); + struct foo * COUNT(10) pf2 = alloc(struct foo, 10); + + struct bar * COUNT(10) pb1 = alloc(struct bar, 10); + struct bar * COUNT(10) pb2 = alloc(struct bar, 10); + + + my_memcpy(pc1, pc2, 10); + my_memcpy(pc1, pc2, 4); + my_memcpy(pc1, pc2, 12); // KEEP len1: error = will always fail + + my_memcpy(pi1, pi2, 10 * sizeof(int)); + my_memcpy(pi1, pi2, 4 * sizeof(int)); + my_memcpy(pi1, pi2, 12 * sizeof(int)); // KEEP len2: error = will always fail + + my_memcpy(pi1, pc1, 10); + my_memcpy(pc1, pi1, 10); + + my_memcpy(pi1, pc1, 10 * sizeof(int)); // KEEP len3: error = will always fail + my_memcpy(pc1, pi1, 10 * sizeof(int)); // KEEP len4: error = will always fail + + my_memcpy(pf1, pf2, 10 * sizeof(struct foo)); + my_memcpy(pf1, pf2, 4); + my_memcpy(pf1, pf2, 12 * sizeof(struct foo)); // KEEP len5: error = will always fail + + my_memcpy(pb1, pb2, 10 * sizeof(struct bar)); + my_memcpy(pb1, pb2, 4); // KEEP partial1: error = Assertion + my_memcpy(pb1, pb2, 12 * sizeof(struct bar)); // KEEP len5: error = will always fail + + my_memcpy(pf1, pb1, 10 * sizeof(struct bar)); + my_memcpy(pb1, pf1, 10 * sizeof(struct bar)); // KEEP type1: error = different base types + + return 0; +} diff --git a/test/small/memcpy2.c b/test/small/memcpy2.c new file mode 100644 index 0000000..3a5ee06 --- /dev/null +++ b/test/small/memcpy2.c @@ -0,0 +1,17 @@ +// Test inference with casts and memcpy. + +struct foo { + char a, b, c, d; +}; + +void * (DMEMCPY(1, 2, 3) my_memcpy)(void *dst, void *src, int sz) { + return dst; +} + +int main() { + struct foo foo; + char p[4]; + // The following cast should *not* be inferred safe! + my_memcpy((char*)&foo, p, sizeof(foo)); + return 0; +} diff --git a/test/small/memset1.c b/test/small/memset1.c new file mode 100644 index 0000000..d0ab7d5 --- /dev/null +++ b/test/small/memset1.c @@ -0,0 +1,47 @@ +// This test checks out our special fancy memset support. +// KEEP baseline: success + +#include "harness.h" + +struct foo { + int a; + int b; +}; + +struct bar { + int a; + int *b; +}; + +void * (DMEMSET(1, 2, 3) my_memset)(void *dst, int value, int sz) { + return dst; +} + +int main() { + char * COUNT(10) pc = alloc(char, 10); + int * COUNT(10) pi = alloc(int, 10); + struct foo * COUNT(10) pf = alloc(struct foo, 10); + struct bar * COUNT(10) pb = alloc(struct bar, 10); + + my_memset(pc, 0, 10); + my_memset(pc, 42, 10); + my_memset(pc, 0, 4); + my_memset(pc, 0, 12); // KEEP len1: error = will always fail + + my_memset(pi, 0, 10 * sizeof(int)); + my_memset(pi, 42, 10 * sizeof(int)); + my_memset(pi, 0, 4); + my_memset(pi, 0, 12 * sizeof(int)); // KEEP len2: error = will always fail + + my_memset(pf, 0, 10 * sizeof(struct foo)); + my_memset(pf, 42, 10 * sizeof(struct foo)); + my_memset(pf, 0, 4); + my_memset(pi, 0, 12 * sizeof(struct foo)); // KEEP len3: error = will always fail + + my_memset(pb, 0, 10 * sizeof(struct bar)); + my_memset(pb, 42, 10 * sizeof(struct bar)); // KEEP nonzero: error = Assertion + my_memset(pb, 0, 4); // KEEP partial: error = Assertion + my_memset(pi, 0, 12 * sizeof(struct bar)); // KEEP len4: error = will always fail + + return 0; +} diff --git a/test/small/memset2.c b/test/small/memset2.c new file mode 100755 index 0000000..564e123 --- /dev/null +++ b/test/small/memset2.c @@ -0,0 +1,29 @@ +// KEEP baseline: success + +// This test checks out the combination of DMEMSET with TRUSTED + +void * (DMEMSET(1, 2, 3) my_memset)(void * s, char c, int count) { + return s; +} + +void * (DMEMCPY(1, 2, 3) my_memcpy)(void* dst, void* src, int sz) { + return dst; +} + +int (DMEMCPY(1, 2, 3) my_memcmp)(void* s1, void* s2, int sz) { + return 0; +} + +char * TRUSTED s; +char * NT COUNT(2) t = "Hi"; +int main() { + my_memset(s, 0, 2); + + my_memcpy(s, t, 2); + my_memcpy(t, s, 2); + + my_memcmp(s, t, 2); + my_memcmp(t, s, 2); + + return 0; +} diff --git a/test/small/nonnull1.c b/test/small/nonnull1.c new file mode 100755 index 0000000..4ea4ef9 --- /dev/null +++ b/test/small/nonnull1.c @@ -0,0 +1,32 @@ +#include "harness.h" + +//KEEP baseline: success + +int global[5]; + +int* NONNULL COUNT(3) foo(int* COUNT(4) NONNULL x) { + *x = 1; + int* p = x + 1; + *p = 2; + return p; +} + +struct test { + int* NONNULL y; +} gstruct = { & global[2] }; + + +int main() { + memset(&gstruct, 0, sizeof(gstruct)); // KEEP memset: error = memset on a type containing a nonnull pointer + struct test * SAFE p = malloc(1*sizeof(struct test)); //KEEP malloc: error = Allocation of a buffer containing non-null + + int* x = malloc(5*sizeof(*x)); + //we need a null check here; it's the only one we need in the file. + memset(x, 0x55, 5*sizeof(*x)); + if (global[2]) { + x = &global; + x++; + } + x = foo(x); + return *x-2; +} diff --git a/test/small/nonnull2.c b/test/small/nonnull2.c new file mode 100755 index 0000000..46ff412 --- /dev/null +++ b/test/small/nonnull2.c @@ -0,0 +1,21 @@ +#include "harness.h" + +int x = 0; +int * pp = &x; + +int deref (int * NONNULL p) { + return *p; +} + +int main() { + int * NONNULL p = pp; // KEEP hasinit: success + + // This gets initialized to 0, which is illegal because it's NONNULL. + // (We also get an error because it's used before being defined.) + int * NONNULL p; // KEEP missinginit: error = p may be used without being defined + + // An explicit assignment is also caught + int * NONNULL p = 0; // KEEP init: error = will always fail. + + return deref(p); +} diff --git a/test/small/nonnull3.c b/test/small/nonnull3.c new file mode 100755 index 0000000..376bd7b --- /dev/null +++ b/test/small/nonnull3.c @@ -0,0 +1,24 @@ +#include "harness.h" + +int x; +int * NONNULL g = &x; + +int func(int * NONNULL nz) { + return 0; +} + +int * NONNULL * pg = & g; + +int main() { + int * z = 0; + + int * p = (int * NONNULL)z; return p; // KEEP : error = non-null check + + g = z; // KEEP : error = non-null check + + func(z); // KEEP : error = non-null check + + *pg = z; // KEEP : error = non-null check + + return 0; +} diff --git a/test/small/nonnull4.c b/test/small/nonnull4.c new file mode 100755 index 0000000..8651690 --- /dev/null +++ b/test/small/nonnull4.c @@ -0,0 +1,19 @@ + +#include "harness.h" + +int x = 5; +int * NONNULL a[2] = { &x, &x }; + +int main() { + + if(* a[0] != 5) E(1); + + // Deputy will allow us to zero the contents of a + a[0] = 0; + + // And will not have a null check now + * a[0] = 0; // KEEP : error = non-null + + return 0; +} + diff --git a/test/small/nullterm1.c b/test/small/nullterm1.c new file mode 100644 index 0000000..92f7ade --- /dev/null +++ b/test/small/nullterm1.c @@ -0,0 +1,32 @@ +// KEEP baseline: success + +int main() { + int * SAFE x; + int * SAFE (NT a)[10]; + int * SAFE y; + + int * SAFE * COUNT(9) NT p; + int * SAFE * NTS q; + int i; + int sum; + + x = &i; y = &i; // Non-zero guards above and below array + + p = a; + for (i = 0; i < 9; i++) { + p[i] = &i; + } + p[9] = 0; + p[9] = &i; // KEEP write1: error = Assertion + + q = p; + + while (*q != 0) { + sum += **q; + q++; + } + + q++; // KEEP inc1: error = Assertion + + return 0; +} diff --git a/test/small/nullterm10.c b/test/small/nullterm10.c new file mode 100644 index 0000000..ddfcf64 --- /dev/null +++ b/test/small/nullterm10.c @@ -0,0 +1,5 @@ +static char (NT data[])[9] = { "hello" }; + +int main() { + return (**data == 'h') ? 0 : 1; +} diff --git a/test/small/nullterm11.c b/test/small/nullterm11.c new file mode 100644 index 0000000..5841f0e --- /dev/null +++ b/test/small/nullterm11.c @@ -0,0 +1,22 @@ +struct with_string { + char * NT COUNT(len) name; + int len; +}; + +struct with_string (NT mystrings)[] = { + {"foobar", sizeof("foobar")-1}, + {"cup", sizeof("cup")-1}, + {"watch", sizeof("watch")-1}, + {(void *)0,0} +}; + +int main() +{ + struct with_string *p = mystrings; + + while(p->name) { + p++; + } + + return 0; +} diff --git a/test/small/nullterm2.c b/test/small/nullterm2.c new file mode 100644 index 0000000..f2a407b --- /dev/null +++ b/test/small/nullterm2.c @@ -0,0 +1,31 @@ +// KEEP baseline: success + +// This test ensures that we search for a fully-null element instead of +// just a null byte. It also ensures that the length does not appear +// artificially long for the same reason. + +int main() { + int (NT a)[4]; + int * NTS p; + int * COUNT(1) NT q; + + a[0] = 0xffffffff; + a[1] = 0xffffff00; + a[2] = 0xffffffff; + a[3] = 0; + + p = a; + p[2] = 0xdeadbeef; + p[4] = 0xdeadbeef; // KEEP err1: error = Assertion + + p++; + p++; + p++; + + q = a; + q++; + q++; + q++; // KEEP err2: error = Assertion + + return 0; +} diff --git a/test/small/nullterm3.c b/test/small/nullterm3.c new file mode 100644 index 0000000..37c6a02 --- /dev/null +++ b/test/small/nullterm3.c @@ -0,0 +1,12 @@ +// Test whether we can increment a nullterm string with inferred bounds. + +char foo(const char * NTS t) { + const char * NT s = t; + s++; + return *s; +} + +int main() { + char c = foo("test"); + return (c == 'e') ? 0 : 1; +} diff --git a/test/small/nullterm4.c b/test/small/nullterm4.c new file mode 100644 index 0000000..3a84448 --- /dev/null +++ b/test/small/nullterm4.c @@ -0,0 +1,17 @@ +// KEEP baseline: success + +int main() { + char * NTS s = "test"; + char * COUNT(0) s1 = NTDROP(s); + char * s2 = NTEXPAND(s); + char c; + + c = s1[0]; // KEEP err1: error = will always fail + + c = s2[0]; + c = s2[3]; + c = s2[4]; + c = s2[5]; // KEEP err2: error = nullterm upper bound check + + return 0; +} diff --git a/test/small/nullterm5.c b/test/small/nullterm5.c new file mode 100644 index 0000000..565441f --- /dev/null +++ b/test/small/nullterm5.c @@ -0,0 +1,5 @@ +int main() { + char * NTS s = "test"; + char * COUNT(4) t = NTDROP(NTEXPAND(s)); + return 0; +} diff --git a/test/small/nullterm6.c b/test/small/nullterm6.c new file mode 100644 index 0000000..5bc4fe8 --- /dev/null +++ b/test/small/nullterm6.c @@ -0,0 +1,66 @@ +// Test that we are properly initializing local variables. + +#include "harness.h" + +TESTDEF baseline:success + +void scribble() { + int a[2048]; + int i; + + // Write a bunch of garbage on the stack. + for (i = 0; i < 2048; i++) { + a[i] = 42; + } +} + +void test() { + int i; + + int * p1; + int (NT p2)[8]; + struct foo { + int * f; + } p3; + + struct foo p4[8]; + + struct fooNT { + int (NT a)[8]; + } p5; + + union fooNTu { + int * ptr WHEN(1); + int in; + } p6; + + // Check that we actually scribbled on the stack. A failure here does + // not indicate a failure in Deputy; I'm just trying to ensure that + // the test tests what it's supposed to be testing. If this test starts + // to fail, we can just remove it. + if(i != 42) E(10); + + //We report this one as an error: + if(p1 != 0) E(1); //KEEP uninit_ptr: error = p1 may be used without being defined + + if(p2[7] != 0) E(2); + + if(p3.f != 0) E(3); + + for(i=0;i<8;i++) { + if(p4[i].f != 0) E(4); + } + + if(p5.a[7] != 0) E(5); + + if(p6.ptr != 0) E(6); + + SUCCESS; +} + +int main() { + scribble(); + test(); + + SUCCESS; +} diff --git a/test/small/nullterm7.c b/test/small/nullterm7.c new file mode 100755 index 0000000..994310f --- /dev/null +++ b/test/small/nullterm7.c @@ -0,0 +1,19 @@ +//Don't allow negative counts! + + +extern const char (NT COUNT(-1) not_really_there1)[0]; +const char * NT COUNT(-1) x1 = not_really_there1; + +int neg_one = -1; +extern const char (NT COUNT(neg_one) not_really_there2)[0]; +const char * NT COUNT(neg_one) x2 = not_really_there2; + +int global; +int main() { + global = not_really_there1[0]; //KEEP array1: error = zero length + global = *x1; //KEEP ptr1: error = zero length + global = not_really_there2[0]; //KEEP array2: error = zero length + global = *x2; //KEEP ptr2: error = zero length + return 0; +} + diff --git a/test/small/nullterm8.c b/test/small/nullterm8.c new file mode 100644 index 0000000..a4049cb --- /dev/null +++ b/test/small/nullterm8.c @@ -0,0 +1,33 @@ +int my_strlen( + char * + // KEEP baseline: error = upper bound check + NTS // KEEP nts: success + CT(5) // KEEP ct5: error = upper bound check + CT(6) // KEEP ct6: error = nullterm upper bound coercion + NT CT(5) // KEEP ntct5: success + NT CT(6) // KEEP ntct6: error = nullterm upper bound coercion + p) { + int i = 0; + while (p[i] != 0) { + i++; + } + return i; +} + +int read5(char * CT(5) p) { + int i; + int sum = 0; + for (i = 0; i < 5; i++) { + sum += p[i]; + } + return sum; +} + +int main() { + int len = my_strlen("hello"); // Test the annotation above. + + char * NTS p = "world"; + read5(p); // Make sure we do a proper NT expand here. + + return (len == 5) ? 0 : 1; +} diff --git a/test/small/nullterm9.c b/test/small/nullterm9.c new file mode 100755 index 0000000..bff5471 --- /dev/null +++ b/test/small/nullterm9.c @@ -0,0 +1,21 @@ +#include "harness.h" + +// Don't allow negative counts! + +int main() { +IFTEST t1: error = upper bound check + char * NT COUNT(-1) p = malloc(0); + *p = 0; +ENDIF +IFTEST t2: error = upper bound check + int neg_one = -1; + char * NT COUNT(neg_one) p = malloc(0); + *p = 0; +ENDIF +IFTEST t3: error + char *p = malloc(0); + char * NTS q = p; // Force p to be inferred NT. + *p = 0; +ENDIF + return 0; +} diff --git a/test/small/offset1.c b/test/small/offset1.c new file mode 100755 index 0000000..9816601 --- /dev/null +++ b/test/small/offset1.c @@ -0,0 +1,28 @@ +//KEEP baseline: success +#include "harness.h" + +typedef struct { + char foo[32]; + int scalar; +} message_t; + +int x = 0; + +// +// Make sure deputy supports the standard trick for offsetof +// + + +int main() { + if (32 != & ((message_t *)0)->scalar) E(1); + //array case: & is changed to StartOf + if (0 != (unsigned )& ((message_t *)0)->foo) E(2); + + + //This is safe, but there's no reason to support it: + if (33 != & ((message_t *)1)->scalar) E(3); //KEEP 1: error = Type mismatch + + x = & ((message_t *)&x)->scalar; //KEEP 2: error = will always fail + + return 0; +} diff --git a/test/small/offset2.c b/test/small/offset2.c new file mode 100755 index 0000000..e8fe45d --- /dev/null +++ b/test/small/offset2.c @@ -0,0 +1,29 @@ +#include "harness.h" + +// +// Make sure deputy supports the standard trick for offsetof +// + + +typedef struct { + char bar[4]; + char data[28]; +} message_t; + +typedef struct { + char h[2]; +} cc1000_header_t; + +cc1000_header_t *f(message_t *amsg) +{ + return (cc1000_header_t * SAFE)(void * TRUSTED) + ((char *)amsg + ((unsigned )& ((message_t*)0)->data + - sizeof(cc1000_header_t ))); +} + +int main() { + message_t msg; + cc1000_header_t * res = f(&msg); + if ((unsigned)res != ((unsigned)&msg + 2)) E(1); + return 0; +} diff --git a/test/small/offset3.c b/test/small/offset3.c new file mode 100755 index 0000000..84395ab --- /dev/null +++ b/test/small/offset3.c @@ -0,0 +1,16 @@ +typedef struct { + char foo[28]; +} message_t; + +int f(unsigned char x) +{ + if (x > 5 + (unsigned )& ((message_t *)0)->foo) + return 1; + else + return 0; + +} + +int main() { + return f(5); +} diff --git a/test/small/openarray1.c b/test/small/openarray1.c new file mode 100644 index 0000000..82a1b0b --- /dev/null +++ b/test/small/openarray1.c @@ -0,0 +1,27 @@ +// KEEP baseline: success + +#include "harness.h" + +struct S { + int len; + int* (COUNT(len) data)[]; // KEEP t1: success +IFNTEST t1 + int* (COUNT(len) data)[0]; +ENDIF +}; + +void foo(int** COUNT(n) s, int n) { +} + +int main() { + struct S *p; + p = malloc(1); // KEEP e2: error = open array allocation +IFNTEST e2 + p = malloc(sizeof(struct S) + 5 * sizeof(int)); +ENDIF + p->len = 5; + p->len = 4; + p->len = 6; // KEEP e1: error = upper bound + foo(p->data, p->len); + return 0; +} diff --git a/test/small/openarray2.c b/test/small/openarray2.c new file mode 100644 index 0000000..4824a4a --- /dev/null +++ b/test/small/openarray2.c @@ -0,0 +1,31 @@ +// Same as openarray1, but with nullterm. + +// KEEP baseline: success + +#include "harness.h" + +struct S { + int len; + char (NT COUNT(len) name)[]; // KEEP t1: success +IFNTEST t1 + char (NT COUNT(len) name)[0]; +ENDIF +}; + +void foo(char * COUNT(n) s, int n) { +} + +int main() { + struct S *p; + p = malloc(1); // KEEP e2: error = open array allocation +IFNTEST e2 + p = malloc(sizeof(struct S) + 6); +ENDIF + p->len = 5; + p->name[4] = 'a'; + p->len = 4; + p->len = 5; + p->len = 6; // KEEP e1: error = upper bound + foo(p->name, p->len); + return 0; +} diff --git a/test/small/openarray3.c b/test/small/openarray3.c new file mode 100644 index 0000000..a80f6a9 --- /dev/null +++ b/test/small/openarray3.c @@ -0,0 +1,21 @@ +// Don't convert zero-length array to flexible array if it's the only field. + +struct padding { + int x[0]; +} __attribute__((__aligned((1) << (7)))); + +struct foo { + char a; + struct padding p1; + char b; + struct padding p2; + char c; +}; + +int main() { + struct foo f; + f.a = 0; + f.b = 1; + f.c = 2; + return 0; +} diff --git a/test/small/openarray4.c b/test/small/openarray4.c new file mode 100644 index 0000000..0660db1 --- /dev/null +++ b/test/small/openarray4.c @@ -0,0 +1,16 @@ +// This test makes sure we don't complain about globals with (empty) +// open arrays inside them (see bug 4). + +#include "harness.h" + +struct foo { + int size; + struct kern_ipc_perm *(COUNT(size) p)[] ; +}; + +struct foo f; + +int main() { + printf("%d\n", sizeof(f)); + return 0; +} diff --git a/test/small/opt1.c b/test/small/opt1.c new file mode 100644 index 0000000..e1f93c8 --- /dev/null +++ b/test/small/opt1.c @@ -0,0 +1,7 @@ +// Verify that unreachable statements don't cause problems. + +int main() { + int * SAFE p = 0; + return 0; + *p = 0; +} diff --git a/test/small/opt10.c b/test/small/opt10.c new file mode 100644 index 0000000..72bdc43 --- /dev/null +++ b/test/small/opt10.c @@ -0,0 +1,14 @@ +struct list_head { + struct list_head *next; +}; +struct signal_struct { + struct list_head cpu_timers[3]; +}; +void foo(struct signal_struct *sig) { + (&sig->cpu_timers[1])->next = &sig->cpu_timers[1]; +} +int main() { + struct signal_struct s; + foo(&s); + return 0; +} diff --git a/test/small/opt11.c b/test/small/opt11.c new file mode 100644 index 0000000..1187e2a --- /dev/null +++ b/test/small/opt11.c @@ -0,0 +1,14 @@ +// This test ensures that abstract types are treated correctly. +// In particular, we need to avoid errors involving arithmetic on +// such types. + +struct foo; + +struct foo *getfoo() { + return 0; +} + +int main() { + struct foo *p = getfoo(); + return 0; +} diff --git a/test/small/opt12.c b/test/small/opt12.c new file mode 100644 index 0000000..3e4bb71 --- /dev/null +++ b/test/small/opt12.c @@ -0,0 +1,16 @@ +// This test makes sure we don't strip off the void* -> char* cast +// inside checks, which causes gcc to complain. + +void foo(void * SIZE(len) pv, int len) { + char *pc = pv; + int i; + for (i = 0; i < len; i++) { + pc++; + } +} + +int main() { + char s[3] = { 42, 42, 42 }; + foo(s, 3); + return 0; +} diff --git a/test/small/opt13.c b/test/small/opt13.c new file mode 100644 index 0000000..a6856d4 --- /dev/null +++ b/test/small/opt13.c @@ -0,0 +1,15 @@ +int find_first_bit(int * COUNT((size / 32) + 1) addr, + int size // KEEP t1: success + unsigned int size // KEEP t2: success + ) { + return 0; +} + +int foo(int *p, int n) { + return find_first_bit(p, n); +} + +int main() { + int i; + return foo(&i, 1); +} diff --git a/test/small/opt14.c b/test/small/opt14.c new file mode 100644 index 0000000..daef848 --- /dev/null +++ b/test/small/opt14.c @@ -0,0 +1,6 @@ +int main() { + char a[] = { 'a', 'b', 'c' }; + char const * COUNT(3) p = a; + ((char *) p)[1] = 'x'; + return 0; +} diff --git a/test/small/opt15.c b/test/small/opt15.c new file mode 100644 index 0000000..0d3af0a --- /dev/null +++ b/test/small/opt15.c @@ -0,0 +1,18 @@ +// This test results (resulted) in a divide-by-zero error due to the +// zero-length struct. + +typedef struct spinlock { +} spinlock_t; + +spinlock_t slavecpulocks[1]; + +int main() { + int i; + spinlock_t x; + + for (i = 0; i < 1; i++) { + *(&slavecpulocks[i]) = x; + } + + return 0; +} diff --git a/test/small/opt16.c b/test/small/opt16.c new file mode 100644 index 0000000..969afac --- /dev/null +++ b/test/small/opt16.c @@ -0,0 +1,19 @@ +#include "harness.h" + +struct foo { + int * SAFE p; +}; + +void bar(struct foo *fp) { + fp->p = malloc(sizeof(int)); + *fp->p = 0; +} + +int main() { + struct foo f; + struct foo *fp = &f; + + fp->p = 0; + bar(fp); // We want to test whether fp->p == 0 is killed here. + return *fp->p; +} diff --git a/test/small/opt2.c b/test/small/opt2.c new file mode 100644 index 0000000..ff79b0a --- /dev/null +++ b/test/small/opt2.c @@ -0,0 +1,18 @@ +// Verify that we don't propagate constants past address-of. + +#include "harness.h" + +void foo(int * SAFE * SAFE pp) { + *pp = alloc(int, 1); +} + +int main() { + int * SAFE p = 0; + int n; + + foo(&p); + n = 0; + n = *p; + + return 0; +} diff --git a/test/small/opt3.c b/test/small/opt3.c new file mode 100755 index 0000000..08de464 --- /dev/null +++ b/test/small/opt3.c @@ -0,0 +1,21 @@ + +int count; +int * COUNT(count) pdata; + + +int data[8]; +void fill_data() { + pdata = 0; + count = 8; + pdata = data; + + pdata[0] = 0; +} + +int main() { + count = 0; + fill_data(); + + return data[0]; // KEEP : success + return pdata[0]; // KEEP : success +} diff --git a/test/small/opt4.c b/test/small/opt4.c new file mode 100755 index 0000000..dee5fe2 --- /dev/null +++ b/test/small/opt4.c @@ -0,0 +1,34 @@ +//Make sure the optimizer doesn't delete labels by mistake. + +#include //strlen + +int main() { + int type; + //CIL will insert a label '__Cont' here to implement the continue. + for (type = 0; type == 0; ) { + type = 1; + continue; + } + return 0; +} + +struct n { + struct n* n_cdr; + int n_type; + char* NTS n_str; +}; +typedef struct n NODE; +typedef int FIXNUM; +NODE *cvfixnum(FIXNUM n); + +NODE *xlength(NODE *args) +{ + NODE *arg = args; + int n; + if (((arg) == 0 || (arg)->n_type == 2)) + arg = ((arg)->n_cdr); + else if (((arg) && (arg)->n_type == 4)) + n = strlen(((arg)->n_str)); + else if (arg) + return 0; +} diff --git a/test/small/opt5.c b/test/small/opt5.c new file mode 100644 index 0000000..2f41acb --- /dev/null +++ b/test/small/opt5.c @@ -0,0 +1,40 @@ +// An optimizer test case minimized from libc/string6. + +#include "harness.h" + +int table[256]; +int * COUNT(256) tablep = table; + +const int * COUNT(256) * ctype_b_loc(void) { + return &tablep; +} + +int skip_atoi(const char * NTS * s) { + int i = 0; + + while (((*ctype_b_loc ())[**s])) { + i++; + } + + return i; +} + +const char * NTS make_str() { + char * NTS str = malloc(1); + str[0] = 0; + return str; +} + +int main() { + const char * NTS p; + int i; + + for (i = 0; i < 256; i++) { + table[i] = 0; + } + + p = make_str(); + skip_atoi(&p); + + return 0; +} diff --git a/test/small/opt6.c b/test/small/opt6.c new file mode 100644 index 0000000..d68a29f --- /dev/null +++ b/test/small/opt6.c @@ -0,0 +1,13 @@ +// A minimized optimizer bug from writev1.c. Make sure we don't +// delete the "dead" variable p2. + +#include "harness.h" + +int main() { + char *p1; + char *p2; + const int size = 8; + p1 = malloc((size+1) * sizeof p2[0]); + p2 = p1 + size; + return 0; +} diff --git a/test/small/opt7.c b/test/small/opt7.c new file mode 100755 index 0000000..fd99f48 --- /dev/null +++ b/test/small/opt7.c @@ -0,0 +1,30 @@ +#include "harness.h" + +// +//Update: this test doesn't apply to gcc v4, which doesn't have the +// -fwritable-strings option. The fact that strings shouldn't be +// forward-substituted still holds, but we have no good way of testing it. +// + + +//baseline fails when compiled with -fwritable-strings and --deputyopt=3 +//KEEP baseline: success + +//Don't do forward substitution with string literals. If -fwritable-strings is +//used, each appearance of a string literal gets its own pointer. +// +//Even if -fwritable-strings is not used, is it okay to assume that string +//literals will be coalesced? + +int main() { + char * p = NTDROP("Hello."); + int sum = 0; + while(*p != '.') { + sum += *p; + p++; + p += 8; //KEEP ubound: error = upper + } + int desiredsum = 'H'+'e'+'l'+'l'+'o'; + if (sum != desiredsum) E(3); + return 0; +} diff --git a/test/small/opt8.c b/test/small/opt8.c new file mode 100644 index 0000000..483c8f6 --- /dev/null +++ b/test/small/opt8.c @@ -0,0 +1,39 @@ +// The errors below should be caught at compile time. + +// KEEP baseline: success + +static int glen = 0; +static int * COUNT(glen) gbuf = 0; + +int inc(int * COUNT(len) NONNULL buf, int len) { + len += 10; // KEEP e3: error = will always fail + //Use buf so that it's live on the line above. + return *buf; +} + +void ginc() { + // We can't catch this statically, because gbuf might be NULL. + glen += 10; // KEEP e4: error = Assertion failed +} + +int main() { + int len; + int * COUNT(len) buf; + int a[10]; + + len = 10; + buf = a; + + len += 10; // KEEP e1: error = will always fail + + inc(buf, len); + + glen = 10; + gbuf = a; + + glen += 10; // KEEP e2: error = will always fail + + ginc(); + + return 0; +} diff --git a/test/small/opt9.c b/test/small/opt9.c new file mode 100644 index 0000000..210a10d --- /dev/null +++ b/test/small/opt9.c @@ -0,0 +1,5 @@ +int main() { + static char (NTS a)[256 + 1]; + a[256] = 0; + return 0; +} diff --git a/test/small/overflow1.c b/test/small/overflow1.c new file mode 100755 index 0000000..532fdf7 --- /dev/null +++ b/test/small/overflow1.c @@ -0,0 +1,46 @@ +// NUMERRORS 2 + +#include "harness.h" + +// This is potential bug regarding overflow in multiplication. We wrongly +// assume that k times x is always a multiple of k. +// +// In this example, we dereference p[x] where the elements in p are 12 bytes +// long, so p[x] compiles to mem[p + 12x]. But if we take +// x = 357,913,942, then (12x mod 2^32) is 8. Address (p + 8) is +// within bounds, yet we read the i2 field when we think we are reading +// the ptr field. + +int globalint = 29; + +#define NELEM 4 + + +struct twelve{ + int* SAFE ptr; + unsigned int i1; + unsigned int i2; +}; + +int foo(unsigned int x, struct twelve* COUNT(NELEM) p) { + int* ptr = p[x].ptr; + printf("p = 0x%x, &p[x] = 0x%x\n", (unsigned long) p, (unsigned long) &p[x]); + printf("Pointer is 0x%x\n", (unsigned long) ptr); + //ptr is now 0xdeadbeef. + return *ptr; +} + + +int main() { + if (sizeof (struct twelve) != 12) E(1); + + struct twelve* p = malloc(NELEM * sizeof(struct twelve)); + for (int i = 0; i < NELEM; i++) { + p[i].ptr = &globalint; + p[i].i1 = (unsigned int)0xbadf00d; + p[i].i2 = (unsigned int)0xdeadbeef; + } + foo(3,p); //KEEP baseline: success + foo(357913942,p); //KEEP overflow: error = Assertion failed + SUCCESS; +} diff --git a/test/small/overflow2.c b/test/small/overflow2.c new file mode 100644 index 0000000..b504629 --- /dev/null +++ b/test/small/overflow2.c @@ -0,0 +1,24 @@ + +#include "harness.h" + +//If len = 2^30+1, and sizeof(*p)=4, then p+len = p+4. +//This causes unsoundness in our optimizer + +int foo(int * COUNT(len) p, int len) { + if (len <= 1000) {return 42;} + else {printf("accessing 0x%x\n", p+1000); + return p[1000];} +} + +//KEEP baseline: success + + +int main() { + int len = 4; + int* COUNT(len) p = malloc(len*sizeof(int)); + printf("len is %d, p = %x\n", len, p); + len = (1<<30)+4; //KEEP bug: error = Assertion failed + printf("len is %d, p = %x\n", len, p); + printf("foo is %d\n", foo(p, len)); + return 0; +} diff --git a/test/small/packed1.c b/test/small/packed1.c new file mode 100644 index 0000000..b40f8c0 --- /dev/null +++ b/test/small/packed1.c @@ -0,0 +1,12 @@ +struct packed { + char a; + short b; +} __attribute__((packed)); + + +int i = 3; +int main() { + struct packed p[4]; + p[i].b = 1; + return 0; +} diff --git a/test/small/poly1.c b/test/small/poly1.c new file mode 100644 index 0000000..4226de5 --- /dev/null +++ b/test/small/poly1.c @@ -0,0 +1,9 @@ +TV(t) id(TV(t) p) { + return p; +} + +int main() { + int i = 0; + int *p = &i; + return * (int*) id(p); +} diff --git a/test/small/poly2.c b/test/small/poly2.c new file mode 100644 index 0000000..57ce235 --- /dev/null +++ b/test/small/poly2.c @@ -0,0 +1,10 @@ +TV(t) deref(TV(t) * p) { + return *p; +} + +int main() { + int i = 0; + int *p = &i; + int **pp = &p; + return deref(deref(pp)); +} diff --git a/test/small/poly3.c b/test/small/poly3.c new file mode 100644 index 0000000..9d6d534 --- /dev/null +++ b/test/small/poly3.c @@ -0,0 +1,13 @@ +TV(t) choose(int n, TV(t) a, TV(t) b) { + return n > 42 ? a : b; +} + +int main() { + int a; + int b; + + int n = choose(13, (int) 3, (int) 5); + int *p = choose(50, &a, &b); + + return 0; +} diff --git a/test/small/poly4.c b/test/small/poly4.c new file mode 100644 index 0000000..4b74cc8 --- /dev/null +++ b/test/small/poly4.c @@ -0,0 +1,48 @@ +struct foo { + int *q; + int a; + int b; +}; + +int getfoo(struct foo *p) { + return p->b; +} + +int getint(int *p) { + return *p; +} + +int run(int (*fn)(TV(t) p), TV(t) p) { + return fn(p); +} + +struct fioo { + TV(t) data; + int (*fn)(TV(t) p); +}; + +int test1() { + int i = 24; + struct foo f = { 0, 0, 42 }; + return run(getfoo, &f) == 42 && run(getint, &i) == 24; +} + +int test2() { + struct fioo TP(struct foo *) fi; + struct fioo TP(int *) pi; + + int i = 24; + struct foo f = { 0, 0, 42 }; + + fi.data = &f; + fi.fn = getfoo; + + pi.data = &i; + pi.fn = getint; + + return fi.fn(fi.data) == 42 && pi.fn(pi.data) == 24; +} + +int main() { + return test1() && test2() ? 0 : 1; +} diff --git a/test/small/poly5.c b/test/small/poly5.c new file mode 100644 index 0000000..f9fee67 --- /dev/null +++ b/test/small/poly5.c @@ -0,0 +1,19 @@ +int foo(int (*fn)(TV(t) data), TV(t) data) { + return fn(data); +} + +int cb_int(int *data) { + return *data; +} + +int cb_void(void *data) { + // doesn't use data + return 0; +} + +int main() { + int i = 0; + foo(cb_int, &i); + foo(cb_void, (void*) 0); + return 0; +} diff --git a/test/small/poly6.c b/test/small/poly6.c new file mode 100644 index 0000000..0238121 --- /dev/null +++ b/test/small/poly6.c @@ -0,0 +1,21 @@ +struct notifier_block { + int (*callback)(TV(t)); + TV(t) data; +}; + +struct notifier_block TP(char * NTS) * reboot_notifier_list; + +int notifier_chain_register(struct notifier_block TP(TV(t)) ** list, + struct notifier_block TP(TV(t)) * nb) { + return 0; +} + +int register_reboot_notifier(struct notifier_block TP(char * NTS) * nb) +{ + return notifier_chain_register(&reboot_notifier_list, nb); +} + +int main() { + struct notifier_block TP(char * NTS) nb; + return register_reboot_notifier(&nb); +} diff --git a/test/small/poly7.c b/test/small/poly7.c new file mode 100644 index 0000000..5f19072 --- /dev/null +++ b/test/small/poly7.c @@ -0,0 +1,16 @@ +// Make sure we handle polymorphic functions where only the return type is +// polymorphic. Thanks to Richard Jones. + +struct foo { + TV(t) data; +}; + +struct foo TP(TV(t)) *alloc_foo() { + return 0; +} + +int main() { + struct foo TP(int *) *foo_ptr; + foo_ptr = alloc_foo(); + return (int) foo_ptr; +} diff --git a/test/small/ptrarith1.c b/test/small/ptrarith1.c new file mode 100644 index 0000000..13629d6 --- /dev/null +++ b/test/small/ptrarith1.c @@ -0,0 +1,8 @@ +#include "harness.h" + +int main() { + int * COUNT(5) p = alloc(int, 5); + int * BND(p, p + 5) q = p + 5; + int n = q - p; + return (n == 5) ? 0 : 1; +} diff --git a/test/small/ptrarith2.c b/test/small/ptrarith2.c new file mode 100644 index 0000000..d0e7711 --- /dev/null +++ b/test/small/ptrarith2.c @@ -0,0 +1,22 @@ +struct p { + void * SIZE(maxlen) data; + int maxlen; +}; + +void f(struct p *s, int newlen) { + int len = newlen; + if (len == s->maxlen) + len--; + /* zf: this triggers a bug that reports an upper-bound failure */ + ((char * COUNT(len+1)) TC(s))[len] = 0; +} + +int main() { + struct p s;// = {.data = TC("0123456789"), .maxlen = 10}; + s.maxlen = 10; + s.data = TC("0123456789"); + + f(&s, 10); + + return 0; +} diff --git a/test/small/retbound1.c b/test/small/retbound1.c new file mode 100644 index 0000000..c0ebb13 --- /dev/null +++ b/test/small/retbound1.c @@ -0,0 +1,16 @@ +static inline void * BND(addr, addr+size) +memscan(void * CT(size) addr, int c, unsigned int size) +{ + void * BND(addr, addr + size) t = addr; + + return t; +} + +char foo[] = "abcdefghijklmnopqrstuvwxyz"; + +int main() +{ + char * k = memscan(foo, 'k', 26); + + return 0; +} diff --git a/test/small/return1.c b/test/small/return1.c new file mode 100644 index 0000000..b09cfeb --- /dev/null +++ b/test/small/return1.c @@ -0,0 +1,24 @@ +// KEEP baseline: success + +#include "harness.h" + +int * COUNT(10) myalloc() { + return alloc(int, 10); +} + +int main() { + int * COUNT(10) p; + int * BND(q, p+10) q; + + // This call should get broken into two statements, one where we + // assign to a fresh variable and one where we assign this value to p. + // The checks for the assignment to p should pass. + p = myalloc(); + q = p; + + // This part should fail, because the assignment to p will violate the + // restrictions on q. + p = myalloc(); // KEEP return1: error = Assertion + + return *q; //use q so that it's live +} diff --git a/test/small/sentinel1.c b/test/small/sentinel1.c new file mode 100755 index 0000000..19128cf --- /dev/null +++ b/test/small/sentinel1.c @@ -0,0 +1,37 @@ +#include "harness.h" + +int foo(int * SNT * p) { + int x = 0; + int * SNT * local = p; + x = **local; //KEEP deref1: error = sentinel + + // it's okay to cast ints to sentinel pointers. + *local = 0xbadf00d; + *p += (int)*p; + + //SNT implies COUNT(0). Make sure no one refers to + //__attribute__((sentinel)) directly, which would let them + //dereference a sentinel pointer. + int * __attribute__((sentinel)) SAFE bad = *p; x = *bad; //KEEP safe: error = dereference of a sentinel + + return 0; +} + +int main() { + int buffer[256]; + int* SNT before = (int * SNT)buffer - 1; + int* SNT after = &buffer[200]; + after += 56; //after = buffer+256 + unsigned long bufferp = &buffer[0]; + + int* x = after; *x = 2; //KEEP cast: error = may not be cast + *after = 3; //KEEP deref2: error = sentinel + + if (before != (bufferp - sizeof(int))) E(1); + if (after != (bufferp + 256*sizeof(int))) E(2); + + foo(&before); + + return 0; +} + diff --git a/test/small/sentinel2.c b/test/small/sentinel2.c new file mode 100755 index 0000000..7eee08c --- /dev/null +++ b/test/small/sentinel2.c @@ -0,0 +1,10 @@ +#include "harness.h" + +//q should be inferred to be a Sentinel, not SAFE. + +int main() { + int * p = alloc(int, 5); + int * q = p + 5; + int n = (int)q - (int)p; + return 0; +} diff --git a/test/small/size1.c b/test/small/size1.c new file mode 100644 index 0000000..969b5d9 --- /dev/null +++ b/test/small/size1.c @@ -0,0 +1,18 @@ +// KEEP baseline: success + +void foo(void * SIZE(n) p, int n) { + char *q = (char*) p; + q[n-1] = 0; + q[n] = 0; // KEEP e2: error = will always fail + *p = 0; // KEEP e3: error = mismatch in coercion +} + +int main() { + int i; + int a[10]; + int *b[10]; + foo(&i, sizeof(int)); + foo(a, sizeof(int) * 10); + foo(b, sizeof(int*) * 10); // KEEP e1: error = Type mismatch + return 0; +} diff --git a/test/small/size2.c b/test/small/size2.c new file mode 100644 index 0000000..9c71d8c --- /dev/null +++ b/test/small/size2.c @@ -0,0 +1,30 @@ +// Size test from TinyOS, courtesy of David Gay. + +typedef unsigned char uint8_t; +typedef struct { unsigned char data[1]; } nx_uint8_t; + +typedef struct CC1KHeader { + nx_uint8_t length; +} cc1000_header_t; + +IFTEST t1: success +uint8_t __nesc_ntoh_uint8(const void *SIZE(1) source) { + const uint8_t *base = source; + return base[0]; +} +ENDIF + +IFTEST t2: success +uint8_t __nesc_ntoh_uint8(nx_uint8_t *source) { + const uint8_t *base = source->data; + return base[0]; +} +ENDIF + +cc1000_header_t foo; + +int main(void) { + cc1000_header_t *txHeader = &foo; + foo.length.data[0] = 0; + return (1 < __nesc_ntoh_uint8(&txHeader->length)) ? 1 : 0; +} diff --git a/test/small/size3.c b/test/small/size3.c new file mode 100644 index 0000000..7312cc1 --- /dev/null +++ b/test/small/size3.c @@ -0,0 +1,25 @@ +// Another SIZE test from David Gay. + +typedef unsigned char uint8_t; +char buf[20]; + +void *SIZE(len) get1(uint8_t len) +{ + if (len <= 20) + return buf; + else + return 0; +} + +void *SIZE(len) get2(uint8_t len) +{ + // We'll get a void* temporary here. + return get1(len); +} + +int main() +{ + char *fun = get2(10); + + return fun[0]; +} diff --git a/test/small/size4.c b/test/small/size4.c new file mode 100644 index 0000000..c0bb299 --- /dev/null +++ b/test/small/size4.c @@ -0,0 +1,18 @@ +// Test that locals with SIZE type are handled properly. Also tests +// allocation of SIZE types. + +// KEEP baseline: success + +#include "harness.h" + +void foo(void * SIZE(n) p, int n) { +} + +int main() { + void * SIZE(10) p = malloc(10); + void * SIZE(5) q = p; + foo(q, 5); + foo(p, 6); + foo(q, 6); // KEEP e1: error = Assertion + return 0; +} diff --git a/test/small/sizeof1.c b/test/small/sizeof1.c new file mode 100644 index 0000000..4987e23 --- /dev/null +++ b/test/small/sizeof1.c @@ -0,0 +1,5 @@ +int main() { + int * SAFE p = 0; + int i = sizeof(*p); + return 0; +} diff --git a/test/small/sizeof2.c b/test/small/sizeof2.c new file mode 100644 index 0000000..e81c7de --- /dev/null +++ b/test/small/sizeof2.c @@ -0,0 +1,20 @@ +// This test checks that we can use sizeof on any variable that is +// currently in scope. + +char a[5]; + +typedef char c[5]; + +int main() { + char b[5]; + + char * COUNT(sizeof(a)) pa; + char * COUNT(sizeof(b)) pb; + char * COUNT(sizeof(c)) pc; + + pa = a; + pb = b; + pc = b; + + return 0; +} diff --git a/test/small/sizeof3.c b/test/small/sizeof3.c new file mode 100644 index 0000000..c05891f --- /dev/null +++ b/test/small/sizeof3.c @@ -0,0 +1,6 @@ +int main() { + int *p; + int x = sizeof(*((int * TRUSTED)p)); // KEEP t1: success + int x = sizeof(*((int * FAT)p)); // KEEP t2: success + return x - sizeof(int); +} diff --git a/test/small/startof1.c b/test/small/startof1.c new file mode 100644 index 0000000..03678df --- /dev/null +++ b/test/small/startof1.c @@ -0,0 +1,6 @@ +int main() { + int a[10]; + int * COUNT(10) p = a; + + return 0; +} diff --git a/test/small/startof2.c b/test/small/startof2.c new file mode 100644 index 0000000..8df9dac --- /dev/null +++ b/test/small/startof2.c @@ -0,0 +1,8 @@ +// KEEP baseline: success + +int main() { + int a[10]; + int * COUNT(20) p = a; // KEEP size1: error = will always fail + + return 0; +} diff --git a/test/small/string1.c b/test/small/string1.c new file mode 100755 index 0000000..8c80169 --- /dev/null +++ b/test/small/string1.c @@ -0,0 +1,46 @@ +// KEEP baseline: success + +#include "harness.h" + +int my_strlen(char * NTS str) { + return 5; +} + +void my_memcpy(char * NT COUNT(len) dest, + char * NT COUNT(len) src, + int len) { + int i; + for (i = 0; i < len; i++) { + dest[i] = src[i]; + } + dest[len] = src[len]; //copy the NULL +} + +void foo(char * NTS str) { + char c = *str; + *str = 0; +} + +void addr (char chr) { + char* NTS str = ""; + char c = *str; //legal + //Don't create a COUNT(1) pointer to *str, because that would let us + //overwrite the null. + char* NTS str2 = &(*str); //KEEP addrofnull: error = Assertion + *str2 = chr; //KEEP addrofnull +} + +void cast(char * NTS str) { + char* COUNT(0) str2 = NTDROP(str); //cast away the nullterm. This is safe. + foo(str2); //KEEP cast: error = Cast from ordinary pointer to nullterm +} + +int main() { + char* NTS hello = "Hello"; + char* NT COUNT(5) str = alloc(char, 6); + my_memcpy(str, hello, 5); //This coerces hello to NTS COUNT(5) using strlen + foo(str); + cast(str); + addr(*hello); + return 0; +} diff --git a/test/small/string10.c b/test/small/string10.c new file mode 100755 index 0000000..0e3adee --- /dev/null +++ b/test/small/string10.c @@ -0,0 +1,11 @@ +// Allow count annotations in arrays with explicit length. + +// CIL will insert the length based on the initializer. +char (NTS foo)[] = "foo"; // KEEP t1: success + +// Just for sanity's sake... +char (NTS foo)[4] = "foo"; // KEEP t2: success + +int main() { + return (foo[3] == 0) ? 0 : 1; +} diff --git a/test/small/string12.c b/test/small/string12.c new file mode 100644 index 0000000..d9753cb --- /dev/null +++ b/test/small/string12.c @@ -0,0 +1,20 @@ +typedef char * NTS string; + +int matchname(string bind, string name) +{ + // Let Deputy infer bounds + char * NTS bp, * NTS np; // KEEP test1 : success + char * bp, * np; // KEEP test2 : success + + bp = bind; + np = name; + while (*bp == *np) { + bp++; + np++; + } + return (*bp == '=' && *np == 0); +} + +int main() { + return ! matchname("foo=2", "foo"); +} diff --git a/test/small/string13.c b/test/small/string13.c new file mode 100755 index 0000000..0c99227 --- /dev/null +++ b/test/small/string13.c @@ -0,0 +1,20 @@ +struct str { + char (NT data)[32]; +} x; + +struct nostr { + char data[32]; +} y; + + +int main() { + char * NT p = & x.data[0]; // KEEP first : success + + // When we take the address of an element inside an array, maintain the bounds + char * p = & y.data[5]; p[-5] = 1; p[31 - 5] = 1; // KEEP third : success + char * p = & y.data[5]; p[-6] = 1; // KEEP lbound : error = Assertion + char * p = & y.data[5]; p[32-5] = 1; // KEEP ubound : error = will always fail + + + return 0; +} diff --git a/test/small/string14.c b/test/small/string14.c new file mode 100755 index 0000000..5f72d60 --- /dev/null +++ b/test/small/string14.c @@ -0,0 +1,12 @@ +// Very often I put the NT annotation on char instead of char *, by mistake +// I want a warning. + +TESTDEF warn : error = Deputy annotations cannot be placed on this type +char NT * p; +int i; +int COUNT(0) * pi = &i; + +int main() { + *pi = 0; + return *pi; +} diff --git a/test/small/string15.c b/test/small/string15.c new file mode 100755 index 0000000..5578c4f --- /dev/null +++ b/test/small/string15.c @@ -0,0 +1,5 @@ +int main() { + char * NT p = "garbage"; + p += 3; + return *p != 'b'; +} diff --git a/test/small/string16.c b/test/small/string16.c new file mode 100755 index 0000000..8eda477 --- /dev/null +++ b/test/small/string16.c @@ -0,0 +1,23 @@ +#include "harness.h" + +char * NT check(int arg) { + char* res = arg > 0 ? "true" : "false"; + return res; +} + +//Try a disconnected node: We have to look at the ? : to get the type of res, +//since we can't infer it from the use (vararg functions are not implemented). +void print(int arg) { + char* res = arg > 0 ? "true" : "false"; + char* fmt = "%s\n"; + printf(fmt, res); +} + +int main() { + print(1); + + if (check( 1)[0] != 't') exit(1); + if (check(-2)[0] != 'f') exit(2); + + return 0; +} diff --git a/test/small/string18.c b/test/small/string18.c new file mode 100755 index 0000000..41062dc --- /dev/null +++ b/test/small/string18.c @@ -0,0 +1,66 @@ +//Yet another set of string tests. + +//KEEP baseline: success + +#include +#include "harness.h" + +struct withstring { + int x; + char* NTS str; +}; + +char* NTS global; + +int loop() { + int acc = 0; + char * s = NTEXPAND(global); + while (*s) { + acc += *s; + s++; + } + //we should be able to write an empty string. + global = s; + return acc; +} + +void copy(char * NTS in) { + char * NT s = NTEXPAND(in); + char * NT t = NTEXPAND(global); + while (*s) { + *t = *s; + t++; s++; + } + *t = *s; +} + +static char (NT terminated)[2] = { 1, 0 }; +static char (NT tooshort)[2] = { 1 }; //should be padded with zeros, so OK. +static char notterminated[2] = { 1, 1 }; //KEEP arraynotterm: error = Cast from ordinary pointer to nullterm + +void array() { + char notterminated_local[2] = { 1, 1 }; //KEEP arraynotterm_local: error = nullterm write check + + copy("HELLO, WORLD"); + copy(tooshort); //KEEP tooshort: success + //make sure tooshort[1] == 0 + if (global[1] != 0) E(2); //KEEP tooshort + + copy(terminated); //KEEP terminated: success + copy(notterminated); //KEEP arraynotterm + copy(notterminated_local); //KEEP arraynotterm_local +} + +int main() { + char* tmp = malloc(13); + strncpy(tmp, "Hello, world", 12); + global = tmp; + + copy("HELLO, WORLD"); + copy("HELLO, WORLD!"); //KEEP ubound: error = nullterm write check + + array(); + + loop(); + SUCCESS; +} diff --git a/test/small/string19.c b/test/small/string19.c new file mode 100755 index 0000000..b81bf9c --- /dev/null +++ b/test/small/string19.c @@ -0,0 +1,29 @@ +#include "harness.h" + +TESTDEF : success + +int BuildWord(char * NTS pchWord) +{ + int i; + char * NTS pch = pchWord; + + /* original code: */ + while ((i = *pch) != '\0') { pch ++; } + + // This other variant would increment the pointer past the 0 + while ((i = *pch ++) != '\0') { } // KEEP : error + + printf("%s\n", pchWord); + + // however, going one past the final null is bad! + pch++; // KEEP : error = Assertion + return i; +} + + +int main() +{ + static char (NT test)[] = "foo"; + + return BuildWord(test); +} diff --git a/test/small/string2.c b/test/small/string2.c new file mode 100755 index 0000000..262fdab --- /dev/null +++ b/test/small/string2.c @@ -0,0 +1,11 @@ +//This test should work without any changes. +//KEEP baseline: success + +int foo(char * NTS str) { + return 0; +} + +int main() { + foo("Hello"); + return 0; +} diff --git a/test/small/string20.c b/test/small/string20.c new file mode 100755 index 0000000..8db9061 --- /dev/null +++ b/test/small/string20.c @@ -0,0 +1,351 @@ +// String tests from Jeremy. + +#include "harness.h" + +int my_strlen(char* NTS s) { + int n = 0; + while (*s != 0) { + n++; + s++; + } + return n; +} + +void my_strlcpy(char* COUNT(n-1) NT dest, char* NTS src, int n) { + int position; + for (position = 0; position < n-1 && *src != 0; src++, position++) { + dest[position] = *src; + } + if (position < n) { + *dest = 0; + } +} + +void my_strlcat(char* COUNT(n-1) NT dest, char* NTS src, int n) { + int offset = my_strlen(dest); + my_strlcpy(dest + offset, src, n - offset); +} + +char* NTS my_strdup(char* NTS s1) { + int i; + int len = my_strlen(s1); + char * s2 = malloc(len+1); + for (i = 0; i < len; i++) { + s2[i] = s1[i]; + } + s2[len] = 0; + return s2; +} + + +TESTDEF str-iter-1 : success +IFTEST str-iter-1 +void test(char * NTS str) { + while (*str != 0) { + str++; + } +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF str-iter-2even : success +IFTEST str-iter-2even +void test(char * NTS str) { + while (*str != 0) { + str += 2; + } +} +int main() { + test("test string."); //buffer length = 13, so [0]...[12] are accessible. + return 0; +} +ENDIF + +TESTDEF str-iter-stride4 : error +IFTEST str-iter-stride4 +void test(char * NTS str) { + while (*str != 0) { + str += 4; + } +} +int main() { + test("test strng"); + return 0; +} +ENDIF + +TESTDEF str-iter-3 : success +IFTEST str-iter-3 +void test(char * NTS str) { + int i; + int sum = 0; + for (i = 0; str[i] != 0; i++) { + sum += str[i]; + } +} +int main() { + test("test string"); + return 0; +} +ENDIF + +IFTEST str-iter-4 : error +void test(char * NTS str) { + int i; + int sum = 0; + for (i = 0; str[i] != 0; i += 4) { + sum += str[i]; + } +} +int main() { + test("test strng"); + return 0; +} +ENDIF + +TESTDEF str-iter-5 : success +IFTEST str-iter-5 +void test(char * NTS str) { + int sum = 0; + + while (*str != 0) { + while (*str == ' ') { + str++; + } + + while (*str != 0 && *str != ' ') { + sum += *str; + str++; + } + } +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF str-iter-6 : error +IFTEST str-iter-6 +void test(char * NTS str) { + int sum = 0; + + while (*str != 0) { + while (*str == ' ') { + str++; + } + + while (*str != ' ') { + sum += *str; + str++; + } + } +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF my_strlen-1 : success +IFTEST my_strlen-1 +void test(char * NTS str) { + int i; + int sum = 0; + int n = my_strlen(str); + for (i = 0; i < n; i++) { + sum += str[i]; + } +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF my_strlen-2 : success +IFTEST my_strlen-2 +void test(char * NTS str) { + int i; + int sum = 0; + int n = my_strlen(str); + for (i = 0; i < n / 2; i++) { + sum += str[i]; + } +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF strlcpy-1 : success +IFTEST strlcpy-1 +void test(char * NTS str) { + char (NT buf)[5]; + my_strlcpy(buf, str, 5); +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF strlcpy-2 : success +IFTEST strlcpy-2 +void test(char * NTS str) { + int len = my_strlen(str); + char *buf = alloc(char, len + 1); + my_strlcpy(buf, str, len + 1); +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF strlcpy-3 : error +IFTEST strlcpy-3 +void test(char * NTS str) { + int len = my_strlen(str); + char *buf = alloc(char, len); + my_strlcpy(buf, str, len + 1); +} +int main() { + test("test string."); + return 0; +} +ENDIF + +TESTDEF strlcat-1 : success +IFTEST strlcat-1 +void test(char * NTS str) { + char (NT buf)[15]; + my_strlcpy(buf, str, 15); + my_strlcat(buf, str, 15); +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF strlcat-2 : error +IFTEST strlcat-2 +void test(char * NTS str) { + char (NT buf)[15]; + my_strlcpy(buf, str, 16); + my_strlcat(buf, str, 16); +} +int main() { + test("test string"); + return 0; +} +ENDIF + +TESTDEF struct-1 : success +IFTEST struct-1 +typedef struct foo foo; +struct foo { + char * COUNT(len) buf; + int len; +}; +void test1(foo *p) { + char *buf = alloc(char, 10); + p->len = 10; + p->buf = buf; +} +void test2(foo *p) { + int i; + int sum = 0; + for (i = 0; i < p->len; i++) { + sum += p->buf[i]; + } +} +int main() { + foo f; + test1(&f); + test2(&f); + return 0; +} +ENDIF + +TESTDEF struct-2 : error +IFTEST struct-2 +typedef struct foo foo; +struct foo { + char * COUNT(len) buf; + int len; +}; +void test1(foo *p) { + char *buf = alloc(char, 12); + p->len = 13; + p->buf = buf; +} +void test2(foo *p) { + int i; + int sum = 0; + for (i = 0; i < p->len; i++) { + sum += p->buf[i]; + } +} +int main() { + foo f; + test1(&f); + test2(&f); + return 0; +} +ENDIF + +TESTDEF struct-3 : success +IFTEST struct-3 +typedef struct foo foo; +struct foo { + char * NTS str; +}; +void test1(foo *p) { + p->str = my_strdup("test string"); +} +void test2(foo *p) { + int i; + int sum = 0; + int len = strlen(p->str); + for (i = 0; i < len; i++) { + sum += p->str[i]; + } +} +int main() { + foo f; + test1(&f); + test2(&f); + return 0; +} +ENDIF + +TESTDEF struct-4 : success +IFTEST struct-4 +typedef struct foo foo; +struct foo { + char * NTS str; +}; +void test1(foo *p) { + p->str = alloc(char, 10); +} +void test2(foo *p) { + int i; + int sum = 0; + int len = my_strlen(p->str); + for (i = 0; i < len; i++) { + sum += p->str[i]; + } +} +int main() { + foo f; + test1(&f); + test2(&f); + return 0; +} +ENDIF diff --git a/test/small/string21.c b/test/small/string21.c new file mode 100644 index 0000000..deae3d1 --- /dev/null +++ b/test/small/string21.c @@ -0,0 +1,10 @@ +// Tests *s++. + +int main() { + char * NTS s = "test"; + int i = 0; + while (*s++) { + i++; + } + return (i == 4); +} diff --git a/test/small/string3.c b/test/small/string3.c new file mode 100644 index 0000000..3fab6c6 --- /dev/null +++ b/test/small/string3.c @@ -0,0 +1,18 @@ +// This test checks our handling of nullterm arrays. +// KEEP baseline: success + +int main() { + char (NT buf)[10]; + char * NT COUNT(9) p; + int i; + + p = buf; + for (i = 0; i < 9; i++) { + p[i] = 'a'; + } + p[9] = 0; + + p[9] = 'a'; // KEEP nullwrite1: error = Assertion + buf[9] = 'a'; // KEEP nullwrite2: error = Assertion + return 0; +} diff --git a/test/small/string4.c b/test/small/string4.c new file mode 100644 index 0000000..4be4491 --- /dev/null +++ b/test/small/string4.c @@ -0,0 +1,20 @@ +static int strncmp(const char * NT cs, const char * NT ct, int count) +{ + register signed char __res = 0; + + while (count) { + if ((__res = *cs - *ct++) != 0 || !*cs++) + break; + count--; + } + + return __res; +} + +int main() { + char * s1 = "abcd"; + char * s2 = "abce"; + + strncmp(s1, s2, 3); + return 0; +} diff --git a/test/small/string5.c b/test/small/string5.c new file mode 100644 index 0000000..ecd55cc --- /dev/null +++ b/test/small/string5.c @@ -0,0 +1,24 @@ +static char * strncat(char * TRUSTED dest, const char * NTS src, int count) +{ + char * NT FAT tmp = dest; + + if (count) { + while (*dest) + dest++; + while ((*dest++ = *src++) != 0) { + if (--count == 0) { + *dest = '\0'; + break; + } + } + } + + return tmp; +} + +int main() { + char dest[16] = "a"; + char *src = "bcd"; + strncat(dest, src, 3); + return 0; +} diff --git a/test/small/string6.c b/test/small/string6.c new file mode 100644 index 0000000..fed685f --- /dev/null +++ b/test/small/string6.c @@ -0,0 +1,14 @@ +static int strncmp(const char * NTS cs, const char * NTS ct, int count) +{ + int i = 0; + for (; i < count-1 && cs[i] && ct[i] && cs[i] == ct[i]; i++) + {} + return cs[i] - ct[i]; +} + +int main() { + char * NTS s1 = "bcd"; + char * NTS s2 = "bcde"; + strncmp(s1, s2, 5); + return 0; +} diff --git a/test/small/string7.c b/test/small/string7.c new file mode 100644 index 0000000..a306752 --- /dev/null +++ b/test/small/string7.c @@ -0,0 +1,12 @@ +void strlcpy1(char * COUNT(size - 1) NT dest, char * NTS src, int size) {} +void strlcpy2(char * COUNT(size) NT dest, char * NTS src, int size) {} + +int main() { + char (NT buf) [100]; + char * NTS str = "test string"; + + strlcpy1(buf, str, sizeof buf); + strlcpy2(buf, str, sizeof buf); // KEEP error1: error = Assertion + + return 0; +} diff --git a/test/small/string8.c b/test/small/string8.c new file mode 100644 index 0000000..55ad9ac --- /dev/null +++ b/test/small/string8.c @@ -0,0 +1,21 @@ +// This test makes sure that a non-NT pointer can't access that last zero. + +// KEEP baseline: success + +void my_strcpy(char * TRUSTED dest, const char * NTS src) +{ + char * FAT tmp = dest; + char * NTS src2 = src; // KEEP baseline + char *src2 = NTDROP(src); // KEEP error1: error = Assertion + + while ((*dest = *src2) != '\0') { + dest++; + src2++; + } +} + +int main() { + char buf[5]; + my_strcpy(buf, "test"); + return 0; +} diff --git a/test/small/string9.c b/test/small/string9.c new file mode 100755 index 0000000..f65514a --- /dev/null +++ b/test/small/string9.c @@ -0,0 +1,22 @@ +// This test makes sure that a non-NT pointer can't access that last zero. + +// KEEP baseline: success + +void my_strncpy(short * COUNT(4) NT dest, const short * NTS NONNULL src) +{ + short *tmp = dest; + short *src2 = src; // KEEP baseline + short *src2 = NTDROP(src); // KEEP error1: error = Assertion + + while ((*tmp = *src2) != '\0') { + tmp++; + src2++; + } +} + +int main() { + short (NT buf)[5]; + short (NT src)[5] = { 1,2,3,4,0 }; + my_strncpy(buf, src); + return 0; +} diff --git a/test/small/struct1.c b/test/small/struct1.c new file mode 100755 index 0000000..b6255c3 --- /dev/null +++ b/test/small/struct1.c @@ -0,0 +1,18 @@ + +#include "harness.h" + +struct fat { + int * SNT _e; + int * BND(__this, _e) _p; +}; + +int array[8] = { 0, 1, 2 }; + +int main() { + struct fat t; + + t._e = array+8; t._p = array; // KEEP sep : success + t = (struct fat){array + 8, array}; // KEEP bundle : success + + return t._p[2] - 2; +} diff --git a/test/small/testlib.c b/test/small/testlib.c new file mode 100644 index 0000000..4d14db0 --- /dev/null +++ b/test/small/testlib.c @@ -0,0 +1,32 @@ +// This file contains externally-defined symbols needed by test cases. + +int identity(int arg) { return arg; } + +// For extern1. +char extern1buf[4] = "abc"; + +char * /* COUNT(extern_count) */ extern_p = extern1buf; +int extern_count = sizeof(extern1buf); + +//For nullterm7. +const char not_really_there1[0]; +const char not_really_there2[0]; + + +//For abstract1 +//Just some functions that take and return pointers that abstract1 doesn't +//know the layout of. +extern void exit(int code); + +struct abstract{ + int data; +}; +static struct abstract private = {5}; + +struct abstract* get_abstract() { + return &private; +} + +void check_abstract(struct abstract* p) { + if (p != &private) exit(10); +} diff --git a/test/small/trusted1.c b/test/small/trusted1.c new file mode 100644 index 0000000..4193f5d --- /dev/null +++ b/test/small/trusted1.c @@ -0,0 +1,10 @@ +// This test checks whether trusted casts to void work as expected. + +void foo(void * SAFE p) { +} + +int main() { + int * SAFE p = 0; + foo(TC(p)); + return 0; +} diff --git a/test/small/trusted10.c b/test/small/trusted10.c new file mode 100644 index 0000000..02f89eb --- /dev/null +++ b/test/small/trusted10.c @@ -0,0 +1,80 @@ +// KEEP baseline: success + +#include "harness.h" + +//Tests for mixing auto with trusted blocks. For each case when auto can +//occur, make sure trusted code doesn't assign to auto lvalues. + +int * globSafe; +int * EFAT globSeq; + + +struct test { + int* fieldSafe; + int* FAT fieldSeq; +}; + +//Trusted functions behave the same as trusted blocks, (except that the types +//of locals are also trusted.) +void structtest(struct test* p) TRUSTED { + p->fieldSafe = (int * SAFE) 10; + p->fieldSafe = (int * SAFE) p->fieldSeq; + p->fieldSeq = (int * SAFE) 10; // KEEP struct: error = Trusted code assigns to + p->fieldSafe = &p->fieldSafe; + p->fieldSafe = &p->fieldSeq; //KEEP struct2: error = In trusted code, you may not take the address +} + +//We support auto bounds in the formals of trusted functions. This follows +//from the general rule that trusted functions can read +void formalTest(int* SAFE p, int * FAT q) TRUSTED { + + if (p != q) exit(-1); + + p = (int * SAFE) 10; + p = q; + q = (int * SAFE) 10; // KEEP formal: error = Trusted block assigns to "q" + p = &p; + p = &q; //KEEP formal2: error = address of a formal + + //From trusted code, it's not okay to call a function with auto bounds in + //its formals. + if (p != 0) formalTest(0,q); //KEEP badcall: error = Calling function formalTest from trusted code +} + +int main() { + int * SAFE p; + int * FAT q = 0; + { TRUSTEDBLOCK + p = (int * SAFE) 10; + p = q; + q = (int * SAFE) 10; // KEEP local: error = Trusted block assigns to "q" + p = &p; + p = &q; //KEEP local2: error = In trusted code, you may not take the address of + } + { TRUSTEDBLOCK + globSafe = (int * SAFE) 10; + globSafe = globSeq; + globSeq = (int * SAFE)10; //KEEP global: error = Trusted code assigns to "globSeq + p = &globSafe; + p = &globSeq; //KEEP global2: error = In trusted code, you may not take the address of + } + { TRUSTEDBLOCK + int * SAFE * SAFE pp = malloc(sizeof(*pp)); + int * FAT * SAFE qq = malloc(sizeof(*qq)); + + *pp = (int * SAFE) 10; + *pp = *qq; + *qq = (int * SAFE)10; //KEEP memory: error + } + struct test local; + structtest(&local); + formalTest(0,q); + return 0; +} + + +//Trusted code should also not return fat values. +int * FAT returnTest(int * FAT p) { + if (!p) { TRUSTEDBLOCK return 0; } //KEEP return: error = Trusted block contains return of fat type + return p; +} diff --git a/test/small/trusted11.c b/test/small/trusted11.c new file mode 100755 index 0000000..0141f30 --- /dev/null +++ b/test/small/trusted11.c @@ -0,0 +1,14 @@ +char (NT ntbuf)[10]; +int main() { + char* NT COUNT(9) p = ntbuf; + char* COUNT(10) q; + char* z = 0; + { TRUSTEDBLOCK + q = p; + //Inference should not see the ++. If it does, z will get auto bounds, + //and this assignment will be illegal in the trusted block. + z++; + } + q[9] = 'a'; + return 0; +} diff --git a/test/small/trusted12.c b/test/small/trusted12.c new file mode 100644 index 0000000..cb7c2f0 --- /dev/null +++ b/test/small/trusted12.c @@ -0,0 +1,24 @@ +// This test ensures that we don't get the "trusted cast" warning due to +// temporaries introduced by function calls. See the line where alloc() +// is called in main(). + +struct foo { + int a; + int *p; +}; + +char buf[8]; + +void * TRUSTED alloc() { + return buf; +} + +int main() { + struct foo * SAFE p = alloc(); + int i = 42; + + p->a = 42; + p->p = &i; + + return (*p->p - p->a); +} diff --git a/test/small/trusted13.c b/test/small/trusted13.c new file mode 100644 index 0000000..69c7a17 --- /dev/null +++ b/test/small/trusted13.c @@ -0,0 +1,8 @@ +int cmp_ex(const void *SAFE a, const void *SAFE b) { + const struct exception_table_entry *SAFE x = TC(a), *SAFE y = TC(b); + return (x != y); +} + +int main() { + return cmp_ex(0, 0); +} diff --git a/test/small/trusted2.c b/test/small/trusted2.c new file mode 100644 index 0000000..2066244 --- /dev/null +++ b/test/small/trusted2.c @@ -0,0 +1,18 @@ +struct foo { + int * SAFE a; + int * SAFE b; +}; + +int main() { + int i = 2; + int j = 3; + + struct foo f; + f.a = &i; + f.b = &j; + + void * SAFE p = TC(&f); + struct foo * SAFE q = TC(p); + + return (*q->a + *q->b == 5) ? 0 : 1; +} diff --git a/test/small/trusted3.c b/test/small/trusted3.c new file mode 100644 index 0000000..2e66b1f --- /dev/null +++ b/test/small/trusted3.c @@ -0,0 +1,7 @@ +// This test checks for a bug where the optimizer tried to get the bounds +// of an unsigned long (and failed, obviously). + +int main() { + unsigned long l = 0; + int * FAT p = TC(l); +} diff --git a/test/small/trusted4.c b/test/small/trusted4.c new file mode 100755 index 0000000..3e4c36f --- /dev/null +++ b/test/small/trusted4.c @@ -0,0 +1,24 @@ + +// Test TRUSTED functions + +int* global = 0; + +void bad1(int a, int *b, int *c) TRUSTED { + global = a; +} + +void (TRUSTED bad2) (int a, int *b, int *c) { + global = a; +} + + +// a K&R declaration. Currently, this won't parse if the return type +// is omitted. +void (TRUSTED old_bad) (a, b, c) + int a, * c; + int *b; +{ + global = a; +} + +int main() { return 0; } diff --git a/test/small/trusted5.c b/test/small/trusted5.c new file mode 100644 index 0000000..fd2ce78 --- /dev/null +++ b/test/small/trusted5.c @@ -0,0 +1,15 @@ +// Shows trusted cast problem resulting from disappearing trusted cast. + +typedef struct node { + int *next; +} *nodeptr; + +typedef struct cell { + int stuff; +} *cellptr; + +int main() { + nodeptr p = 0; + cellptr FAT c = TC(p); + return 0; +} diff --git a/test/small/trusted6.c b/test/small/trusted6.c new file mode 100644 index 0000000..b418b09 --- /dev/null +++ b/test/small/trusted6.c @@ -0,0 +1,5 @@ +int main() { + char * NT EFAT p = "test"; + char * FAT q = TC(NTDROP(p)) - 1; + return 0; +} diff --git a/test/small/trusted7.c b/test/small/trusted7.c new file mode 100644 index 0000000..eb8847a --- /dev/null +++ b/test/small/trusted7.c @@ -0,0 +1,22 @@ +// Make sure we check the target of a trusted cast for full annotations. + +int main() { + int a[2] = { 0, 42 }; + int * SAFE p = a; + + // Make sure LHS is annotated on trusted casts. + int * q = a; // KEEP baseline: success + int * q = TC(p); // KEEP t1: error = Target "q" of trusted cast + int * COUNT(2) q = (int *) TC(p); // KEEP t2: error = Target of trusted cast + + // It's okay if the LHS is trusted but otherwise unannotated. + int * TRUSTED r = TC(p); + int * COUNT(2) s = (int * TRUSTED) TC(p); + + // Self-assignment used to introduce temporaries with no annotations. + // Make sure this doesn't cause any mysterious errors. + int * SAFE t = 0; + t = TC(t); + + return (q[1] == 42) ? 0 : 1; +} diff --git a/test/small/trusted8.c b/test/small/trusted8.c new file mode 100644 index 0000000..471dbc8 --- /dev/null +++ b/test/small/trusted8.c @@ -0,0 +1,13 @@ +// Test TC on functions. + +int foo(int x) { + return x; +} + +typedef int (* SAFE fptr)(int); + +int main() { + fptr p = TC(foo); + int * SAFE p = TC(foo); + return 0; +} diff --git a/test/small/trusted9.c b/test/small/trusted9.c new file mode 100644 index 0000000..b26578f --- /dev/null +++ b/test/small/trusted9.c @@ -0,0 +1,13 @@ +#include "harness.h" + +struct foo { + int len; + char (TRUSTED blah)[]; +}; + +int main() { + struct foo* SAFE f; + f = malloc(sizeof(struct foo) + 10); + f->len = 10; + return 0; +} diff --git a/test/small/typedef1.c b/test/small/typedef1.c new file mode 100755 index 0000000..a2a83f7 --- /dev/null +++ b/test/small/typedef1.c @@ -0,0 +1,34 @@ +#include "harness.h" + +// This seems to become SAFE. Instead we should unroll the typedef where +// it is used, thus allowing the pointer to become bounded +typedef int * intptr; + + +TESTDEF default : success + + +int main() { + int array[8]; + int i; + +IFTEST test1 : success + intptr p; +ELSE + int * p; +ENDIF + + for(p=array; pp); + + return 0; +} diff --git a/test/small/types9.c b/test/small/types9.c new file mode 100644 index 0000000..0ced6e1 --- /dev/null +++ b/test/small/types9.c @@ -0,0 +1,15 @@ +typedef int fun(void); + +int foo() { + return 0; +} + +int main() { + fun *fp; + int n; + + fp = &foo; + n = fp(); + + return n; +} diff --git a/test/small/union1.c b/test/small/union1.c new file mode 100755 index 0000000..a477684 --- /dev/null +++ b/test/small/union1.c @@ -0,0 +1,77 @@ +//KEEP baseline: success + +#include "harness.h" + +#define CLEARUNION(u) memset(&u, 0, sizeof(u)) + + union bar { + int anint WHEN(tag == 2); + int * SAFE ptrint WHEN(tag > 2); + float afloat WHEN(buf != 0); + }; +struct host { + int tag; // 0 for integer, 1 for int* + + union bar u; + + int* COUNT(tag) buf; //Another dependency on tag. +}; + + +struct host global; +int gint; + +//Test for union as a local +void local() { + int tag; + union bar u; + int* COUNT(tag) buf = 0; //Another dependency on tag. + + //If we don't clear the union with memset, we will have to notice + //that "u.anint = 2" is also an initialization of the union. + CLEARUNION(u); //KEEP noinit: success + tag = 2; + + u.anint = 2; + + int x = u.anint; + + // I added a special case for memset to allow taking the address of + // dependent stuff. Make sure we check for external dependencies: + CLEARUNION(tag); //KEEP addrof: error = address of lval + + u.anint -= x; //set to 0 + tag = 3; + u.ptrint = &gint; + + u.ptrint = 0; + tag = 1; + buf = &gint; + u.afloat = 3.14159; +} + +//Test for union in a struct. +int main() { + global.buf = 0; + + global.tag = 2; + + global.u.anint = 2; + + int x = global.u.anint; + + global.u.anint -= x; //set to 0 + global.tag = 3; + global.u.ptrint = &gint; + + global.u.ptrint = 0; + CLEARUNION(global.u); + + global.tag = 1; + global.buf = &gint; + global.u.afloat = 3.14159; + + local(); + + return 0; +} diff --git a/test/small/union2.c b/test/small/union2.c new file mode 100755 index 0000000..a3422f2 --- /dev/null +++ b/test/small/union2.c @@ -0,0 +1,45 @@ +//no pointers? then no WHEN clause is needed. +//This is from the CCured regression suite + +extern int printf(const char * NTS format, ...); +extern void exit(int); +/* Always call E with a non-zero number */ +#define E(n) { printf("Error %d\n", n); exit(n); } + + +typedef unsigned long ULONG; +typedef long LONG; +#ifdef _GNUCC +typedef long long LONGLONG; +#else +typedef __int64 LONGLONG; +#endif + +typedef union _LARGE_INTEGER { + struct { + ULONG LowPart; + LONG HighPart; + }; + struct { + ULONG LowPart; + LONG HighPart; + } u; + LONGLONG QuadPart; +} LARGE_INTEGER; + + +int main() { + LARGE_INTEGER foo; + + foo.LowPart = 3; + foo.HighPart = 7; + + if (foo.u.LowPart != 3) { + E(1); + } + if (foo.u.HighPart != 7) { + E(2); + } + + return 0; +} diff --git a/test/small/union3.c b/test/small/union3.c new file mode 100755 index 0000000..33ae251 --- /dev/null +++ b/test/small/union3.c @@ -0,0 +1,120 @@ +//This file is from the CCured regression suite. +//KEEP baseline: success + +#include "harness.h" + +#define CLEARUNION(u) memset(&u, 0, sizeof(u)) + +enum tags { + TAG_ZERO = 0, +}; + +struct host { + int tag; // 0 for integer, 1 for int*, 2 for structure, 3 if tag2 choses + char tag2; //If tag is 3, then 0 for int, 1 for int* + + union bar { + int anint WHEN(tag == TAG_ZERO); + int * ptrint WHEN(tag == 1); + struct str { + int * * ptrptr; + } ptrptr + /* missing WHEN */ // KEEP e1: error = Missing WHEN + WHEN(tag_bad == 5) // KEEP e2: error = Field ptrptr of union bar depends on names that are not in scope + WHEN(tag == 5) WHEN(tag == 6) // KEEP e3: error = more than one WHEN +IFNTEST e1 +IFNTEST e2 +IFNTEST e3 + WHEN(tag == 5) +ENDIF +ENDIF +ENDIF + ; + int *disj WHEN(tag == 10 || tag == 11); + int *conj WHEN(tag >= 15 && tag <= 17); + + int int2 WHEN(tag == 3 && tag2 == 0); + int * ptr2 WHEN(tag == 3 && tag2 == 1); + int unprotected; //needs no WHEN clause. + } data; + + //A second union that uses the same tags. + union foo { + int fooint WHEN(!(tag & 1)); + int * fooptrint WHEN(tag & 1); + } data2; + + struct { + int x; + } somethingelse; +} g; + + +int x; +int * px = &x; + +int one() { return 1; } + +int main() { + + g.tag = 0; + + // This is good behavior + +IFTEST baseline + g.data.anint = 5; + x = g.data.anint; + CLEARUNION(g.data); + + g.tag = 1; + g.data2.fooptrint = px; + px = g.data2.fooptrint; + CLEARUNION(g.data2); + + g.tag = 5; + g.data.ptrptr.ptrptr = &px; + x = * * g.data.ptrptr.ptrptr; + CLEARUNION(g.data); + + g.tag = 3; g.tag2 = 1; + g.data.ptr2 = px; + px = g.data.ptr2; + + // This is allowed because we are not reading a pointer + x = g.data.unprotected; + + // We can take the address of a non-discriminated field + px = & g.somethingelse.x; + + CLEARUNION(g.data); + g.tag = 10; px = g.data.disj; + g.tag = 11; px = g.data.disj; + + CLEARUNION(g.data); + g.tag = 15;px = g.data.conj; + g.tag = 16;px = g.data.conj; +ELSE + + CLEARUNION(g.data); + + // We cannot access pointers when the tag is wrong + g.tag = 0; x = g.data.ptrint; // KEEP e4: error = will always fail + g.tag = 0; *g.data.ptrptr.ptrptr = px; // KEEP e5: error = will always fail + g.tag = 0; { struct str s = g.data.ptrptr; } // KEEP e6: error = will always fail + + px = & g.data.anint; // KEEP e7: error = address of a union field + // We cannot take the address of a field in a subfield + { int * * * a = & g.data.ptrptr.ptrptr; } // KEEP e8: error = address of a union field + + g.tag = 12;px = g.data.disj; // KEEP e9: error = will always fail + + g.tag = 10;px = g.data.conj; // KEEP e10: error = will always fail + g.tag = 18;px = g.data.conj; // KEEP e11: error = will always fail + + //Don't allow changes to the tag. + g.tag = 0; g.data.anint = 42; g.tag = 1; //KEEP e12: error = Assertion +ENDIF + + return 0; +} + diff --git a/test/small/union4.c b/test/small/union4.c new file mode 100755 index 0000000..0dcca4f --- /dev/null +++ b/test/small/union4.c @@ -0,0 +1,58 @@ +//This is roughly union1.c, with a trusted annotation instead of WHENs. + +//KEEP baseline: success +#include "harness.h" + + union TRUSTED bar { + int anint; + int * SAFE ptrint; + float afloat; + } u ; +struct host { + int tag; // 0 for integer, 1 for int* + + union bar u; + + int* COUNT(tag) buf; //Another dependency on tag. +}; + + +struct host global; +int gint; + +//Test for union as a local +void local() { + int tag; + union bar u; + int* buf = 0; + + u.anint = 2; + tag = 2; + + tag = 3; + u.ptrint = &gint; + + u.ptrint = 0; + tag = 1; + u.ptrint = &u.anint; + if (u.ptrint != &u.ptrint) E(1); + u.afloat += 3.14159; +} + +//Test for union in a struct. +int main() { + global.u.anint = 2; + + global.tag = 3; + global.u.ptrint = &gint; + + global.u.ptrint = 0; + + global.tag = 1; + global.buf = &gint; + global.u.afloat = 3.14159; + + local(); + + return 0; +} diff --git a/test/small/union5.c b/test/small/union5.c new file mode 100755 index 0000000..4dd8130 --- /dev/null +++ b/test/small/union5.c @@ -0,0 +1,117 @@ +//KEEP baseline: success + +//Example from the spec95 Lisp interpreter: change a union tag to +// an equivalent one without zeroing the union. + +#include "harness.h" +#include //memset + +typedef struct file FILE; + +/* node types */ +#define FREE 0 +#define SUBR 1 +#define FSUBR 2 +#define LIST 3 +#define SYM 4 +#define INT 5 +#define STR 6 +#define OBJ 7 +#define FPTR 8 +#define FLOAT 9 +#define VECT 10 + +/* node flags */ +#define MARK 1 +#define LEFT 2 + +/* string types */ +#define DYNAMIC 0 +#define STATIC 1 + +/* new node access macros */ +#define ntype(x) ((x)->n_type) + +/* type predicates */ +#define atom(x) ((x) == NIL || (x)->n_type != LIST) +#define null(x) ((x) == NIL) +#define listp(x) ((x) == NIL || (x)->n_type == LIST) +#define consp(x) ((x) && (x)->n_type == LIST) +#define subrp(x) ((x) && (x)->n_type == SUBR) +#define fsubrp(x) ((x) && (x)->n_type == FSUBR) +#define stringp(x) ((x) && (x)->n_type == STR) +#define symbolp(x) ((x) && (x)->n_type == SYM) +#define filep(x) ((x) && (x)->n_type == FPTR) +#define objectp(x) ((x) && (x)->n_type == OBJ) +#define fixp(x) ((x) && (x)->n_type == INT) +#define floatp(x) ((x) && (x)->n_type == FLOAT) +#define vectorp(x) ((x) && (x)->n_type == VECT) + +typedef struct node { + char n_type; /* type of node */ + char n_flags; /* flag bits */ + union { /* value */ + struct xsubr { /* subr/fsubr node */ + /* WEIMER struct node *(*xsu_subr)(); pointer to an internal routine */ + struct node *(*xsu_subr)(struct node *); + } n_xsubr WHEN(n_type == SUBR || n_type == FSUBR); + struct xlist { /* list node (cons) or symbol, too */ + struct node *xl_car; /* the car pointer */ + struct node *xl_cdr; /* the cdr pointer */ + } n_xlist WHEN(n_type == LIST || n_type == SYM || n_type == FREE); + struct xint { /* integer node */ + long xi_int; /* integer value */ + } n_xint WHEN(n_type == INT); + struct xfloat { /* float node */ + double xf_float; /* float value */ + } n_xfloat WHEN(n_type == FLOAT + || n_type == VECT //KEEP notexclusive: error = Warning: Setting this tag makes two fields active + ); + struct xstr { /* string node */ + int xst_type; /* string type */ + char * NTS xst_str; /* string pointer */ + } n_xstr WHEN(n_type == STR); + struct xfptr { /* file pointer node */ + FILE *xf_fp; /* the file pointer */ + int xf_savech; /* lookahead character for input files */ + } n_xfptr WHEN(n_type == FPTR); + struct xvect { /* vector node */ + int xv_size; /* vector size */ + struct node ** COUNT(xv_size) xv_data; /* vector data */ + } n_xvect WHEN(n_type == VECT || n_type == OBJ); + } n_info ; +} NODE; + +/* newnode - allocate a new node */ +NODE *newnode(int type) +{ + NODE * nnode = malloc(sizeof(NODE)); + + /* initialize the new node */ + memset(&nnode->n_info, 0, sizeof(nnode->n_info)); + nnode->n_type = type; + + /* return the new node */ + return (nnode); +} + +//Test for union in a struct. +int main() { + NODE * obj = newnode(VECT); + NODE ** data = malloc(4 * sizeof(NODE*)); + obj->n_info.n_xvect.xv_size = 4; + obj->n_info.n_xvect.xv_data = data; + + //Now change the type to obj: + obj->n_type = OBJ; //KEEP difftag: success + + obj->n_type = STR; //KEEP wrongtag: error = Assertion failed + + if (obj->n_info.n_xvect.xv_data != data) E(1); + + //And change it back: + obj->n_type = VECT+256; //the +256 goes away because n_type is a char. + + if (obj->n_info.n_xvect.xv_data != data) E(2); + return 0; +} diff --git a/test/small/union6.c b/test/small/union6.c new file mode 100644 index 0000000..7b73b97 --- /dev/null +++ b/test/small/union6.c @@ -0,0 +1,18 @@ + +union u { + struct { + int x,y,z; + } a; + struct { + int m[3]; + } b; +}; + +int main() { + union u u; + int t = 0; + u.a.x = 1; + u.b.m[2] = 2; + t = u.a.x + u.b.m[2]; + return (t == 3) ? 0 : 1; +} diff --git a/test/small/upcast1.c b/test/small/upcast1.c new file mode 100644 index 0000000..96d7bb9 --- /dev/null +++ b/test/small/upcast1.c @@ -0,0 +1,29 @@ +// KEEP baseline: success + +struct foo { + int *p; + int a; +}; + +struct bar { + struct foo f; + int *q; + int b; +}; + +int main() { + struct bar b; + struct bar *bp1 = &b; + struct foo *fp1 = (struct foo *) bp1; + + struct bar *bp2 = 0; + struct foo *fp2 = (struct foo *) bp2; + + struct bar b3[2]; + struct bar * COUNT(2) bp3 = b3; + struct foo * COUNT(2) fp3 = (struct foo * SAFE) bp3; // KEEP e1: error = will always fail + struct foo * COUNT(2) fp3 = (struct foo * COUNT(2)) bp3; // KEEP e2: error = will always fail + + b.f.a = 0; + return fp1->a; +} diff --git a/test/small/upcast2.c b/test/small/upcast2.c new file mode 100644 index 0000000..8f7756f --- /dev/null +++ b/test/small/upcast2.c @@ -0,0 +1,20 @@ +// Need to make sure that upcasts don't take priority over more +// appropriate casts. + +#include "harness.h" + +struct tcphdr { + int a; // KEEP t1: success + short a; // KEEP t2: success + int b; +}; + +void *get() { + return malloc(sizeof(struct tcphdr)); +} + +int main() { + struct tcphdr *th = (struct tcphdr * SAFE) TC(get()); + *(((short *)th) + 1) = 0; + return 0; +} diff --git a/test/small/var1.c b/test/small/var1.c new file mode 100644 index 0000000..7292622 --- /dev/null +++ b/test/small/var1.c @@ -0,0 +1,11 @@ +#include "harness.h" + +void foo(int * BND(p, q) p, int * BND(q, q) q) { + p = p + 1; +} + +int main() { + int * BND(__this, __this+2) p = alloc(int, 2); + foo(p,p+2); + return 0; +} diff --git a/test/small/var2.c b/test/small/var2.c new file mode 100644 index 0000000..f25ffe5 --- /dev/null +++ b/test/small/var2.c @@ -0,0 +1,13 @@ +// KEEP baseline: success + +#include "harness.h" + +void foo(int * SAFE p) { + p = p + 1; // KEEP size1: error = will always fail +} + +int main() { + int * SAFE p = alloc(int, 1); + foo(p); + return 0; +} diff --git a/test/small/var3.c b/test/small/var3.c new file mode 100644 index 0000000..23740ef --- /dev/null +++ b/test/small/var3.c @@ -0,0 +1,13 @@ +// KEEP baseline: success + +#include "harness.h" + +void foo(int * COUNT(2) p) { + p = p + 1; // KEEP size1: error = will always fail +} + +int main() { + int * COUNT(2) p = alloc(int, 2); + foo(p); + return 0; +} diff --git a/test/small/var4.c b/test/small/var4.c new file mode 100755 index 0000000..95d8394 --- /dev/null +++ b/test/small/var4.c @@ -0,0 +1,24 @@ +// KEEP baseline: success + +#include "harness.h" + +int ten() { + return 10; +} + +int main() { + int len = 5; + int * COUNT(len) p = 0; + //p is 0, so we can change len here + len = 8; //KEEP dep1: success + + p = alloc(int, len); + p++; //KEEP incr: error + //Can't increase the length here: + len = 10; //KEEP dep2: error + // or here: + len = ten(); //KEEP dep3: error + //but decreasing is okay: + len--; + return *p; //use p so that it's live +} diff --git a/test/small/var5.c b/test/small/var5.c new file mode 100644 index 0000000..f1aa908 --- /dev/null +++ b/test/small/var5.c @@ -0,0 +1,10 @@ +void foo(int * SAFE p) { + // int * p = p; Not legal code + *p = 0; +} + +int main() { + int a; + foo(&a); + return 0; +} diff --git a/test/small/vararg1.c b/test/small/vararg1.c new file mode 100644 index 0000000..4d4e36a --- /dev/null +++ b/test/small/vararg1.c @@ -0,0 +1,18 @@ +// This test checks for a bug where non-NT char* arguments to printf were +// automatically converted to NT. + +#include "harness.h" + +struct sk_buff { + unsigned char * COUNT(0) head; +}; + +void skb_over_panic(struct sk_buff *skb) { + printf("%p\n", skb->head); +} + +int main() { + struct sk_buff skb; + skb_over_panic(&skb); + return 0; +} diff --git a/test/small/voidstar1.c b/test/small/voidstar1.c new file mode 100755 index 0000000..6c78499 --- /dev/null +++ b/test/small/voidstar1.c @@ -0,0 +1,11 @@ +#include "harness.h" + +char * NT COUNT(49) x; +char * COUNT(50) y; + +//Don't let the NT spread through the return type of malloc from to x and y. +int main() { + x = malloc(50); + y = malloc(50); + return 0; +} diff --git a/test/small/voidstar2.c b/test/small/voidstar2.c new file mode 100755 index 0000000..1b3d168 --- /dev/null +++ b/test/small/voidstar2.c @@ -0,0 +1,20 @@ +#include "harness.h" + +int *SAFE * COUNT(5) global; + +void foo() { + void * tmp = malloc(sizeof(*global) * 5); + global = tmp; +} + +//Infer that the void* in the cast should be "int *SAFE * COUNT(5)." +void bar() { + int *SAFE * COUNT(5) local = malloc(sizeof(*local) * 5); + global = (void*) local; +} + +int main() { + foo(); + bar(); + return 0; +} diff --git a/test/small/voidstar4.c b/test/small/voidstar4.c new file mode 100644 index 0000000..48298cc --- /dev/null +++ b/test/small/voidstar4.c @@ -0,0 +1,11 @@ +// Make sure that we don't spread function dependencies to arguments. + +void foo(char * COUNT(len) buf, int len) { +} + +int main(void) +{ + void *tmp = 0; + foo(tmp, 5); + return 0; +} diff --git a/test/small/volatile1.c b/test/small/volatile1.c new file mode 100755 index 0000000..fcc25f6 --- /dev/null +++ b/test/small/volatile1.c @@ -0,0 +1,27 @@ +#include +#include "harness.h" + +//Bug 34. From TinyOS + +//Don't propagate volatile expressions. +//We don't want to change this to +// while (*82 == *82); +//which will loop forever. +void foo() { + char now = (int) * (volatile char* SAFE )TC(82U); + while ( (*(volatile char* SAFE )TC(82U)) + == now) ; +} + +//This is one uggggly hack. The only way I can think of to test this bug +//in a single-threaded app is to grep through the output. + +int main() { + int x = system("grep '^ while.*now' volatile1-tmp.cil.c"); + if (x != 0) { + printf("Error: grep returned %d\n", x); + exit(1); + } + return 0; +} + diff --git a/test/testdeputy b/test/testdeputy new file mode 100755 index 0000000..2677a3f --- /dev/null +++ b/test/testdeputy @@ -0,0 +1,3 @@ +#!/bin/sh +eval 'exec perl -S ./testdeputy.pl ${1+"$@"}' + if 0; diff --git a/test/testdeputy.pl b/test/testdeputy.pl new file mode 100644 index 0000000..aea6a0d --- /dev/null +++ b/test/testdeputy.pl @@ -0,0 +1,494 @@ +require 5.000; +use strict; + +use FindBin; +use lib "$FindBin::Bin/../cil/ocamlutil"; + +use RegTest; + +$ENV{LANG} = 'C'; + +print "Test infrastructure for Deputy\n"; + +# Create our customized test harness +my $test = RegTest->new(AvailParams => { 'SUCCESS' => 0, + 'RUN' => 1, # Numeric + 'MEM' => 1 }, + LogFile => "deputy.log", + CommandName => "testdeputy"); + +# am I on win32? +my $win32 = ($^O eq 'MSWin32' || $^O eq 'cygwin'); +my $unix = !$win32; +my $linux = $^O eq 'linux'; +my $solaris = $^O eq 'solaris'; + +my $make; +if ($solaris) { + $make = "gmake"; +} else { + $make = "make"; +} + +# Start with a few tests that must be run first +$test->newTest( + Name => "!inittests0", + Dir => "..", + Cmd => "$make", + Group => ['ALWAYS']); + +my %commonerrors = + ( +# We are seeing an error from make. Try to classify it based on the stage +# in which we are + "^make: \\*\\*\\*" => + sub { + if($_[1]->{ErrorCode} == 0) { + my $err = defined $_[1]->{instage} > 0 ? $_[1]->{instage} : 1; + $_[1]->{ErrorCode} = $err; + }}, + + # Collect some more parameters + # Now error messages + "^((Error|Bug|Unimplemented): .+)\$" + => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+ : error .+)\$" => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+:\\d+: (Error|Unimplemented|Internal error):.+)\$" + => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+: fatal error.+)\$" => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(.+: Assertion failed in.+)\$" => sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(stackdump: Dumping stack trace)" => + sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + "^(Cannot find .* in output of .*) at " => + sub { if(! defined $_[1]->{ErrorMsg}) { + $_[1]->{ErrorMsg} = $_[2];} }, + +# Running time measurements + "^user\\s+(\\d+)m([\\d.]+)s" + => sub { $_[1]->{RUN} = 60 * $_[2] + $_[3]; }, + + ); + + +# Deputy tests +# First argument is a command (one word test name followed by arguments for +# make) +sub addDeputyTest { + my($command, %extrafields) = @_; + + my ($name, $extraargs) = + ($command =~ /^(\S+) ?(.*)$/); # name is first word + + # Make a local copy of the hash + my %patterns = %commonerrors; + my $tst = + $test->newTest(Name => $name, + Dir => ".", + Cmd => "$make " . $name . " " . $extraargs, + Group => [ ], + Patterns => \%patterns); + + + # Add the extra fields + my $key; + foreach $key (keys %extrafields) { + $tst->{$key} = $extrafields{$key}; + } + return $tst; +} + +addDeputyTest("small/abstract1"); + +addDeputyTest("small/addrof1"); +addDeputyTest("small/addrof2"); +addDeputyTest("small/addrof3"); +addDeputyTest("small/addrof4"); +addDeputyTest("small/addrof5"); +addDeputyTest("small/addrof6"); +addDeputyTest("small/addrof7"); + +addDeputyTest("small/align1"); +addDeputyTest("small/align2", + Comm=>"Unsound handling of upper bounds in NT pointers"); + +addDeputyTest("small/alloc1"); +addDeputyTest("small/alloc2"); +addDeputyTest("small/alloc3"); +addDeputyTest("small/alloc4"); +addDeputyTest("small/alloc5"); +addDeputyTest("small/alloc6"); +addDeputyTest("small/alloc7"); +addDeputyTest("small/alloc8"); +addDeputyTest("small/alloc9"); +addDeputyTest("small/alloc10"); +addDeputyTest("small/alloc11"); +addDeputyTest("small/alloc12"); + +addDeputyTest("small/array1"); +addDeputyTest("small/array2"); +addDeputyTest("small/array3"); +addDeputyTest("small/array4"); +addDeputyTest("small/array5"); +addDeputyTest("small/array6"); +addDeputyTest("small/array7"); + +addDeputyTest("small/auto1"); +addDeputyTest("small/auto2"); +addDeputyTest("small/auto3"); +addDeputyTest("small/auto4", + Comm => "Better error messages for illegal auto use. Bug 41."); +addDeputyTest("small/auto5"); +addDeputyTest("small/auto6"); +addDeputyTest("small/auto7"); +addDeputyTest("small/auto8"); +addDeputyTest("small/auto9"); + +addDeputyTest("small/bound1"); + +addDeputyTest("small/builtin1"); + +addDeputyTest("small/call1"); +addDeputyTest("small/call2"); +addDeputyTest("small/call3"); +addDeputyTest("small/call4"); +addDeputyTest("small/call5"); +addDeputyTest("small/call6"); +addDeputyTest("small/call7"); +addDeputyTest("small/call8", + Comm => "Better checking for args in ret type. Bug 46."); + +addDeputyTest("small/cast1"); +addDeputyTest("small/cast2"); +addDeputyTest("small/cast3"); +addDeputyTest("small/cast4"); +addDeputyTest("small/cast5"); +addDeputyTest("small/cast6"); +addDeputyTest("small/cast7"); +addDeputyTest("small/cast8"); +addDeputyTest("small/cast9"); +addDeputyTest("small/cast10"); +addDeputyTest("small/cast11"); +addDeputyTest("small/cast12"); +addDeputyTest("small/cast13"); +addDeputyTest("small/cast14"); +addDeputyTest("small/cast15", + Comm => "Physical sutyping. Bug 5"); +addDeputyTest("small/cast16", + Comm => "Rmunused removes meta variables. Low priority"); +addDeputyTest("small/cast17"); +addDeputyTest("small/cast18"); +addDeputyTest("small/cast19", + Comm => "Need nice error message for ptr -> struct cast."); +addDeputyTest("small/cast20"); + +addDeputyTest("small/deref1"); +addDeputyTest("small/deref2"); +addDeputyTest("small/deref3"); + +addDeputyTest("small/enum1"); + +addDeputyTest("small/extern1"); +addDeputyTest("small/extern2"); +addDeputyTest("small/extern3"); + +addDeputyTest("small/extinline1"); + +addDeputyTest("small/field1"); +addDeputyTest("small/field2"); +addDeputyTest("small/field3"); +addDeputyTest("small/field4"); +addDeputyTest("small/field5"); + +addDeputyTest("small/func1"); +addDeputyTest("small/func2"); +addDeputyTest("small/func3", + Comm => "Dependencies of function arguments on non-const globals"); +addDeputyTest("small/func4"); +addDeputyTest("small/func5"); +addDeputyTest("small/func6"); +addDeputyTest("small/func7"); +addDeputyTest("small/func8"); +addDeputyTest("small/func9"); + +addDeputyTest("small/global1"); +addDeputyTest("small/global2"); +addDeputyTest("small/global3"); +addDeputyTest("small/global4"); +addDeputyTest("small/global5"); +addDeputyTest("small/global6"); +addDeputyTest("small/global7"); +addDeputyTest("small/global8"); +addDeputyTest("small/global9"); + +addDeputyTest("small/incr1"); + +addDeputyTest("small/infer1"); +addDeputyTest("small/infer2"); +addDeputyTest("small/infer3"); +addDeputyTest("small/infer4"); +addDeputyTest("small/infer5"); +addDeputyTest("small/infer6"); +addDeputyTest("small/infer7"); +addDeputyTest("small/infer8"); +addDeputyTest("small/infer9"); +addDeputyTest("small/infer10"); +addDeputyTest("small/infer11"); +addDeputyTest("small/infer12"); +addDeputyTest("small/infer13"); +addDeputyTest("small/infer14"); +addDeputyTest("small/infer15"); +addDeputyTest("small/infer16"); +addDeputyTest("small/infer17"); +addDeputyTest("small/infer18"); +addDeputyTest("small/infer19"); + +addDeputyTest("small/init1"); +addDeputyTest("small/init2"); + +addDeputyTest("small/live1"); +addDeputyTest("small/live2"); +addDeputyTest("small/live3"); + +addDeputyTest("small/local1"); + +addDeputyTest("small/memcmp1"); +addDeputyTest("small/memcmp2"); +addDeputyTest("small/memcpy1"); +addDeputyTest("small/memcpy2", + Comm=> ("when memcpy arg is cast to char*, ". + "we wrongly infer that as a SAFE ptr")); +addDeputyTest("small/memset1"); +addDeputyTest("small/memset2"); + +addDeputyTest("small/nonnull1"); +addDeputyTest("small/nonnull2"); +addDeputyTest("small/nonnull3"); +addDeputyTest("small/nonnull4"); + +addDeputyTest("small/nullterm1"); +addDeputyTest("small/nullterm2"); +addDeputyTest("small/nullterm3"); +addDeputyTest("small/nullterm4"); +addDeputyTest("small/nullterm5"); +addDeputyTest("small/nullterm6"); +addDeputyTest("small/nullterm7"); +addDeputyTest("small/nullterm8"); +addDeputyTest("small/nullterm9", + Comm=> "Zero-length NT allocation shouldn't be allowed!"); +addDeputyTest("small/nullterm10"); +addDeputyTest("small/nullterm11"); + +addDeputyTest("small/offset1"); +addDeputyTest("small/offset2"); +addDeputyTest("small/offset3"); + +addDeputyTest("small/openarray1"); +addDeputyTest("small/openarray2", + Comm => "Nullterm open arrays"); +addDeputyTest("small/openarray3"); +addDeputyTest("small/openarray4"); + +addDeputyTest("small/opt1"); +addDeputyTest("small/opt2"); +addDeputyTest("small/opt3"); +addDeputyTest("small/opt4"); +addDeputyTest("small/opt5"); +addDeputyTest("small/opt6"); +addDeputyTest("small/opt7 EXTRAARGS=-fwritable-strings", + Enabled=>0, Comm => "Not applicable to gcc4."); +addDeputyTest("small/opt8"); +addDeputyTest("small/opt9"); +addDeputyTest("small/opt10"); +addDeputyTest("small/opt11"); +addDeputyTest("small/opt12"); +addDeputyTest("small/opt13"); +addDeputyTest("small/opt14"); +addDeputyTest("small/opt15"); +addDeputyTest("small/opt16"); + +addDeputyTest("small/overflow1"); +addDeputyTest("small/overflow2", + Comm=>"Unsound! Overflow bug in optimization."); + +addDeputyTest("small/packed1"); + +addDeputyTest("small/poly1"); +addDeputyTest("small/poly2", + Comm => "Need to handle temporaries with poly type."); +addDeputyTest("small/poly3"); +addDeputyTest("small/poly4"); +addDeputyTest("small/poly5"); +addDeputyTest("small/poly6"); +addDeputyTest("small/poly7", + Comm => "Need to handle returns of poly type."); + +addDeputyTest("small/ptrarith1"); +addDeputyTest("small/ptrarith2"); + +addDeputyTest("small/return1"); + +addDeputyTest("small/sentinel1"); +addDeputyTest("small/sentinel2"); + +addDeputyTest("small/size1"); +addDeputyTest("small/size2"); +addDeputyTest("small/size3"); +addDeputyTest("small/size4"); + +addDeputyTest("small/sizeof1"); +addDeputyTest("small/sizeof2"); +addDeputyTest("small/sizeof3"); + +addDeputyTest("small/startof1"); +addDeputyTest("small/startof2"); + +addDeputyTest("small/string1"); +addDeputyTest("small/string2"); +addDeputyTest("small/string3"); +addDeputyTest("small/string4"); +addDeputyTest("small/string5"); +addDeputyTest("small/string6"); +addDeputyTest("small/string7"); +addDeputyTest("small/string8"); +addDeputyTest("small/string9"); +addDeputyTest("small/string10"); +addDeputyTest("small/string12"); +addDeputyTest("small/string13"); +addDeputyTest("small/string14"); +addDeputyTest("small/string15"); +addDeputyTest("small/string16"); +addDeputyTest("small/string18"); +addDeputyTest("small/string19"); +addDeputyTest("small/string20"); +addDeputyTest("small/string21", + Comm => "while (*s++) on nullterm pointer"); + +addDeputyTest("small/struct1"); + +addDeputyTest("small/trusted1"); +addDeputyTest("small/trusted2"); +addDeputyTest("small/trusted3"); +addDeputyTest("small/trusted4"); +addDeputyTest("small/trusted5"); +addDeputyTest("small/trusted6"); +addDeputyTest("small/trusted7"); +addDeputyTest("small/trusted8"); +addDeputyTest("small/trusted9", + Comm => "Trusted open arrays"); +addDeputyTest("small/trusted10"); +addDeputyTest("small/trusted11"); +addDeputyTest("small/trusted12"); +addDeputyTest("small/trusted13"); + +addDeputyTest("small/typedef1"); +addDeputyTest("small/typedef2", + Comm => "Arrays changed to pointers in function arguments. Need count. Low priority"); + +addDeputyTest("small/typeof1"); + +addDeputyTest("small/types1"); +addDeputyTest("small/types2"); +addDeputyTest("small/types3"); +addDeputyTest("small/types4"); +addDeputyTest("small/types5"); +addDeputyTest("small/types6"); +addDeputyTest("small/types7"); +addDeputyTest("small/types8"); +addDeputyTest("small/types9"); + +addDeputyTest("small/union1", + Comm=>"unsatisfied globalinit check -- we don't optimize unions well."); +addDeputyTest("small/union2"); +addDeputyTest("small/union3"); +addDeputyTest("small/union4"); +addDeputyTest("small/union5"); +addDeputyTest("small/union6"); + +addDeputyTest("small/upcast1"); +addDeputyTest("small/upcast2"); + +addDeputyTest("small/var1"); +addDeputyTest("small/var2"); +addDeputyTest("small/var3"); +addDeputyTest("small/var4"); +addDeputyTest("small/var5"); + +addDeputyTest("small/vararg1"); + +addDeputyTest("small/voidstar1"); +addDeputyTest("small/voidstar2"); + +addDeputyTest("small/voidstar4"); + +addDeputyTest("small/volatile1"); + +addDeputyTest("small/retbound1"); + +# libc tests + +addDeputyTest("libc/crypt1 EXTRAARGS=-lcrypt"); +addDeputyTest("libc/ctype1"); +addDeputyTest("libc/fwrite1"); +addDeputyTest("libc/getpwnam1"); +addDeputyTest("libc/glob1"); +addDeputyTest("libc/hostent1"); + # gethostent_r doesn't exist on Cygwin: +addDeputyTest("libc/hostent2") if $linux; +addDeputyTest("libc/malloc1"); +addDeputyTest("libc/malloc2"); +addDeputyTest("libc/memset1"); +addDeputyTest("libc/popen1"); +addDeputyTest("libc/printf1"); +addDeputyTest("libc/printf2"); +addDeputyTest("libc/readv1"); +addDeputyTest("libc/servent1"); +addDeputyTest("libc/servent2") if $linux; +addDeputyTest("libc/stat1"); +addDeputyTest("libc/strchr1"); +addDeputyTest("libc/strcpy"); +addDeputyTest("libc/strerror1"); +addDeputyTest("libc/string1"); +addDeputyTest("libc/string2"); +addDeputyTest("libc/string3"); +addDeputyTest("libc/string4"); +addDeputyTest("libc/string5", + Comm => "old strings-david. Not yet ported?"); + +addDeputyTest("libc/string6"); +addDeputyTest("libc/string7", + Comm => "old strings-zach. not yet ported?"); + + #Manju doesn't support strlcpy: +addDeputyTest("libc/strlcpy") if $win32; +addDeputyTest("libc/strncpy1"); +addDeputyTest("libc/strpbrk1"); +addDeputyTest("libc/strspn"); +addDeputyTest("libc/strtok1"); +addDeputyTest("libc/vararg1"); +addDeputyTest("libc/writev1"); + +#addDeputyTest("libc/getaddrinfo1"); +#addDeputyTest("libc/sockaddr1"); +#addDeputyTest("libc/socket1"); + +# See if we need to include any other tests +if(defined $ENV{DEPUTYEXTRATESTS}) { + require $ENV{DEPUTYEXTRATESTS}; +} + +###################################################################### + +# Now run the tests. +$test->doit(); + +# print Dumper($test); + +exit(0); + +1; diff --git a/web/.htaccess b/web/.htaccess new file mode 100644 index 0000000..2f341a6 --- /dev/null +++ b/web/.htaccess @@ -0,0 +1 @@ +Options +ExecCGI diff --git a/web/index.html b/web/index.html new file mode 100644 index 0000000..ccea819 --- /dev/null +++ b/web/index.html @@ -0,0 +1,61 @@ + +Deputy Demo + + +
+

Deputy Demo

+
+You can try Deputy on one of our pre-packaged tests, or you can upload your +own source file. You'll then see the result of running Deputy on the selected +file. +
+

1. Select the source file:

+ + + + + + + + + + + + + + + +
[Option 1]  Select one of our test files:
or,
[Option 2]  Upload file[s] to compile:
Constraints on uploaded files: +
    +
  • must be a preprocessed source file, with the extension .i (to obtain such +a file run "gcc -E" on a source file). +
+ +

2. Select the Deputy options you want to use:

+ +
    +
  • Optimize the run-time checks + +
+ +

3.

+ + You will have access to
    +
  • Statistics about the different kinds of pointers + that Deputy decides to use +
  • Statistics about the different kinds of run-time checks + that Deputy decides to use +
  • An interactive browser that allows you to find out why Deputy has + decided to use certain pointer kinds. +
  • The output of Deputy +
  • A full log of the Deputy run embedded in comments in the resulting + file (select "View/Page Source" to see them) +
+ +
+ + + diff --git a/web/web-driver.cgi b/web/web-driver.cgi new file mode 100644 index 0000000..a461959 --- /dev/null +++ b/web/web-driver.cgi @@ -0,0 +1,309 @@ +#!/usr/bin/perl +# +# +# Copyright (c) 2001-2002, +# George C. Necula +# Scott McPeak +# Wes Weimer +# 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 CGI; +use Cwd; +use FindBin; +# use Archive::Tar; +use Data::Dumper; +use File::Copy; + +BEGIN { + # log errors to local file + use CGI::Carp qw(carpout); +# open(ERROR_LOG, ">>./error_log") or +# die("Unable to open error log file: $!\n"); +# carpout(\*ERROR_LOG); + carpout(\*STDOUT); +} + + +use lib "$FindBin::Bin/../cil/bin"; # To get CilConfig.pm +use CilConfig; +use lib "$FindBin::Bin/../lib"; # To get CilConfig.pm +use Deputy; + + +# make newly-created files user-writable +umask 002; + +$| = 1; # No buffering of output + + +# Keep all directories relative to $::deputyhome +my $TEMPFILESDIR = "web/tmp"; + +# How to reach $::deputyhome from where this script is +my $relative_cil_home = ".."; + +# These are the standard tests +my %standardTests = + ( 'array2' => &smallTest('array2'), +); + +my $cgi = new CGI; + +print $cgi->header(-expires => 'now', + -title => "Deputy demo results"); + + +# Just for debugging +# print $cgi->Dump(); + +#check if program being run from command line or remotely +my $LOCAL = ($cgi->remote_addr() eq '127.0.0.1'); + +my $testinfo = &prepareFiles(); + +my $cwd = Cwd::cwd(); + +# Now we are running the test +chdir "$::deputyhome/$testinfo->{DIRECTORY}" + || die "$!: $::deputyhome/$testinfo->{DIRECTORY}"; +# Prepare the arguments +my @args = ( '--verbose', + '--stats', + '--save-temps=.'); +my $deputy = + "$::deputyhome/bin/deputy " . + join(' ', @args) . ' ' . + $testinfo->{FLAGS}; +# Now add whatever argument we got from the form +foreach my $arg ($cgi->param()) { + if($arg =~ m|^--|) { + $deputy .= " $arg"; + } +} +# Now finish the command line +$deputy .= ' ' . join(' ', @{$testinfo->{SOURCEFILES}}) . + " -o $testinfo->{BASENAME}.o"; + +print "\n"; +if(! open(OUT, "$deputy 2>&1 |")) { + die < +See the source of this page for more details about this run. +EOF +} + +print "The Deputy demo is in progress. Please wait...
\n"; +print "$1\n
\n"; 
+        while() {
+            if($_ !~ m|CHECK_|) { last; }
+            print $_;
+        }
+        print "
+Error running Deputy +See the source of this page for more details about this run. +EOF +} +chdir $cwd; + +print "-->"; + +# Show the result +print "Deputy completed succesfully!
\n"; + +my $basedir = "$relative_cil_home/$testinfo->{DIRECTORY}"; +my $deputyout = "$basedir/$testinfo->{BASENAME}.cil.c"; +print "Check out the result"; + +# print Dumper($testinfo); + +# Now show the browser +#if(! -d $browserdir) { +# $browserdir = "$basename/$testinfo->{BASENAME}.o_comb.browser"; +# if(! -d $browserdir) { +# die "Cannot find the browser directory\n"; +# } +#} +#print < +#; +#EOF + + +# Go over the temporary directories and delete those that are older than +# a few days +opendir TESTDIR, "$::deputyhome/$TEMPFILESDIR"; +my @temps = grep {/^\d+/ && -d $_ && -C $_ > 1} readdir TESTDIR; +closedir TESTDIR; +foreach my $tmp (@temps) { + system("rm -r $::deputyhome/$TEMPFILESDIR/$tmp"); +} + +exit(0); + +########## Subroutines + +# Construct the info for a test from small +sub smallTest { + my ($basename) = @_; + return { DIRECTORY => "test/small", + BASENAME => $basename, + SOURCEFILES => [ "$basename.c" ], + FLAGS => '-c' } +} + +# +# Prepare the files that we must work on +sub prepareFiles { + my $testname = $cgi->param('testname'); + my $handle = $cgi->upload('file'); + if(defined $testname && $testname ne "" && defined $handle) { + die "Both a resident and an upload test were specified"; + } + if(defined $testname && $testname ne "") { + #This is one of our standard tests + if(! defined($standardTests{$testname})) { + die "Unknown resident test name: $testname"; + } + return $standardTests{$testname}; + } + # Not a resident test name. Hope for a .i file + if(defined $handle) { + #get content-type of file (nothing if not filehandle) + my $contentType = $cgi->uploadInfo($handle)->{'Content-Type'}; + # Check the file name. Return the basename + my $basename = &checkFileName($handle); + print "The basename is $basename\n"; + my $tdir = &makeTempDir(); + open(SAVED, ">$::deputyhome/$tdir/$basename.i") + || die "Cannot copy uploaded file to $::deputyhome/$tdir"; + my $buffer; + while(read($handle,$buffer,1024)) { + print SAVED $buffer; + } + close(SAVED); + return { DIRECTORY => "$tdir", + SOURCEFILES => [ "$basename.i" ], + FLAGS => '--nomerge -c', + BASENAME => $basename }; + } + die "Neither a resident test nor an upload file was specfied"; +} + +# Check a file name. It must be a preprocessed file +sub checkFileName { + my $filename = shift; + if($filename =~ m|^(.+[/\\])?([a-zA-Z0-9_.]+).i$|) { + return $2; + } + die "Invalid filename: $filename. It must be a preprocessed file with +extension .i!"; +} + +# Make a temporary directory. +# Also delete old directories +sub makeTempDir { + my $timestamp = time(); # We use this to create fresh directory names + + # Now find a good name + my $TEMPDIR; + do { + $TEMPDIR = "$TEMPFILESDIR/$timestamp"; + # Go back in time a bit to ensure a new name + $timestamp --; + } while(-d "$::deputyhome/$TEMPDIR"); + mkdir "$::deputyhome/$TEMPDIR"; + return $TEMPDIR; +} + +# Search for strange characters that could lead to security vulnerabilities +sub validateArgument { + my($arg) = @_; + if($arg =~ m|[^0-9a-zA-Z_]|) { + die "Invalid character in $arg"; + } +} + +sub checkTar { + my $tarFiles = shift; + my $file = undef; + foreach $file (@$tarFiles) { + if (($file !~ m/\.[cih]$/i) || $file =~ m/\//) { + print qq(ERROR: tar file does not satisfy constraints\n
); + return 0; + } + } + return 1; +} + + +# printUploadHeaders() prints a list of the file upload headers +# associated with a given filename +# useful for debugging +# +sub printUploadHeaders() { + my $filename = shift; + print "headers:\n
"; + my $headersRef = $cgi->uploadInfo($filename); + my $key = undef; + foreach $key (keys (%$headersRef)) { + print "$key -> " . $headersRef->{$key} . "
\n"; + } +} + +# done, deputy generated the appropriate files. +# open the input file + +__END__ +:endofperl -- 2.39.2