From 767abcbbd3b2263d28da2957390f21d223960be8 Mon Sep 17 00:00:00 2001 From: Enrico Tassi Date: Fri, 15 Mar 2013 11:33:15 +0100 Subject: [PATCH 1/1] Imported Upstream version 0.1 --- Makefile | 38 + Makefile.in | 38 + README | 86 + configure | 5228 +++++++++++++++++++++++++++ configure.ac | 15 + frama-c_jessie.in | 9 + plugin/Makefile | 40 + plugin/README | 45 + plugin/arith.ml | 244 ++ plugin/arithSig.ml | 151 + plugin/cerco.ml | 122 + plugin/completeMap.ml | 84 + plugin/compute.ml | 2277 ++++++++++++ plugin/compute_simple.ml | 787 ++++ plugin/compute_simple_stack_size.ml | 356 ++ plugin/cost.ml | 163 + plugin/cost_value.ml | 704 ++++ plugin/emap.ml | 120 + plugin/eset.ml | 24 + plugin/misc.ml | 108 + plugin/multiset.ml | 58 + plugin/normAtLabels.ml | 258 ++ plugin/normAtLabels.mli | 51 + plugin/parameters.ml | 23 + plugin/simplify_terms.ml | 415 +++ plugin/tests/fail/blowfish.c | 829 +++++ plugin/tests/fail/blowfish.h | 35 + plugin/tests/fail/bubble_sort.c | 46 + plugin/tests/success/3-way.c | 144 + plugin/tests/success/a5.c | 226 ++ plugin/tests/success/fact.c | 12 + plugin/tests/success/is_sorted.c | 8 + plugin/tests/success/random.c | 147 + plugin/tests/success/tab_sum.c | 15 + wrapper/Makefile.in | 17 + wrapper/README | 49 + wrapper/_tags | 1 + wrapper/error.ml | 38 + wrapper/error.mli | 29 + wrapper/main.ml | 304 ++ wrapper/misc.ml | 153 + wrapper/misc.mli | 73 + wrapper/options.ml | 87 + wrapper/options.mli | 41 + wrapper/optionsParsing.ml | 16 + wrapper/position.ml | 134 + wrapper/position.mli | 106 + wrapper/tests/parity/Makefile | 15 + wrapper/tests/parity/README | 37 + wrapper/tests/parity/parity.lus | 35 + 50 files changed, 14041 insertions(+) create mode 100644 Makefile create mode 100644 Makefile.in create mode 100644 README create mode 100755 configure create mode 100644 configure.ac create mode 100644 frama-c_jessie.in create mode 100644 plugin/Makefile create mode 100644 plugin/README create mode 100644 plugin/arith.ml create mode 100644 plugin/arithSig.ml create mode 100644 plugin/cerco.ml create mode 100644 plugin/completeMap.ml create mode 100644 plugin/compute.ml create mode 100644 plugin/compute_simple.ml create mode 100644 plugin/compute_simple_stack_size.ml create mode 100644 plugin/cost.ml create mode 100644 plugin/cost_value.ml create mode 100644 plugin/emap.ml create mode 100644 plugin/eset.ml create mode 100644 plugin/misc.ml create mode 100644 plugin/multiset.ml create mode 100644 plugin/normAtLabels.ml create mode 100644 plugin/normAtLabels.mli create mode 100644 plugin/parameters.ml create mode 100644 plugin/simplify_terms.ml create mode 100644 plugin/tests/fail/blowfish.c create mode 100644 plugin/tests/fail/blowfish.h create mode 100644 plugin/tests/fail/bubble_sort.c create mode 100644 plugin/tests/success/3-way.c create mode 100644 plugin/tests/success/a5.c create mode 100644 plugin/tests/success/fact.c create mode 100644 plugin/tests/success/is_sorted.c create mode 100644 plugin/tests/success/random.c create mode 100644 plugin/tests/success/tab_sum.c create mode 100644 wrapper/Makefile.in create mode 100644 wrapper/README create mode 100644 wrapper/_tags create mode 100644 wrapper/error.ml create mode 100644 wrapper/error.mli create mode 100644 wrapper/main.ml create mode 100644 wrapper/misc.ml create mode 100644 wrapper/misc.mli create mode 100644 wrapper/options.ml create mode 100644 wrapper/options.mli create mode 100644 wrapper/optionsParsing.ml create mode 100644 wrapper/position.ml create mode 100644 wrapper/position.mli create mode 100644 wrapper/tests/parity/Makefile create mode 100644 wrapper/tests/parity/README create mode 100644 wrapper/tests/parity/parity.lus diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..6d83fd2 --- /dev/null +++ b/Makefile @@ -0,0 +1,38 @@ +PACKAGE=cost-plug-in +VERSION=0.1 +PACKAGE_RES=$(PACKAGE)-$(VERSION).tgz + +JESSIE=frama-c_jessie + +all: + make -C plugin + make -C wrapper + +install: + mkdir -p /usr/local/bin + cp $(JESSIE) /usr/local/bin + make -C plugin install + make -C wrapper install + +clean: + rm -fr $(PACKAGE) $(PACKAGE_RES) doc + make -C plugin clean + make -C wrapper clean + +distclean: clean + make -C plugin distclean + make -C wrapper distclean + +dist: + rm -fr $(PACKAGE) $(PACKAGE_RES) + mkdir $(PACKAGE) + for i in `cat distributed_files` doc/html/*.html; do \ + if test -f $$i; then \ + cp -fr --parents $$i $(PACKAGE); \ + else \ + mkdir -p $$i; \ + fi; \ + done + tar cvfz $(PACKAGE_RES) $(PACKAGE) + +.PHONY = install clean distclean dist diff --git a/Makefile.in b/Makefile.in new file mode 100644 index 0000000..594e5b4 --- /dev/null +++ b/Makefile.in @@ -0,0 +1,38 @@ +PACKAGE=cost-plug-in +VERSION=0.1 +PACKAGE_RES=$(PACKAGE)-$(VERSION).tgz + +JESSIE=frama-c_jessie + +all: + make -C plugin + make -C wrapper + +install: + mkdir -p @prefix@/bin + cp $(JESSIE) @prefix@/bin + make -C plugin install + make -C wrapper install + +clean: + rm -fr $(PACKAGE) $(PACKAGE_RES) doc + make -C plugin clean + make -C wrapper clean + +distclean: clean + make -C plugin distclean + make -C wrapper distclean + +dist: + rm -fr $(PACKAGE) $(PACKAGE_RES) + mkdir $(PACKAGE) + for i in `cat distributed_files` doc/html/*.html; do \ + if test -f $$i; then \ + cp -fr --parents $$i $(PACKAGE); \ + else \ + mkdir -p $$i; \ + fi; \ + done + tar cvfz $(PACKAGE_RES) $(PACKAGE) + +.PHONY = install clean distclean dist diff --git a/README b/README new file mode 100644 index 0000000..b4d0a51 --- /dev/null +++ b/README @@ -0,0 +1,86 @@ +Presentation +-------------- + +This is a Frama-C plug-in and a wrapper for Lustre that makes the synthesis of +the results of the CerCo compiler. + + Requirements +-------------- + + - Frama-C Nitrogen + - Ocaml >= 3.12 + - CerCo + - Lustre compiler (for Lustre files only) + - Jessie plug-in and simplify (for verification only) + + Compilation +------------- + + You can compile the plug-in and the wrapper using the following command: + + % make + + (assuming that you are located at the root of the source tree) + + Installation +-------------- + + You can install the plug-in and the wrapper using the following command: + + % make install + + You may need administrative rights. + +Note: both the plug-in and the wrapper can be installed seperately. See their +README in their respective source folders ("plugin" for the plug-in and +"wrapper" for the Lustre wrapper). Also note that the wrapper uses the plug-in. + + Usage +------- + + - Plug-in: + + You can run the plug-in on a C file "file.c" using the following command: + + % frama-c -cost file.c + + The result will be in file "file-annotated.c" in the same directory if the + name is fresh. Otherwise an integer suffix will be added to the base name of + the output file. + + For a complete description of the options, use the command: + + % frama-c -cost-help + + - Lustre wrapper: + + You can run the wrapper for Lustre on a node "node" of a Lustre file + "file.lus" using the following command: + + % frama-c_lustre file.lus node + + The result will be in file "file-annotated.c" in the same directory if the + name is fresh. Otherwise an integer suffix will be added to the base name of + the output file. + + For a complete description of the options, use the command: + + % frama-c_lustre -help + + - Jessie script + + For verification through a graphical user interface, a script that calls the + Jessie plug-in of Frama-C with specific options is also provided. It can be + ran using the following command on an annotated C file (obtained with the + Cost plug-in for instance): + + % frama-c_jessie annotated-file.c + + Note: the script calls Jessie with generation of safety conditions + disabled, i.e. proof obligations regarding interger overflow, pointer + dereferencing, preconditions, loop variants, etc, will *not* be + generated. Thus, verification with frama-c_jessie is only correct modulo + safety. If you wish to turn on the generation of safety conditions you can + use Jessie in its simplest form: + + % frama-c -jessie annotated-file.c diff --git a/configure b/configure new file mode 100755 index 0000000..29d9700 --- /dev/null +++ b/configure @@ -0,0 +1,5228 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69. +# +# +# Copyright (C) 1992-1996, 1998-2012 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=: + # Pre-4.2 versions of Zsh do 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_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +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.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +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 + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do 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_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_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 || +$as_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" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +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 + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# 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 + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # 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" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # 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 +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +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 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + 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 -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +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='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# 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'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/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= + +# Identity of this package. +PACKAGE_NAME= +PACKAGE_TARNAME= +PACKAGE_VERSION= +PACKAGE_STRING= +PACKAGE_BUGREPORT= +PACKAGE_URL= + +ac_unique_file="configure.ac" +ac_subst_vars='LTLIBOBJS +LIBOBJS +FRAMAC +ACC +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +' + ac_precious_vars='build_alias +host_alias +target_alias' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# 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= ;; + *) 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_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=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_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$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_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=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 ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_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'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +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 + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +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 + 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 .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# 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 -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + 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 .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + 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 +_ACEOF +fi + +if test -n "$ac_init_help"; then + + cat <<\_ACEOF + +Report bugs to the package provider. +_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" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && 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=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_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 + $as_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.69 + +Copyright (C) 2012 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 + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## +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.69. 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=. + $as_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=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append 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 + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset 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 + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + 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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; 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 + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_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'; as_fn_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 + +$as_echo "/* confdefs.h */" > 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 + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + 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. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_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,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_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 + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_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. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +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 + + + +for ac_prog in acc +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ACC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ACC"; then + ac_cv_prog_ACC="$ACC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ACC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ACC=$ac_cv_prog_ACC +if test -n "$ACC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ACC" >&5 +$as_echo "$ACC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ACC" && break +done + + + +for ac_prog in frama-c +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_FRAMAC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$FRAMAC"; then + ac_cv_prog_FRAMAC="$FRAMAC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_FRAMAC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +FRAMAC=$ac_cv_prog_FRAMAC +if test -n "$FRAMAC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $FRAMAC" >&5 +$as_echo "$FRAMAC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$FRAMAC" && break +done + + + +ac_config_files="$ac_config_files Makefile" + +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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; 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 + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_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=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +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= +U= +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=`$as_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. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $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} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## 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=: + # Pre-4.2 versions of Zsh do 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_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +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.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +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 + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +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 + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# 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 + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +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 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + 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 -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_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 || +$as_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" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# 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 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=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.69. 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 + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + 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 the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 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' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +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=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + 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 ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_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. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append 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 || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + 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= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries 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[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[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="$ac_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 || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append 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 '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + 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 || +$as_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"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_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 + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# 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= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + 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 || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;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 +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_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 "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# 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 || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + +ac_config_files="$ac_config_files frama-c_jessie" + +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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; 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 + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_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=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +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= +U= +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=`$as_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. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $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} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## 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=: + # Pre-4.2 versions of Zsh do 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_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +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.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +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 + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +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 + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# 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 + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +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 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + 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 -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_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 || +$as_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" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# 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 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=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.69. 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 + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + 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 the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 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' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +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=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + 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 ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_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. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append 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 || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "frama-c_jessie") CONFIG_FILES="$CONFIG_FILES frama-c_jessie" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + 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= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries 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[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[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="$ac_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 || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append 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 '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + 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 || +$as_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"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_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 + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# 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= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + 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 || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;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 +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_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 "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# 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 || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + +ac_config_files="$ac_config_files wrapper/Makefile" + +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_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; 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 + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_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=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +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= +U= +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=`$as_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. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $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} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## 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=: + # Pre-4.2 versions of Zsh do 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_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +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.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +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 + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +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 + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# 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 + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +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 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + 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 -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_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 || +$as_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" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# 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 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=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.69. 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 + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + 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 the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +config.status +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 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' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +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=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + 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 ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_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. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append 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 || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "frama-c_jessie") CONFIG_FILES="$CONFIG_FILES frama-c_jessie" ;; + "wrapper/Makefile") CONFIG_FILES="$CONFIG_FILES wrapper/Makefile" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + 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= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries 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[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[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="$ac_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 || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append 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 '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + 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 || +$as_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"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_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 + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# 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= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + 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 || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;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 +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_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 "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# 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 || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + + diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..a69b5b8 --- /dev/null +++ b/configure.ac @@ -0,0 +1,15 @@ +# +# Autoconf +# +AC_INIT(configure.ac) + +AC_CHECK_PROGS([ACC],[acc]) +AC_SUBST(ACC) + +AC_CHECK_PROGS([FRAMAC],[frama-c]) +AC_SUBST(FRAMAC) + +AC_OUTPUT(Makefile) +AC_OUTPUT(frama-c_jessie) +AC_OUTPUT(wrapper/Makefile) + diff --git a/frama-c_jessie.in b/frama-c_jessie.in new file mode 100644 index 0000000..b6dcd16 --- /dev/null +++ b/frama-c_jessie.in @@ -0,0 +1,9 @@ +#!/bin/env sh + +ERROR="usage: $(basename $0) file.c\n" + +if [ $# -eq 0 ] ; then + echo -e $ERROR +else + @FRAMAC@ -jessie -jessie-behavior default -jessie-why-opt="-fast-wp" $1 +fi diff --git a/plugin/Makefile b/plugin/Makefile new file mode 100644 index 0000000..5bf2892 --- /dev/null +++ b/plugin/Makefile @@ -0,0 +1,40 @@ +########################################################################## +# # +# This file is part of Frama-C. # +# # +# Copyright (C) 2007-2011 # +# CEA (Commissariat � l'�nergie atomique et aux �nergies # +# alternatives) # +# # +# you can redistribute it and/or modify it under the terms of the GNU # +# Lesser General Public License as published by the Free Software # +# Foundation, version 2.1. # +# # +# It 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 Lesser General Public License for more details. # +# # +# See the GNU Lesser General Public License version 2.1 # +# for more details (enclosed in the file licenses/LGPLv2.1). # +# # +########################################################################## + +# Generic Makefile for bytecode plugins + +FRAMAC_SHARE := $(shell frama-c.byte -print-path) +FRAMAC_LIBDIR := $(shell frama-c.byte -print-libpath) + +PLUGIN_NAME = Cost_synthesis +PLUGIN_CMO = eset emap completeMap multiset misc arithSig arith \ + cost_value compute parameters simplify_terms normAtLabels \ + compute_simple compute_simple_stack_size cerco cost + +# PLUGIN_HAS_MLI := yes + +# include Makefile.plugin +include $(FRAMAC_SHARE)/Makefile.dynamic + +distclean: clean + +.PHONY = distclean \ No newline at end of file diff --git a/plugin/README b/plugin/README new file mode 100644 index 0000000..993d375 --- /dev/null +++ b/plugin/README @@ -0,0 +1,45 @@ +Presentation +-------------- + +This is a Frama-C plug-in that makes the synthesis of the results of the CerCo +compiler. + + Requirements +-------------- + + - Frama-C Nitrogen + - Ocaml >= 3.12 + - CerCo + + Compilation +------------- + + You can compile the plug-in using the following command: + + % make + + (assuming that you are located at the root of the source tree) + + Installation +-------------- + + You can install the plug-in using the following command: + + % make install + + You may need administrative rights. + + Usage +------- + + You can run the plug-in on a C file "file.c" using the following command: + + % frama-c -cost file.c + + The result will be in file "file-annotated.c" in the same directory if the + name is fresh. Otherwise an integer suffix will be added to the base name of + the output file. + + For a complete description of the options, use the command: + + % frama-c -cost-help diff --git a/plugin/arith.ml b/plugin/arith.ml new file mode 100644 index 0000000..245e8bb --- /dev/null +++ b/plugin/arith.ml @@ -0,0 +1,244 @@ + +(** This module provides functions to manipulate parameterized arithmetic + expressions (see the ArithSig module) when instanciaded on a specific + type. *) + + +module Make (S : ArithSig.S) = struct + + include ArithSig.P + + let compare = compare S.compare + + type t = S.t tt + + let fill_subs v subs = ArithSig.fill_subs v subs + + let subs v = ArithSig.subs v + + let fold f v = ArithSig.fold f v + + + let f_to_string v subs_res = match v, subs_res with + | A a, _ -> "(A " ^ (S.to_string a) ^ ")" + | Int i, _ -> string_of_int i + | Var x, _ -> x + | UnOp (unop, _), v :: _ -> (string_of_unop unop) ^ "(" ^ v ^ ")" + | BinOp (binop, _, _), v1 :: v2 :: _ -> + "(" ^ v1 ^ ")" ^ (string_of_binop binop) ^ "(" ^ v2 ^ ")" + | Cond (_, rel, _, _, _), t1 :: t2 :: tif :: telse :: _ -> + Printf.sprintf "(%s %s %s)? (%s) : (%s)" + t1 (string_of_relation rel) t2 tif telse + | UnOp _, _ | BinOp _, _ | Cond _, _ -> + assert false (* wrong number of arguments *) + + let to_string v = fold f_to_string v + + + let is_supported_rel = function + | Cil_types.Lt | Cil_types.Gt | Cil_types.Le | Cil_types.Ge -> true + | _ -> false + + let rel_of_cil_binop = function + | Cil_types.Lt -> Lt + | Cil_types.Gt -> Gt + | Cil_types.Le -> Le + | Cil_types.Ge -> Ge + | _ -> raise (Failure "Arith.rel_of_cil_binop") + + + let cil_binop_of_rel = function + | Lt -> Cil_types.Lt + | Gt -> Cil_types.Gt + | Le -> Cil_types.Le + | Ge -> Cil_types.Ge + + let cil_unop_of_unop = function + | Neg -> Cil_types.Neg + + let cil_binop_of_binop = function + | Add -> Cil_types.PlusA + | Sub -> Cil_types.MinusA + | Mul -> Cil_types.Mult + | Div -> Cil_types.Div + | Mod -> Cil_types.Mod + (* No direct translation. Handle this case in the calling function. *) + | Max -> assert false + + + let integer_term term = Logic_const.term term Cil_types.Linteger + + let tinteger i = + let cint64 = Cil_types.CInt64 (My_bigint.of_int i, Cil_types.IInt, None) in + let iterm = Cil_types.TConst cint64 in + integer_term iterm + + let f_to_cil_term v subs_res = match v, subs_res with + | A a, _ -> S.to_cil_term a + | Int i, _ -> tinteger i + | Var x, _ -> + Logic_const.tvar (Cil_const.make_logic_var x Cil_types.Linteger) + | UnOp (unop, _), t :: _ -> + integer_term (Cil_types.TUnOp (cil_unop_of_unop unop, t)) + | BinOp (Max, _, _), t1 :: t2 :: _ -> + let test = integer_term (Cil_types.TBinOp (Cil_types.Ge, t1, t2)) in + integer_term (Cil_types.Tif (test, t1, t2)) + | BinOp (binop, _, _), t1 :: t2 :: _ -> + integer_term (Cil_types.TBinOp (cil_binop_of_binop binop, t1, t2)) + | Cond (_, rel, _, _, _), t1 :: t2 :: tif :: telse :: _ -> + let test = + integer_term (Cil_types.TBinOp (cil_binop_of_rel rel, t1, t2)) in + integer_term (Cil_types.Tif (test, tif, telse)) + | _ -> assert false (* wrong number of arguments *) + + let to_cil_term v = fold f_to_cil_term v + + + let cil_rel_of_rel = function + | Lt -> Cil_types.Rlt + | Gt -> Cil_types.Rgt + | Le -> Cil_types.Rle + | Ge -> Cil_types.Rge + + + let of_int i = Int i + let of_var x = Var x + + let apply_unop unop v = UnOp (unop, v) + let apply_binop binop v1 v2 = BinOp (binop, v1, v2) + + let int_op_of_rel = function + | Lt -> (<) + | Le -> (<=) + | Gt -> (>) + | Ge -> (>=) + + (* The functions below allows to build arithmetic expressions with their usual + operators (add, sub, etc) and with a partial simplification. *) + + let rec neg = function + | A a -> S.neg a + | Int i -> Int (-i) + | UnOp (Neg, v) -> v + | BinOp (Add, v1, v2) -> add (neg v1) (neg v2) + | BinOp (Sub, v1, v2) -> minus (neg v1) (neg v2) + | v -> apply_unop Neg v + + and add v1 v2 = match v1, v2 with + | Int i1, Int i2 -> Int (i1 + i2) + | Int 0, v | v, Int 0 -> v + | BinOp (Add, Int i1, v), Int i2 + | BinOp (Add, v, Int i1), Int i2 + | Int i1, BinOp (Add, Int i2, v) + | Int i1, BinOp (Add, v, Int i2) -> add (Int (i1 + i2)) v + | BinOp (Sub, Int i1, v), Int i2 + | Int i1, BinOp (Sub, Int i2, v) -> minus (Int (i1 + i2)) v + | BinOp (Sub, v, Int i1), Int i2 + | Int i1, BinOp (Sub, v, Int i2) -> add (Int (i1 - i2)) v + | A a, v -> S.addl a v + | v, A a -> S.addr v a + | _ -> apply_binop Add v1 v2 + + and minus v1 v2 = match v1, v2 with + | A a, v -> S.minusl a v + | v, A a -> S.minusr v a + | Int i1, Int i2 -> Int (i1 - i2) + | _, Int 0 -> v1 + | Int 0, _ -> neg v2 + | _ -> apply_binop Sub v1 v2 + + and mul v1 v2 = match v1, v2 with + | A a, v -> S.mull a v + | v, A a -> S.mulr v a + | Int i1, Int i2 -> Int (i1 * i2) + | Int 1, v | v, Int 1 -> v + | Int 0, _ | _, Int 0 -> Int 0 + | Int (-1), v | v, Int (-1) -> neg v + | _ -> apply_binop Mul v1 v2 + + and div v1 v2 = match v1, v2 with + | _, Int 0 -> raise (Invalid_argument "Arith.div") + | A a, v -> S.divl a v + | v, A a -> S.divr v a + | Int i1, Int i2 -> Int (i1 / i2) + | Int 1, v | v, Int 1 -> v + | Int 0, _ -> Int 0 + | Int (-1), v | v, Int (-1) -> neg v + | _ -> apply_binop Div v1 v2 + + and modulo v1 v2 = match v1, v2 with + | _, Int 0 -> raise (Invalid_argument "Arith.modulo") + | A a, v -> S.modl a v + | v, A a -> S.modr v a + | Int i1, Int i2 -> Int (i1 mod i2) + | Int 0, _ | _, Int 1 -> Int 0 + | _ -> apply_binop Mod v1 v2 + + and max v1 v2 = match v1, v2 with + | A a, v -> S.maxl a v + | v, A a -> S.maxr v a + | Int i1, Int i2 -> Int (Pervasives.max i1 i2) + | _ -> apply_binop Max v1 v2 + + and cond v1 rel v2 v3 v4 = match v1, v2 with + | Int i1, Int i2 when (int_op_of_rel rel) i1 i2 -> v3 + | Int _, Int _ -> v4 + | _ -> Cond (v1, rel, v2, v3, v4) + + let cmp is_large cmpal cmpar int_cmp v1 v2 = match v1, v2 with + | Int i1, Int i2 -> int_cmp i1 i2 + | A a, v -> cmpal a v + | v, A a -> cmpar v a + | _ when is_large -> v1 = v2 + | _ -> false + + let binop_false _ _ = false + + let lt = cmp false S.ltl S.ltr (<) + let le = cmp true S.lel S.ler (<=) + let gt = cmp false S.gtl S.gtr (>) + let ge = cmp true S.gel S.ger (>=) + + let op_of_unop = function + | Neg -> neg + + let op_of_binop = function + | Add -> add + | Sub -> minus + | Mul -> mul + | Div -> div + | Mod -> modulo + | Max -> max + + let op_of_relation = function + | Lt -> lt + | Le -> le + | Gt -> gt + | Ge -> ge + + let bool_of_cond = op_of_relation + + let f_compute v subs_res = match v, subs_res with + | A a, _ -> A (S.compute a) + | UnOp (unop, _), v :: _ -> (op_of_unop unop) v + | BinOp (binop, _, _), v1 :: v2 :: _ -> (op_of_binop binop) v1 v2 + | Cond (_, rel, _, _, _), v1 :: v2 :: v3 :: _ + when (op_of_relation rel) v1 v2 -> v3 + | Cond (_, rel, _, _, _), v1 :: v2 :: _ :: v4 :: _ + when (op_of_relation (opposite rel)) v1 v2 -> v4 + | _ -> fill_subs v subs_res + + (** [compute v] partially simplifies the arithmetic expression [v]. *) + + let compute v = fold f_compute v + + let abs v = cond (Int 0) Le v v (neg v) + + let f_replace_vars replacements v subs_res = match fill_subs v subs_res with + | Var x when Misc.String.Map.mem x replacements -> + Misc.String.Map.find x replacements + | v -> v + + let replace_vars replacements = fold (f_replace_vars replacements) + +end diff --git a/plugin/arithSig.ml b/plugin/arithSig.ml new file mode 100644 index 0000000..3d30cd1 --- /dev/null +++ b/plugin/arithSig.ml @@ -0,0 +1,151 @@ + +(** This module defines parameterized arithmetic expressions, i.e. arithmetic + expressions mixed with any other type. For instance, one can define + arithmetic expressions with function calls, arithmetic expressions with top + and bottom (the abstract interpretation constants), etc. *) + +(* Note: the feature 'mixed with any other type' is not used anymore. It would + make the code clearer to remove it. *) + + +module P = struct + + type relation = Lt | Gt | Le | Ge + + let is_large = function + | Le | Ge -> true + | Lt | Gt -> false + + let has_lower_type = function + | Lt | Le -> true + | Gt | Ge -> false + + let string_of_relation = function + | Lt -> "<" + | Le -> "<=" + | Gt -> ">" + | Ge -> ">=" + + let mk_strict = function + | Lt | Le -> Lt + | Gt | Ge -> Gt + + let mk_large = function + | Lt | Le -> Le + | Gt | Ge -> Ge + + let opposite = function + | Lt -> Ge + | Le -> Gt + | Gt -> Le + | Ge -> Lt + + type unop = Neg + + type binop = Add | Sub | Div | Mul | Mod | Max + + let string_of_unop = function + | Neg -> "-" + + let string_of_binop = function + | Add -> "+" + | Sub -> "-" + | Div -> "/" + | Mul -> "*" + | Mod -> "%" + | Max -> "max" + + type 'a tt = + | A of 'a + | Int of int + | Var of string + | UnOp of unop * 'a tt + | BinOp of binop * 'a tt * 'a tt + | Cond of 'a tt * relation * 'a tt * 'a tt * 'a tt (* ternary expressions *) + + let compare compare_a v1 v2 = match v1, v2 with + | A a1, A a2 -> compare_a a1 a2 + | A _, _ -> -1 + | _, A _ -> 1 + | _ -> Pervasives.compare v1 v2 + + let rec map f = function + | A a -> A (f a) + | Int i -> Int i + | Var x -> Var x + | UnOp (unop, v) -> UnOp (unop, map f v) + | BinOp (binop, v1, v2) -> BinOp (binop, map f v1, map f v2) + | Cond (v1, rel, v2, v3, v4) -> + Cond (map f v1, rel, map f v2, map f v3, map f v4) + + let fill_subs v subs = match v, subs with + | A _, _ | Int _, _ | Var _, _ -> v + | UnOp (unop, _), v :: _ -> UnOp (unop, v) + | BinOp (binop, _, _), v1 :: v2 :: _ -> BinOp (binop, v1, v2) + | Cond (_, rel, _, _, _), t1 :: t2 :: tif :: telse :: _ -> + Cond (t1, rel, t2, tif, telse) + | _ -> raise (Failure "ArithSig.fill_subs") (* wrong number of arguments *) + + let subs = function + | A _ | Int _ | Var _ -> [] + | UnOp (_, v) -> [v] + | BinOp (_, v1, v2) -> [v1 ; v2] + | Cond (t1, _, t2, tif, telse) -> [t1 ; t2 ; tif ; telse] + + let rec fold f v = + let subs_res = List.map (fold f) (subs v) in + f v subs_res + + let f_is_independent v subs_res = + let b = match v with A _ -> false | _ -> true in + List.fold_left (&&) true (b :: subs_res) + + (** [is_independent v] returns true if and only if the arithmetic expression + [v] does not mention a value of its parameter type. *) + + let is_independent v = fold f_is_independent v + + let f_replace replacements v subs_res = + let v = match v with + | Var x when List.mem_assoc x replacements -> List.assoc x replacements + | _ -> v in + fill_subs v subs_res + + let replace replacements v = fold (f_replace replacements) v + +end + +include P + + +module type S = sig + type t + + val to_string : t -> string + val to_cil_term : t -> Cil_types.term + + val compute : t -> t + val neg : t -> t tt + val addl : t -> t tt -> t tt + val addr : t tt -> t -> t tt + val minusl : t -> t tt -> t tt + val minusr : t tt -> t -> t tt + val mull : t -> t tt -> t tt + val mulr : t tt -> t -> t tt + val divl : t -> t tt -> t tt + val divr : t tt -> t -> t tt + val modl : t -> t tt -> t tt + val modr : t tt -> t -> t tt + val maxl : t -> t tt -> t tt + val maxr : t tt -> t -> t tt + val lel : t -> t tt -> bool + val ler : t tt -> t -> bool + val ltl : t -> t tt -> bool + val ltr : t tt -> t -> bool + val gel : t -> t tt -> bool + val ger : t tt -> t -> bool + val gtl : t -> t tt -> bool + val gtr : t tt -> t -> bool + + val compare : t -> t -> int +end diff --git a/plugin/cerco.ml b/plugin/cerco.ml new file mode 100644 index 0000000..788e84b --- /dev/null +++ b/plugin/cerco.ml @@ -0,0 +1,122 @@ + +type cost_id = + { + cost_id : string; + cost_incr : string; + extern_costs : string Misc.String.Map.t; + } +(** This file makes the interface between the cost plug-in and CerCo's + compiler. *) + + +let rec read_extern_cost_variables cin = + try + let s = input_line cin in + assert (String.contains s ' ') ; + let i = String.index s ' ' in + assert (String.length s > i + 1) ; + let fun_name = String.sub s 0 i in + let var_name = String.sub s (i+1) (String.length s - (i+1)) in + Misc.String.Map.add fun_name var_name (read_extern_cost_variables cin) + with End_of_file -> Misc.String.Map.empty + +(** [multifile_exists exts filename] returns true if and only if the file name + [filename] concatenated with an extension from the list [exts] exists. *) + +let multifile_exists exts filename = + let f b ext = b || (Sys.file_exists (filename ^ ext)) in + List.fold_left f false exts + +(** [fresh_multifile exts filename] returns a file name whose base is [filename] + and suffixed with an integer such that the result is fresh when concatenated + with any extension from the list [exts]. *) + +let fresh_multifile exts filename = + if not (multifile_exists exts filename) then filename + else + let rec aux i = + let new_filename = filename ^ (string_of_int i) in + if not (multifile_exists exts new_filename) then new_filename + else aux (i+1) in + aux 0 + +(** [index_of e l] returns the index of the element [e] in the list [l], if + any. *) + +let index_of e l = + let f (i, res) e' = + let res' = if e' = e then Some i else res in + (i+1, res') in + match snd (List.fold_left f (0, None) l) with + | None -> raise (Failure "Cerco.index_of") + | Some i -> i + +let acc_option lustre_option lustre_verify_option lustre_test_option = + if lustre_verify_option || lustre_test_option then "-remove-lustre-externals " + else + if lustre_option then "-lustre " + else "" + +(** [apply (filename, _)] apply CerCo's compiler on the file [filename]. The + result is a new C file with cost annotations, the name of the cost + variable, and the name of the cost update function. *) + +let apply acc_name lustre_option lustre_verify_option lustre_test_option + user_output_filename + (filename, _) = + let annotated_ext = "-instrumented.c" in + let asm_ext = ".s" in + let cerco_ext = ".cerco" in + let cerco_stack_ext = ".stack_cerco" in + let hex_ext = ".hex" in + let exts = + [annotated_ext ; asm_ext ; cerco_ext ; cerco_stack_ext ; hex_ext] in + let tmp_filename = + if user_output_filename <> "" then user_output_filename else + let tmp_filename = Filename.chop_extension filename in + fresh_multifile exts tmp_filename in + let acc_option = + acc_option lustre_option lustre_verify_option lustre_test_option in + let com_acc = + Printf.sprintf "%s -a %s -o %s %s" + acc_name acc_option tmp_filename filename in + let ext_tmp_filename ext = tmp_filename ^ ext in + let tmp_filenames = List.map ext_tmp_filename exts in + let index_of s = List.nth tmp_filenames (index_of s exts) in + let c_tmp_filename = index_of annotated_ext in + let s_tmp_filename = index_of asm_ext in + let cerco_tmp_filename = index_of cerco_ext in + let cerco_stack_tmp_filename = index_of cerco_stack_ext in + (* let hex_tmp_filename = index_of hex_ext in *) + let rm () = + let com = + "rm -rf " ^ s_tmp_filename ^ " " ^ + (if lustre_test_option then "" else cerco_tmp_filename) + (* ^ " " ^ hex_tmp_filename *) in + ignore (Sys.command com) in + if Sys.command com_acc <> 0 then + (rm () ; failwith "Error calling acc.") + else + (let (_, file) = Frontc.parse c_tmp_filename () in + let time = + let cin = open_in cerco_tmp_filename in + let cost_id = input_line cin in + let cost_incr = input_line cin in + let extern_cost_variables = read_extern_cost_variables cin in + close_in cin ; + {cost_id = cost_id; cost_incr = cost_incr; + extern_costs = extern_cost_variables} in + let stack = + try + let cin = try open_in cerco_stack_tmp_filename with _ -> raise Exit in + let cost_stack_id = input_line cin in + let cost_stack_max_id = input_line cin in + let cost_stack_incr = input_line cin in + let extern_cost_stack_variables = read_extern_cost_variables cin in + close_in cin ; + Some ({cost_id = cost_stack_max_id; cost_incr = cost_stack_incr; + extern_costs = extern_cost_stack_variables}, + cost_stack_id) + with Exit -> None in + rm () ; + (file, c_tmp_filename, time, stack)) diff --git a/plugin/completeMap.ml b/plugin/completeMap.ml new file mode 100644 index 0000000..ecea2b5 --- /dev/null +++ b/plugin/completeMap.ml @@ -0,0 +1,84 @@ + +(** This modules describes complete (and potentially finite) mappings. *) + + +(** The signature of the functor's parameter module. *) + +module type T = sig + type key + type 'a t + (** [keys] needs to be given for finite mappings, and needs to be [None] for + non finite mappings. *) + val keys : key list option + val mem : key -> 'a t -> bool + val find : key -> 'a t -> 'a + val add : key -> 'a -> 'a t -> 'a t + val empty : 'a t + val map : ('a -> 'b) -> 'a t -> 'b t + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b +end + +(** The result signature of the functor. *) + +module type S = sig + type key + type 'a t + val empty : 'a -> 'a t + val find : key -> 'a t -> 'a + val upd : key -> 'a -> 'a t -> 'a t + val map : ('a -> 'b) -> 'a t -> 'b t + (** Keys in case of finite mappings. *) + val keys : key list option + (** Only works on [keys]. Raises [Failure "CompleteMap.fold: not finite + domain"] is no keys. *) + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + val merge : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t + val cmp : ('a -> 'b -> bool -> bool) -> 'a t -> 'b t -> bool -> bool + val to_string : (key -> string) -> ('a -> string) -> 'a t -> string +end + +module Make (T : T) : S with type key = T.key = struct + + type key = T.key + + type 'a t = ('a * 'a T.t) + + let empty a = (a, T.empty) + + let find x (a, map) = if T.mem x map then T.find x map else a + + let (!!) = find + + let upd x b (a, map) = (a, T.add x b map) + + let map f (a, map) = (f a, T.map f map) + + let keys = T.keys + + let fold f cmap a = match T.keys with + | None -> raise (Failure "CompleteMap.fold: not finite domain") + | Some keys -> + List.fold_left (fun res key -> f key (find key cmap) res) a keys + + let f_merge f_default f_map ((a1, map1) as cmap1) ((a2, map2) as cmap2) a = + let f1 x v1 a = f_map x v1 (find x cmap2) a in + let f2 x v2 a = f_map x (find x cmap1) v2 a in + let a = T.fold f1 map1 a in + f_default a1 a2 (T.fold f2 map2 a) + + let merge f cmap1 cmap2 = + let f_default a1 a2 map = (f a1 a2, map) in + let f_map x v1 v2 map = T.add x (f v1 v2) map in + f_merge f_default f_map cmap1 cmap2 T.empty + + let cmp f cmap1 cmap2 a = + let f_default a1 a2 a = f a1 a2 a in + let f_map _ v1 v2 a = f v1 v2 a in + f_merge f_default f_map cmap1 cmap2 a + + let to_string string_of_key string_of_a (_, map) = + let f key a res = + res ^ "--KEY\n" ^ (string_of_key key) ^ "\n--VAL\n" ^ (string_of_a a) in + T.fold f map "" + +end diff --git a/plugin/compute.ml b/plugin/compute.ml new file mode 100644 index 0000000..fc70cdf --- /dev/null +++ b/plugin/compute.ml @@ -0,0 +1,2277 @@ + +(* TODO: transform precondition into assertions, transform added code into ghost + code. *) + +(** This module defines the main analysis of the plug-in. Its actions are: + - build the CFG of the program; + - initialize the static environment of analysis (parameters of the + functions, number of loops, etc); + - compute the cost of each function depending on the costs of the others; + - try to solve the inequations formed from the previous step so as to obtain + an independent cost for each function; + - save the results; + - add the annotations on the program. *) + + +(*** Exceptions ***) + +exception ASM_unsupported +exception Try_unsupported + +let string_of_exception = function + | ASM_unsupported -> "ASM instructions not supported" + | Try_unsupported -> "Try instructions not supported" + | Cost_value.Unknown_cost fun_name -> + "Cost for function " ^ fun_name ^ " not found." + | Cost_value.Unknown_prototype fun_name -> + "Prototype for function " ^ fun_name ^ " not found." + | e -> raise e + + +(*** Debug flag ***) + +let debug = ref false + + +(*** Helpers ***) + +let identity x = x + +let string_of_list sep f l = + let rec aux = function + | [] -> "" + | [e] -> f e + | e :: l -> (f e) ^ sep ^ (aux l) in + aux l + +let integer_term term = Logic_const.term term Cil_types.Linteger + +let tinteger i = + let cint64 = Cil_types.CInt64 (My_bigint.of_int i, Cil_types.IInt, None) in + let iterm = Cil_types.TConst cint64 in + integer_term iterm + +let cil_logic_int_var x = + Logic_const.tvar (Cil_const.make_logic_var x Cil_types.Linteger) + +let current_kf obj = match obj#current_kf with + | None -> raise (Failure "Compute.current_kf") + | Some kf -> kf + +let add_loop_annot obj stmt annot = + let annot = Cil_types.User annot in + let kf = + Cil.get_original_kernel_function (Cil.copy_visit ()) (current_kf obj) in + Queue.add (fun () -> Annotations.add kf stmt [Ast.self] annot) + obj#get_filling_actions + +let add_loop_annots obj stmt annots = List.iter (add_loop_annot obj stmt) annots + +let mk_invariant pred = + Logic_const.new_code_annotation (Cil_types.AInvariant ([], true, pred)) + +let mk_variant term = + Logic_const.new_code_annotation (Cil_types.AVariant (term, None)) + +let mk_fun_cost_pred rel cost_id cost = + let cost_var = Cil_const.make_logic_var cost_id Cil_types.Linteger in + let cost_var = Logic_const.tvar cost_var in + let old_cost = Logic_const.told cost_var in + let new_cost = Cil_types.TBinOp (Cil_types.PlusA, old_cost, cost) in + let new_cost = integer_term new_cost in + Logic_const.prel (rel, cost_var, new_cost) + +(** Casts may get in the way when looking for a loop counter, just remove + them. *) + +let rec remove_casts e = match e.Cil_types.enode with + | Cil_types.Lval lval -> + { e with Cil_types.enode = Cil_types.Lval (remove_casts_lval lval) } + | Cil_types.SizeOfE e -> + { e with Cil_types.enode = Cil_types.SizeOfE (remove_casts e) } + | Cil_types.AlignOfE e -> + { e with Cil_types.enode = Cil_types.AlignOfE (remove_casts e) } + | Cil_types.UnOp (unop, e, typ) -> + { e with Cil_types.enode = Cil_types.UnOp (unop, remove_casts e, typ) } + | Cil_types.BinOp (binop, e1, e2, typ) -> + let enode = + Cil_types.BinOp (binop, remove_casts e1, remove_casts e2, typ) in + { e with Cil_types.enode } + | Cil_types.CastE (_, e) -> remove_casts e + | Cil_types.AddrOf lval -> + { e with Cil_types.enode = Cil_types.AddrOf (remove_casts_lval lval) } + | Cil_types.StartOf lval -> + { e with Cil_types.enode = Cil_types.StartOf (remove_casts_lval lval) } + | Cil_types.Info (e, info) -> + { e with Cil_types.enode = Cil_types.Info (remove_casts e, info) } + | _ -> e + +and remove_casts_lval (lhost, offset) = + (remove_casts_lhost lhost, remove_casts_offset offset) + +and remove_casts_lhost = function + | Cil_types.Mem e -> Cil_types.Mem (remove_casts e) + | lhost -> lhost + +and remove_casts_offset = function + | Cil_types.Field (fieldinfo, offset) -> + Cil_types.Field (fieldinfo, remove_casts_offset offset) + | Cil_types.Index (e, offset) -> + Cil_types.Index (remove_casts e, remove_casts_offset offset) + | offset -> offset + +let rec exp_is_var name e = match (remove_casts e).Cil_types.enode with + | Cil_types.Lval (Cil_types.Var v, _) -> v.Cil_types.vname = name + | Cil_types.Info (e, _) -> exp_is_var name e + | _ -> false + +let has_fun_type varinfo = match varinfo.Cil_types.vtype with + | Cil_types.TFun _ -> true + | _ -> false + +let formals_of_varinfo varinfo = match varinfo.Cil_types.vtype with + | Cil_types.TFun (_, args, _, _) -> + List.map (fun (x, t, _) -> Cil.makeVarinfo false true x t) + (Cil.argsToList args) + | _ -> assert false (* do not use on these arguments *) + +let dummy_location = (Lexing.dummy_pos, Lexing.dummy_pos) + +let dummy_varinfo = Cil.makeVarinfo false false "" (Cil_types.TVoid []) + +let make_list n a = + let rec aux acc i = if i >= n then acc else aux (a :: acc) (i+1) in + aux [] 0 + +let rec stmt_subs stmt = + let added = match stmt.Cil_types.skind with + | Cil_types.If (_, block1, block2, _) + | Cil_types.TryFinally (block1, block2, _) + | Cil_types.TryExcept (block1, _, block2, _) -> + (block_subs block1) @ (block_subs block2) + | Cil_types.Switch (_, block, _, _) + | Cil_types.Loop (_, block, _, _, _) + | Cil_types.Block block -> block_subs block + | Cil_types.UnspecifiedSequence l -> + List.map (fun (stmt, _, _, _, _) -> stmt) l + | _ -> [] in + stmt :: added + +and block_subs block = List.flatten (List.map stmt_subs block.Cil_types.bstmts) + +let rec first_stmt block = match block.Cil_types.bstmts with + | [] -> None + | stmt :: _ -> match stmt.Cil_types.skind with + | Cil_types.Block block -> first_stmt block + | _ -> Some stmt + +let stmt_is_break stmt = match stmt.Cil_types.skind with + | Cil_types.Break _ -> true + | _ -> false + +let starts_with_break block = match first_stmt block with + | Some stmt -> + (match stmt.Cil_types.skind with + | Cil_types.Goto (stmt_ref, _) -> stmt_is_break !stmt_ref + | _ -> stmt_is_break stmt) + | _ -> false + +let rec last = function + | [] -> None + | [e] -> Some e + | _ :: l -> last l + +let rec last_stmt block = match last block.Cil_types.bstmts with + | None -> None + | Some stmt -> match stmt.Cil_types.skind with + | Cil_types. Block block -> last_stmt block + | _ -> Some stmt + +module IntSet = Misc.Int.Set +module IntMap = Misc.Int.Map +module IntCMap = Misc.Int.CMap + + +(*** Temporary variable name generator ***) + +module GenName = struct + + let prefix = ref "" + let index = ref 0 + + let set_prefix prf = prefix := prf + let reset () = index := 0 + + let concat suffix = !prefix ^ "_" ^ suffix + + let fresh () = + let s = !prefix ^ (string_of_int !index) in + index := !index + 1 ; + s + + let rec freshes n = if n = 0 then [] else (freshes (n-1)) @ [fresh ()] + + let fresh_varinfo fundec = + Cil.makeTempVar fundec ~name:(fresh ()) Cil.intType + + let freshes_varinfo fundec n = + let vars = freshes n in + List.map (fun name -> Cil.makeTempVar fundec ~name Cil.intType) vars + +end + + +(*** Debug helpers ***) + +let string_of_intset set = + IntSet.fold (fun i s -> s ^ (string_of_int i) ^ " ") set "" +let string_of_intset_intmap map = + let f i set s = Printf.sprintf "%s%d: %s\n" s i (string_of_intset set) in + IntMap.fold f map "" + +class print_CFG prj = object inherit Visitor.frama_c_copy prj as super + + method vfunc func = + Format.printf "*** %s ***\n\n%!" func.Cil_types.svar.Cil_types.vname ; + List.iter + (fun stmt -> + Format.printf "%d: %a\n--> %!" stmt.Cil_types.sid Cil.d_stmt stmt ; + List.iter (fun stmt -> Format.printf "%d %!" stmt.Cil_types.sid) + stmt.Cil_types.succs ; + Format.printf "\n\n%!") + func.Cil_types.sallstmts ; + Format.printf "\n\n%!" ; + Cil.SkipChildren + +end + +let print_CFG () = + let print_CFG_prj = + File.create_project_from_visitor "print_CFG" (new print_CFG) in + let f () = () in + Project.on print_CFG_prj f () + +class loop_exit prj = object inherit Visitor.frama_c_copy prj as super + + method vstmt_aux stmt = + let _ = match stmt.Cil_types.skind with + | Cil_types.Loop (_, block, _, _, _) -> + (match first_stmt block with + | Some stmt -> + (match stmt.Cil_types.skind with + | Cil_types.If (_, _, block, _) -> + (match first_stmt block with + | Some stmt -> + (match stmt.Cil_types.skind with + | Cil_types.Break _ -> + Format.printf "Loop exit: %!" ; + List.iter + (fun stmt -> Format.printf "%d %!" stmt.Cil_types.sid) + stmt.Cil_types.succs ; + Format.printf "\n%!" + | _ -> Format.printf "If but no break\n%!") + | _ -> Format.printf "If but no child\n%!") + | _ -> Format.printf "Loop but no if\n%!") + | _ -> Format.printf "Loop but no child\n%!") + | _ -> () in + Cil.DoChildren + +end + +let loop_exit () = + let loop_exit_prj = + File.create_project_from_visitor "loop_exit" (new loop_exit) in + let f () = () in + Format.printf "\n%!" ; + Project.on loop_exit_prj f () + + +(*** Make CFG ***) + +class make_CFG prj = object inherit Visitor.frama_c_copy prj as super + + method vfile file = + Cfg.clearFileCFG file ; + Cfg.computeFileCFG file ; + Cil.SkipChildren + +end + +let make_CFG () = + let make_CFG_prj = + File.create_project_from_visitor "make_CFG" (new make_CFG) in + let f () = () in + Project.on make_CFG_prj f () + + +(*** Control points that are gotoed to, control points of a loop. Those will + help checking that a loop has a supported form. ***) + +module PointsInfo = struct + + type t = { gotoed : IntSet.t IntMap.t ; loop_points : IntSet.t IntMap.t } + + let empty = { gotoed = IntMap.empty ; loop_points = IntMap.empty } + + let gotoed points_info = points_info.gotoed + + let loop_points points_info = points_info.loop_points + + let mem_gotoed to_id points_info = IntMap.mem to_id (gotoed points_info) + + let find_gotoed to_id points_info = IntMap.find to_id (gotoed points_info) + + let add_gotoed to_id to_from_ids points_info = + let gotoed = IntMap.add to_id to_from_ids (gotoed points_info) in + { points_info with gotoed } + + let mem_loop_points loop_id points_info = + IntMap.mem loop_id (loop_points points_info) + + let find_loop_points loop_id points_info = + IntMap.find loop_id (loop_points points_info) + + let add_loop_points loop_id ids points_info = + let loop_points = IntMap.add loop_id ids (loop_points points_info) in + { points_info with loop_points } + +end + +(*** PointsInfo for each function ***) + +module PointsInfos = struct + + type t = PointsInfo.t Misc.String.Map.t + + let empty = Misc.String.Map.empty + + let mem = Misc.String.Map.mem + + let add = Misc.String.Map.add + + let find = Misc.String.Map.find + + let add_gotoed fun_name to_id to_from_ids points_infos = + let points_info = + if mem fun_name points_infos then find fun_name points_infos + else PointsInfo.empty in + let points_info = PointsInfo.add_gotoed to_id to_from_ids points_info in + add fun_name points_info points_infos + + let add_loop_points fun_name loop_id ids points_infos = + let points_info = + if mem fun_name points_infos then find fun_name points_infos + else PointsInfo.empty in + let points_info = PointsInfo.add_loop_points loop_id ids points_info in + add fun_name points_info points_infos + +end + +class points_infos points_infos prj = +object inherit Visitor.frama_c_copy prj as super + + val mutable current_fun_name = "" + + method vstmt_aux stmt = + (* because it is initialized in vfunc *) + assert (PointsInfos.mem current_fun_name !points_infos) ; + let points_info = PointsInfos.find current_fun_name !points_infos in + let _ = match stmt.Cil_types.skind with + | Cil_types.Goto (stmt_ref, _) -> + let from_id = stmt.Cil_types.sid in + let to_id = !stmt_ref.Cil_types.sid in + let to_from_ids = + if PointsInfo.mem_gotoed to_id points_info then + PointsInfo.find_gotoed to_id points_info + else IntSet.empty in + let to_from_ids = IntSet.add from_id to_from_ids in + points_infos := + PointsInfos.add_gotoed current_fun_name to_id to_from_ids + !points_infos + | Cil_types.Loop (_, block, _, _, _) -> + let loop_id = stmt.Cil_types.sid in + let ids = + if PointsInfo.mem_loop_points loop_id points_info then + PointsInfo.find_loop_points loop_id points_info + else IntSet.empty in + let ids = IntSet.add loop_id ids in + let f_stmts stmt = stmt :: (stmt_subs stmt) in + let stmts = List.flatten (List.map f_stmts block.Cil_types.bstmts) in + let f ids stmt = IntSet.add stmt.Cil_types.sid ids in + let ids = List.fold_left f ids stmts in + points_infos := + PointsInfos.add_loop_points current_fun_name loop_id ids !points_infos + | _ -> () in + Cil.DoChildren + + method vfunc fundec = + current_fun_name <- fundec.Cil_types.svar.Cil_types.vname ; + points_infos := + PointsInfos.add current_fun_name PointsInfo.empty !points_infos ; + Cil.DoChildren + +end + +(** [points_infos ()] returns a mapping that associates to each function of the + current program in the currently opened project the control points that are + gotoed to and the control points of loops. *) + +let points_infos () : PointsInfos.t = + let map = ref PointsInfos.empty in + let points_infos_prj = + File.create_project_from_visitor "points_infos" (new points_infos map) in + let f () = !map in + Project.on points_infos_prj f () + + +(*** Value (flat) domain extremes ***) + +module BotAndTop = struct + + type t = Bot | Top + + let compare = Pervasives.compare + + let to_string = function + | Bot -> "bot" + | Top -> "top" + + let to_cil_term _ = assert false (* should not be used *) + + let top = ArithSig.A Top + let bot = ArithSig.A Bot + + let neg = function + | Top -> top + | Bot -> bot + + let addl a v = match a, v with + | Bot, _ | _, ArithSig.A Bot -> bot + | Top, _ -> top + + let addr v a = addl a v + + let minusl a v = match a, v with + | Bot, _ | _, ArithSig.A Bot -> bot + | Top, _ -> top + + let minusr v a = match v, a with + | _, Bot | ArithSig.A Bot, _ -> bot + | _, Top -> top + + let mull a v = match a, v with + | Bot, _ | _, ArithSig.A Bot -> bot + | _, ArithSig.Int 0 -> ArithSig.Int 0 + | Top, _ -> top + + let mulr v a = mull a v + + let divl a v = match a, v with + | Bot, _ | _, ArithSig.A Bot | _, ArithSig.Int 0 -> bot + | Top, _ -> top + + let divr v a = match v, a with + | _, Bot | ArithSig.A Bot, _ -> bot + | _, Top -> top + + let modl a v = match a, v with + | Bot, _ | _, ArithSig.A Bot | _, ArithSig.Int 0 -> bot + | Top, _ -> top + + let modr v a = match v, a with + | _, Bot | ArithSig.A Bot, _ -> bot + | _, Top -> top + + let maxl a v = match a, v with + | Bot, _ | _, ArithSig.A Bot -> bot + | Top, _ -> top + + let maxr v a = maxl a v + + let lel a v = match a, v with + | Bot, _ -> true + | Top, ArithSig.A Top -> true + | Top, _ -> false + + let ler v a = match v, a with + | _, Top -> true + | ArithSig.A Bot, Bot -> true + | _, Bot -> false + + let ltl a v = match a, v with + | Bot, ArithSig.A Bot -> false + | Bot, _ -> true + | Top, _ -> false + + let ltr v a = match v, a with + | ArithSig.A Top, Top -> false + | _, Top -> true + | _, Bot -> false + + let gel a v = ler v a + + let ger v a = lel a v + + let gtl a v = ltr v a + + let gtr v a = ltl a v + + let compute v = v + +end + + +(*** Arithmetic expressions flat domain ***) + +module ArithValDom = struct + + include Arith.Make (BotAndTop) + + let top = A BotAndTop.Top + + let bot = A BotAndTop.Bot + + let join v1 v2 = match v1, v2 with + | A BotAndTop.Bot, v | v, A BotAndTop.Bot -> v + | _ when v1 = v2 -> v1 + | _ -> A BotAndTop.Top + + let widen = join + + let narrow v1 v2 = match v1, v2 with + | A BotAndTop.Top, A _ -> v1 + | A BotAndTop.Top, _ -> v2 + | _ -> v1 + + let f_is_concrete v subs_res = + let b = match v with + | A _ -> false + | _ -> true in + List.fold_left (&&) true (b :: subs_res) + + let is_concrete v = fold f_is_concrete v + + let add_list l = List.fold_left add (Int 0) l + + let last_value rel _ exit_value increment = + let rel_added = of_int (if is_large rel then 0 else 1) in + let rel_op = if has_lower_type rel then minus else add in + add (rel_op exit_value rel_added) increment + + let iteration_nb init_value counter increment = + div (minus (of_var counter) init_value) increment + +end + +module Domain = ArithValDom + + +(*** Abstract cost ***) + +module AbsCost = struct + + include (Cost_value.Make (ArithValDom)) + +end + + +(*** Requirements for loop termination ***) + +module Require = struct + + type t = + { relation : Domain.relation ; + init_value : Domain.t ; + exit_value : Domain.t ; + increment : Domain.t } + + let compare = Pervasives.compare + + let relation require = require.relation + let init_value require = require.init_value + let exit_value require = require.exit_value + let increment require = require.increment + + let merge f require1 require2 = + (* each loop has a single condition relation *) + assert (relation require1 = relation require2) ; + { relation = relation require1 ; + init_value = f (init_value require1) (init_value require2) ; + exit_value = f (exit_value require1) (exit_value require2) ; + increment = f (increment require1) (increment require2) } + + let join = merge Domain.join + let widen = merge Domain.widen + let narrow = merge Domain.narrow + + let le require1 require2 = + (* each loop has a single condition relation *) + (relation require1 = relation require2) && + (Domain.le (init_value require1) (init_value require2)) && + (Domain.le (exit_value require1) (exit_value require2)) && + (Domain.le (increment require1) (increment require2)) + + let make relation init_value exit_value increment = + { relation ; init_value ; exit_value ; increment } + + let replace_vars replacements require = + let init_value = Domain.replace_vars replacements (init_value require) in + let exit_value = Domain.replace_vars replacements (exit_value require) in + let increment = Domain.replace_vars replacements (increment require) in + { require with init_value ; exit_value ; increment } + + let to_string require = + Printf.sprintf "%s %s %s %s" + (Domain.string_of_relation (relation require)) + (Domain.to_string (init_value require)) + (Domain.to_string (exit_value require)) + (Domain.to_string (increment require)) + +end + +(*** Associates Require to control points ***) + +module Requires = struct + + module M = Misc.Int.Map + + type t = Require.t M.t + + let empty = M.empty + + let mem = M.mem + + let find = M.find + + let merge f = + let f_merge _ require1 require2 = match require1, require2 with + | None, None -> None + | Some require, None | None, Some require -> Some require + | Some require1, Some require2 -> Some (f require1 require2) in + M.merge f_merge + + let join = merge Require.join + let widen = merge Require.widen + let narrow = merge Require.narrow + + let le requires1 requires2 = + let f id require1 res = + res && (mem id requires2) && (Require.le require1 (find id requires2)) in + M.fold f requires1 true + + let cardinal = M.cardinal + + let fold f requires a = + let f' _ require a = f require a in + M.fold f' requires a + + let add = M.add + + let replace_vars replacements = M.map (Require.replace_vars replacements) + + let to_string requires = + let f id require res = + Printf.sprintf "%s%d: %s\n%!" res id (Require.to_string require) in + M.fold f requires "" + +end + + +(*** Point kind ***) + +module LoopInfo = struct + + type t = + { tmp_loop : Cil_types.varinfo ; + counter : string ; + relation : Domain.relation ; + exit_exp : Cil_types.exp ; + increment : Cil_types.exp ; + prev_stmts : (Cil_types.stmt * int (* position *)) list ; + last_stmts : Cil_types.stmt list } + + let tmp_loop loop_info = loop_info.tmp_loop + + let counter loop_info = loop_info.counter + + let relation loop_info = loop_info.relation + + let exit_exp loop_info = loop_info.exit_exp + + let increment loop_info = loop_info.increment + + let prev_stmts loop_info = loop_info.prev_stmts + + let last_stmts loop_info = loop_info.last_stmts + + let make tmp_loop counter relation exit_exp increment prev_stmts last_stmts = + { tmp_loop ; counter ; relation ; exit_exp ; increment ; + prev_stmts ; last_stmts } + + +end + +module PointKind = struct + + type t = + | LoopStart of LoopInfo.t + | LoopExit of LoopInfo.t + | ULoopStart (* start of an unrecognized loop *) + | ULoopExit (* exit of an unrecognized loop *) + | RegularPoint + + let is_recognized_loop_start = function + | LoopStart _ -> true + | _ -> false + + let tmp_loop = function + | LoopStart loop_info -> LoopInfo.tmp_loop loop_info + | _ -> raise (Invalid_argument "PointKind.tmp_loop") + +end + +module PointKinds = struct + + type t = PointKind.t IntMap.t + + let empty = IntMap.empty + let add = IntMap.add + let mem = IntMap.mem + let find = IntMap.find + let fold = IntMap.fold + let dom point_kinds = List.map fst (IntMap.bindings point_kinds) + + let mem_loop_start point point_kinds = + mem point point_kinds && + (PointKind.is_recognized_loop_start (find point point_kinds)) + + let find_tmp_loop point point_kinds = + let error = Invalid_argument "PointKinds.find_tmp_loop" in + PointKind.tmp_loop (IntMap.error_find point point_kinds error) + +end + + +(*** Fun infos ***) + +module FunInfo = struct + + type local_vars = (Cil_types.varinfo * string) list * Cil_types.varinfo list + + type t = + { prototype : local_vars ; + (* exactly one start and one end points in Frama-C's CFG *) + start_and_end_points : (int * int) option ; + nb_loops : int ; + point_kinds : PointKinds.t } + + let empty = + { prototype = ([], []) ; start_and_end_points = None ; nb_loops = 0 ; + point_kinds = PointKinds.empty } + + let make formals locals nb_loops start_and_end_points point_kinds = + { prototype = (formals, locals) ; + nb_loops ; start_and_end_points ; point_kinds } + + let prototype fun_info = + List.map (fun (x, _) -> x.Cil_types.vname) (fst fun_info.prototype) + + let start_and_end_points fun_info = fun_info.start_and_end_points + + let formals_and_locals fun_info = fun_info.prototype + + let point_kinds fun_info = fun_info.point_kinds + + let mem_point point fun_info = PointKinds.mem point fun_info.point_kinds + + let find_point point fun_info = PointKinds.find point fun_info.point_kinds + + let points fun_info = PointKinds.dom fun_info.point_kinds + + let nb_loops fun_info = fun_info.nb_loops + + let add_nb_loops fun_info = + let nb_loops = fun_info.nb_loops + 1 in + { fun_info with nb_loops } + + let mem_loop_start point fun_info = + PointKinds.mem_loop_start point fun_info.point_kinds + + let find_tmp_loop point fun_info = + PointKinds.find_tmp_loop point fun_info.point_kinds + +end + +module FunInfos = struct + + type t = FunInfo.t Misc.String.Map.t + + let empty = Misc.String.Map.empty + + let prototypes = Misc.String.Map.map FunInfo.prototype + + let mem = Misc.String.Map.mem + + let add + fun_name formals locals nb_loops start_and_end_points point_kinds + fun_infos = + let fun_info = + FunInfo.make formals locals nb_loops start_and_end_points point_kinds in + Misc.String.Map.add fun_name fun_info fun_infos + + let start_and_end_points fun_name fun_infos = + let error = Invalid_argument "FunInfos.start_and_end_points" in + let fun_info = Misc.String.Map.error_find fun_name fun_infos error in + FunInfo.start_and_end_points fun_info + + let formals_and_locals fun_name fun_infos = + let error = Invalid_argument "FunInfos.formals_and_locals" in + let fun_info = Misc.String.Map.error_find fun_name fun_infos error in + FunInfo.formals_and_locals fun_info + + let mem_point fun_name point fun_infos = + Misc.String.Map.mem fun_name fun_infos && + FunInfo.mem_point point (Misc.String.Map.find fun_name fun_infos) + + let find_point fun_name point fun_infos = + FunInfo.find_point point (Misc.String.Map.find fun_name fun_infos) + + let points fun_name fun_infos = + let error = Invalid_argument "FunInfos.points" in + FunInfo.points (Misc.String.Map.error_find fun_name fun_infos error) + + let nb_loops fun_name fun_infos = + let error = Invalid_argument "FunInfos.nb_loops" in + FunInfo.nb_loops (Misc.String.Map.error_find fun_name fun_infos error) + + let add_nb_loops fun_name fun_infos = + let error = Invalid_argument "FunInfos.add_nb_loops" in + let fun_info = Misc.String.Map.error_find fun_name fun_infos error in + let fun_info = FunInfo.add_nb_loops fun_info in + Misc.String.Map.add fun_name fun_info fun_infos + + let mem_loop_start fun_name point fun_infos = + Misc.String.Map.mem fun_name fun_infos && + FunInfo.mem_loop_start point (Misc.String.Map.find fun_name fun_infos) + + let find_tmp_loop fun_name point fun_infos = + let error = Invalid_argument "FunInfos.find_tmp_loop" in + let fun_info = Misc.String.Map.error_find fun_name fun_infos error in + FunInfo.find_tmp_loop point fun_info + + let point_kinds fun_name fun_infos = + let error = Invalid_argument "FunInfos.point_kinds" in + let fun_info = Misc.String.Map.error_find fun_name fun_infos error in + FunInfo.point_kinds fun_info + +end + + +(*** Static environment ***) + +module StaticEnv = struct + + type t = + { fname : string ; + f_old_name : string ; + cost_id : string ; + cost_incr : string ; + cost_varinfo : Cil_types.varinfo ; + fun_infos : FunInfos.t ; + globals : Misc.String.Set.t ; + extern_costs : string Misc.String.Map.t } + + let init fname f_old_name cost_id cost_incr extern_costs = + { fname ; f_old_name ; cost_id ; cost_incr ; cost_varinfo = dummy_varinfo ; + fun_infos = FunInfos.empty ; + globals = Misc.String.Set.empty ; extern_costs } + + let fname static_env = static_env.fname + + let f_old_name static_env = static_env.f_old_name + + let prototypes static_env = FunInfos.prototypes static_env.fun_infos + + let add_fun_infos + fun_name formals locals nb_loops start_and_end_points point_kinds + static_env = + let fun_infos = + FunInfos.add fun_name formals locals nb_loops start_and_end_points + point_kinds static_env.fun_infos in + { static_env with fun_infos } + + let globals static_env = static_env.globals + + let add_globals x static_env = + let globals = Misc.String.Set.add x (globals static_env) in + { static_env with globals } + + let formals_and_locals fun_name static_env = + FunInfos.formals_and_locals fun_name static_env.fun_infos + + let locals fun_name static_env = snd (formals_and_locals fun_name static_env) + let formals fun_name static_env = fst (formals_and_locals fun_name static_env) + + let is_local fun_name x static_env = + let f varinfo = varinfo.Cil_types.vname = x in + List.exists f (locals fun_name static_env) + + let is_formal fun_name x static_env = + let (formals, locals) = formals_and_locals fun_name static_env in + let f_local varinfo = varinfo.Cil_types.vname <> x in + let f_formal (varinfo, _) = varinfo.Cil_types.vname = x in + (List.for_all f_local locals) && (List.exists f_formal formals) + + let is_global fun_name x static_env = + let (formals, locals) = formals_and_locals fun_name static_env in + let f_local varinfo = varinfo.Cil_types.vname <> x in + let f_formal (varinfo, _) = varinfo.Cil_types.vname <> x in + (List.for_all f_local locals) && (List.for_all f_formal formals) && + (Misc.String.Set.mem x (globals static_env)) + + let cost_id static_env = static_env.cost_id + + let cost_varinfo static_env = static_env.cost_varinfo + + let cost_incr static_env = static_env.cost_incr + + let set_cost_varinfo cost_varinfo static_env = + { static_env with cost_varinfo } + + let mem_point fun_name point static_env = + FunInfos.mem_point fun_name point static_env.fun_infos + + let find_point fun_name point static_env = + FunInfos.find_point fun_name point static_env.fun_infos + + let extern_costs static_env = static_env.extern_costs + + let start_and_end_points fun_name static_env = + FunInfos.start_and_end_points fun_name static_env.fun_infos + + let mem_fun_name fun_name static_env = + FunInfos.mem fun_name static_env.fun_infos + + let points fun_name static_env = + FunInfos.points fun_name static_env.fun_infos + + let nb_loops fun_name static_env = + FunInfos.nb_loops fun_name static_env.fun_infos + + let add_nb_loops fun_name static_env = + let fun_infos = FunInfos.add_nb_loops fun_name static_env.fun_infos in + { static_env with fun_infos } + + let mem_loop_start fun_name point static_env = + FunInfos.mem_loop_start fun_name point static_env.fun_infos + + let find_tmp_loop fun_name point static_env = + FunInfos.find_tmp_loop fun_name point static_env.fun_infos + + let point_kinds fun_name static_env = + FunInfos.point_kinds fun_name static_env.fun_infos + +end + + +(*** Initializations ***) + +let special_point f body = match f body with + | None -> None + | Some stmt -> Some stmt.Cil_types.sid + +let start_point = special_point first_stmt + +let end_point = special_point last_stmt + +let make_start_and_end_points start_point end_point = + match start_point, end_point with + | None, _ | _, None -> None + | Some start_point, Some end_point -> Some (start_point, end_point) + +let make_tmp_names formals = + let f varinfo = (varinfo, GenName.concat varinfo.Cil_types.vname) in + List.map f formals + +let rec extract_added_value counter e = match e.Cil_types.enode with + | Cil_types.BinOp (Cil_types.PlusA, e1, e2, _) when exp_is_var counter e1 -> + Some (counter, e2) + | Cil_types.BinOp (Cil_types.MinusA, e1, e2, typ) + when exp_is_var counter e1 -> + let enode = Cil_types.UnOp (Cil_types.Neg, e2, typ) in + let e2 = { e2 with Cil_types.enode = enode } in + Some (counter, e2) + | Cil_types.CastE (_, e) -> extract_added_value counter e + | _ -> + if !debug then + Format.printf + "Could not find added increment value for counter %s in %a.\n%!" + counter Cil.d_exp e ; + None + +let extract_increment block = + let open Misc.Option in + last_stmt block >>= + (fun stmt -> match stmt.Cil_types.skind with + | Cil_types.Instr (Cil_types.Set ((Cil_types.Var v, _), e, _)) -> + extract_added_value v.Cil_types.vname e + | _ -> + if !debug then + Format.printf + "Could not find increment instruction; found %a instead.\n%!" + Cil.d_stmt stmt ; + None) + +let extract_guard block (counter, increment) = + let open Misc.Option in + first_stmt block >>= + (fun stmt -> match stmt.Cil_types.skind with + | Cil_types.If (e, _, block, _) when starts_with_break block -> + (match e.Cil_types.enode with + | Cil_types.BinOp (rel, e1, e2, _) + when exp_is_var counter e1 && Domain.is_supported_rel rel -> + Some (counter, Domain.rel_of_cil_binop rel, e2, increment) + | Cil_types.BinOp (rel, e1, e2, _) + when exp_is_var counter e2 && Domain.is_supported_rel rel -> + let rel = Domain.rel_of_cil_binop rel in + let rel = Domain.opposite rel in + Some (counter, rel, e1, increment) + | _ -> + if !debug then + Format.printf "Unsupported guard condition %a on counter %s.\n%!" + Cil.d_exp e counter ; + None) + | Cil_types.If (_, _, block, _) -> + if !debug then + Format.printf "Loop not guarded by a break:\n%a\n%!" Cil.d_block block ; + None + | _ -> + if !debug then Format.printf "Loop not guarded:\n%a\n%!" Cil.d_stmt stmt ; + None) + +let add_point_kinds + start_id loop_start_info last_stmts loop_exit_info point_kinds = + let point_kinds = PointKinds.add start_id loop_start_info point_kinds in + let f_last_stmts point_kinds stmt = + PointKinds.add stmt.Cil_types.sid loop_exit_info point_kinds in + List.fold_left f_last_stmts point_kinds last_stmts + +let add_loop_point_kinds id tmp_loop exps prev_stmts last_stmts point_kinds = + match exps with + | None -> + let loop_start_info = PointKind.ULoopStart in + let loop_exit_info = PointKind.ULoopExit in + add_point_kinds id loop_start_info last_stmts loop_exit_info point_kinds + | Some (counter, relation, exit_exp, increment) -> + let loop_info = + LoopInfo.make + tmp_loop counter relation exit_exp increment prev_stmts last_stmts in + let loop_start_info = PointKind.LoopStart loop_info in + let loop_exit_info = PointKind.LoopExit loop_info in + add_point_kinds id loop_start_info last_stmts loop_exit_info point_kinds + +let loop_exits loop_points body = + let f_exists stmt = not (IntSet.mem stmt.Cil_types.sid loop_points) in + let f stmt = List.exists f_exists stmt.Cil_types.succs in + List.filter f (block_subs body) + +let stmt_point_kinds fundec points_info point_kinds stmt = + let id = stmt.Cil_types.sid in + match stmt.Cil_types.skind with + | Cil_types.Loop (_, body, _, _, _) -> + let open Misc.Option in + assert (PointsInfo.mem_loop_points id points_info) ; + let loop_points = PointsInfo.find_loop_points id points_info in + let tmp_loop = GenName.fresh_varinfo fundec in + let exps = extract_increment body >>= extract_guard body in + let f_preds res pred = + let pred_id = pred.Cil_types.sid in + if IntSet.mem pred_id loop_points then res + else + let succs_id = + List.map (fun stmt -> stmt.Cil_types.sid) pred.Cil_types.succs in + let opt_pos = Misc.List.pos id succs_id in + (* otherwise pred would not be a predecessor of the loop *) + assert (opt_pos <> None) ; + (pred, Misc.Option.extract opt_pos) :: res in + let prev_stmts = + List.fold_left f_preds [] stmt.Cil_types.preds in + let last_stmts = loop_exits loop_points body in + let last_stmts = match last_stmt body with + | None -> last_stmts + | Some last_stmt -> last_stmt :: last_stmts in + add_loop_point_kinds id tmp_loop exps prev_stmts last_stmts point_kinds + | _ when PointKinds.mem id point_kinds -> point_kinds + | _ -> PointKinds.add id PointKind.RegularPoint point_kinds + +class initialize points_infos static_env prj = +object inherit Visitor.frama_c_copy prj as super + + method vglob_aux glob = + let _ = match glob with + | Cil_types.GVarDecl (_, varinfo, _) when has_fun_type varinfo -> + GenName.reset () ; + GenName.set_prefix "__tmp" ; + let fun_name = varinfo.Cil_types.vname in + let formals = formals_of_varinfo varinfo in + let formals = make_tmp_names formals in + let locals = [] in + let nb_loops = 0 in + let start_and_end_points = None in + let point_kinds = PointKinds.empty in + static_env := + StaticEnv.add_fun_infos + fun_name formals locals nb_loops start_and_end_points point_kinds + !static_env + | Cil_types.GFun (fundec, _) -> + GenName.reset () ; + GenName.set_prefix "__tmp" ; + let fun_name = fundec.Cil_types.svar.Cil_types.vname in + (* supposes a good initialization of [points_infos] *) + assert (PointsInfos.mem fun_name points_infos) ; + let points_info = PointsInfos.find fun_name points_infos in + let formals = fundec.Cil_types.sformals in + let formals = make_tmp_names formals in + let locals = fundec.Cil_types.slocals in + let nb_loops = 0 in + let start_point = start_point fundec.Cil_types.sbody in + let end_point = end_point fundec.Cil_types.sbody in + let start_and_end_points = + make_start_and_end_points start_point end_point in + GenName.set_prefix "__tmp_loop" ; + let point_kinds = + List.fold_left (stmt_point_kinds fundec points_info) PointKinds.empty + fundec.Cil_types.sallstmts in + static_env := + StaticEnv.add_fun_infos + fun_name formals locals nb_loops start_and_end_points point_kinds + !static_env + | Cil_types.GVar (varinfo, _, _) + when varinfo.Cil_types.vname = StaticEnv.cost_id !static_env -> + static_env := StaticEnv.set_cost_varinfo varinfo !static_env ; + static_env := StaticEnv.add_globals varinfo.Cil_types.vname !static_env + | Cil_types.GVar (varinfo, _, _) | Cil_types.GVarDecl (_, varinfo, _) -> + static_env := StaticEnv.add_globals varinfo.Cil_types.vname !static_env + | _ -> () in + Cil.DoChildren + +end + +let initialize tmp_prefix fname f_old_name cost_id cost_incr extern_costs = + let points_infos = points_infos () in + GenName.set_prefix tmp_prefix ; + let static_env_ref = + ref (StaticEnv.init fname f_old_name cost_id cost_incr extern_costs) in + let initialize_prj = + File.create_project_from_visitor "initialize" + (new initialize points_infos static_env_ref) in + let f () = !static_env_ref in + Project.on initialize_prj f () + + +(*** Abstract domains and environments ***) + +module type DOMAIN = sig + type t + val of_int : int -> t + val of_var : string -> t + val top : t + val bot : t + val join : t -> t -> t + val widen : t -> t -> t + val narrow : t -> t -> t + val le : t -> t -> bool + val to_string : t -> string + val neg : t -> t + val add : t -> t -> t + val minus : t -> t -> t + val mul : t -> t -> t + val div : t -> t -> t + val modulo : t -> t -> t +end + +module type VARABSENV = sig + module Domain : DOMAIN + type t + val bot : t + val top : t + val upd : string -> Domain.t -> t -> t + val find : string -> t -> Domain.t + val init : Misc.String.Set.t -> (string * string) list -> t + val join : t -> t -> t + val widen : t -> t -> t + val narrow : t -> t -> t + val le : t -> t -> bool + val to_string : t -> string +end + +module type ABSENV = sig + module VarAbsEnv : VARABSENV + module Domain : DOMAIN + type t + type addressed = Misc.String.Set.t + val cost : t -> AbsCost.t + val requires : t -> Requires.t + val set_cost : t -> AbsCost.t -> t + val add_cost : t -> AbsCost.t -> t + val add_addressed : t -> addressed -> t + val set_lval : t -> Cil_types.lval -> Domain.t -> t + val top_vars : t -> Misc.String.Set.t -> t + val find : string -> t -> Domain.t + val bot : t + val init : Misc.String.Set.t -> (string * string) list -> t + val join : t -> t -> t + val widen : t -> t -> t + val narrow : t -> t -> t + val le : t -> t -> bool + val add_require : t -> int -> Require.t -> t + val to_string : t -> string +end + +module MakeVarAbsEnv (D : DOMAIN) : VARABSENV with module Domain = D = struct + + module Domain = D + + type t = Domain.t Misc.String.CMap.t + + let bot = Misc.String.CMap.empty D.bot + let upd = Misc.String.CMap.upd + let find = Misc.String.CMap.find + + let init globals formals = + let f x env = Misc.String.CMap.upd x D.top env in + let env = Misc.String.Set.fold f globals bot in + let f env (x, tmp) = + let env = Misc.String.CMap.upd x (D.of_var tmp) env in + Misc.String.CMap.upd tmp (D.of_var tmp) env in + List.fold_left f env formals + + let join = Misc.String.CMap.merge D.join + let widen = Misc.String.CMap.merge D.widen + let narrow = Misc.String.CMap.merge D.narrow + + let top = Misc.String.CMap.empty D.top + + let le env1 env2 = + let f v1 v2 res = res && (Domain.le v1 v2) in + Misc.String.CMap.cmp f env1 env2 true + + let to_string = + Misc.String.CMap.to_string (fun x -> x) (fun v -> (D.to_string v) ^ "\n") + +end + +module MakeAbsEnv (VAE : VARABSENV) + : ABSENV with module VarAbsEnv = VAE + and module Domain = VAE.Domain = struct + + module VarAbsEnv = VAE + module Domain = VarAbsEnv.Domain + + type addressed = Misc.String.Set.t + + type t = + { cost : AbsCost.t ; var_abs_env : VarAbsEnv.t ; addressed : addressed ; + requires : Requires.t } + + let init globals formals = + let cost = AbsCost.bot in + let var_abs_env = VarAbsEnv.init globals formals in + let addressed = Misc.String.Set.empty in + let requires = Requires.empty in + { cost ; var_abs_env ; addressed ; requires } + + let cost env = env.cost + + let requires env = env.requires + + let var_abs_env env = env.var_abs_env + + let find x env = VarAbsEnv.find x (var_abs_env env) + + let set_cost env cost = { env with cost } + + let add_cost env cost = { env with cost = AbsCost.add env.cost cost } + + let addressed env = env.addressed + + let add_addressed env addressed = + { env with addressed = Misc.String.Set.union env.addressed addressed } + + let set_lval env lval v = match fst lval with + | Cil_types.Var x -> + let var_abs_env = VarAbsEnv.upd x.Cil_types.vname v env.var_abs_env in + { env with var_abs_env } + | _ -> env + + let top_vars env vars = + let f x var_abs_env = VarAbsEnv.upd x Domain.top var_abs_env in + let var_abs_env = Misc.String.Set.fold f vars env.var_abs_env in + { env with var_abs_env } + + let bot = + { cost = AbsCost.bot ; var_abs_env = VarAbsEnv.bot ; + addressed = Misc.String.Set.empty ; requires = Requires.empty } + + let join env1 env2 = + { cost = AbsCost.join (cost env1) (cost env2) ; + var_abs_env = VarAbsEnv.join (var_abs_env env1) (var_abs_env env2) ; + addressed = Misc.String.Set.union (addressed env1) (addressed env2) ; + requires = Requires.join (requires env1) (requires env2) } + + let widen env1 env2 = + { cost = AbsCost.widen (cost env1) (cost env2) ; + var_abs_env = VarAbsEnv.widen (var_abs_env env1) (var_abs_env env2) ; + addressed = Misc.String.Set.union (addressed env1) (addressed env2) ; + requires = Requires.widen (requires env1) (requires env2) } + + let narrow env1 env2 = + { cost = AbsCost.narrow (cost env1) (cost env2) ; + var_abs_env = VarAbsEnv.narrow (var_abs_env env1) (var_abs_env env2) ; + addressed = addressed env1 ; + requires = Requires.narrow (requires env1) (requires env2) } + + let le env1 env2 = + (AbsCost.le (cost env1) (cost env2)) && + (VarAbsEnv.le (var_abs_env env1) (var_abs_env env2)) && + (Misc.String.Set.is_subset (addressed env1) (addressed env2)) && + (Requires.le (requires env1) (requires env2)) + + let add_require env id require = + { env with requires = Requires.add id require (requires env) } + + let to_string env = + let f_addressed x res = res ^ x ^ " " in + "Cost: " ^ (AbsCost.to_string (cost env)) ^ "\n" ^ + "Var env:\n" ^ (VarAbsEnv.to_string (var_abs_env env)) ^ + "Addressed: " ^ (Misc.String.Set.fold f_addressed (addressed env) "") ^ + "\n" ^ + "Requires:\n" ^ (Requires.to_string (requires env)) ^ "\n" + +end + +module MakePointsAbsEnv (AE : ABSENV) = struct + + module AbsEnv = AE + module Domain = AbsEnv.Domain + + type t = + { abs_env : AbsEnv.t IntCMap.t } + + let empty = { abs_env = IntCMap.empty AbsEnv.bot } + let bot = empty + + let abs_env env = env.abs_env + + let find point env = IntCMap.find point env.abs_env + + let add point abs_env env = + let abs_env = IntCMap.upd point abs_env env.abs_env in + { abs_env } + + let le env1 env2 = + let cmp abs_env1 abs_env2 res = res && (AbsEnv.le abs_env1 abs_env2) in + IntCMap.cmp cmp (abs_env env1) (abs_env env2) true + + let cost point env = AbsEnv.cost (find point env) + + let requires point env = AbsEnv.requires (find point env) + + let init start_point globals formals = + add start_point (AbsEnv.init globals formals) empty + + let to_string env = + IntCMap.to_string string_of_int AbsEnv.to_string (abs_env env) + + let widen env1 env2 = + let abs_env = IntCMap.merge AbsEnv.widen (abs_env env1) (abs_env env2) in + { abs_env } + + let narrow env1 env2 = + let abs_env = IntCMap.merge AbsEnv.narrow (abs_env env1) (abs_env env2) in + { abs_env } + + let set_cost id cost env = add id (AbsEnv.set_cost (find id env) cost) env + +end + + +module PointsAbsEnv = struct + + module D = Domain + + module VAE = MakeVarAbsEnv (D) + + module AE = MakeAbsEnv (VAE) + + include MakePointsAbsEnv (AE) + +end + +module AbsEnv = PointsAbsEnv.AbsEnv + + +(*** Dependent cost results ***) + +module LoopAnnotInfo = struct + + type t = + { counter : string ; + relation : Domain.relation ; + init_value : Domain.t ; + exit_value : Domain.t ; + increment : Domain.t ; + last_value : Domain.t ; + cost_id : string ; + tmp_loop : string ; + iteration_nb : Domain.t ; + body_cost : AbsCost.t } + + let counter loop_annot_info = loop_annot_info.counter + + let relation loop_annot_info = loop_annot_info.relation + + let init_value loop_annot_info = loop_annot_info.init_value + + let exit_value loop_annot_info = loop_annot_info.exit_value + + let increment loop_annot_info = loop_annot_info.increment + + let last_value loop_annot_info = loop_annot_info.last_value + + let cost_id loop_annot_info = loop_annot_info.cost_id + + let tmp_loop loop_annot_info = loop_annot_info.tmp_loop + + let iteration_nb loop_annot_info = loop_annot_info.iteration_nb + + let body_cost loop_annot_info = loop_annot_info.body_cost + + let make + counter relation init_value exit_value increment last_value cost_id + tmp_loop iteration_nb body_cost = + { counter ; relation ; init_value ; exit_value ; increment ; last_value ; + cost_id ; tmp_loop ; iteration_nb ; body_cost } + +end + +module LoopAnnot = struct + + type t = + | Variant of Domain.t + | CounterMod of Domain.t * Domain.t + | CounterLastValue of + string * Domain.relation * Domain.t * Domain.t * Domain.t + | NoIteration of string * Domain.relation * Domain.t * Domain.t + | Cost of string * string * Domain.t * AbsCost.t + + let reduce prototypes costs = function + | Cost (cost_id, tmp_loop, iteration_nb, body_cost) -> + let body_cost = AbsCost.reduce prototypes costs body_cost in + Cost (cost_id, tmp_loop, iteration_nb, body_cost) + | v -> v + + let compare = Pervasives.compare + + let variant_to_cil v = + if Domain.is_concrete v then Some (mk_variant (Domain.to_cil_term v)) + else None + + let counter_mod_to_cil v1 v2 = + if Domain.is_concrete v1 && Domain.is_concrete v2 then + if v1 = v2 then None + else + let v1 = Domain.to_cil_term v1 in + let v2 = Domain.to_cil_term v2 in + let invariant = Logic_const.prel (Cil_types.Req, v1, v2) in + Some (mk_invariant invariant) + else None + + let counter_last_value_to_cil counter rel init_value exit_value last_value = + if Domain.is_concrete init_value && + Domain.is_concrete exit_value && + Domain.is_concrete last_value then + let init_value = Domain.to_cil_term init_value in + let exit_value = Domain.to_cil_term exit_value in + let last_value = Domain.to_cil_term last_value in + let rel' = Domain.cil_rel_of_rel rel in + let require = Logic_const.prel (rel', init_value, exit_value) in + let rel' = Domain.cil_rel_of_rel (Domain.mk_large rel) in + let counter = cil_logic_int_var counter in + let prop = Logic_const.prel (rel', counter, last_value) in + let invariant = Logic_const.pimplies (require, prop) in + Some (mk_invariant invariant) + else None + + let no_iteration_to_cil counter rel init_value exit_value = + if Domain.is_concrete init_value && Domain.is_concrete exit_value then + let rel = Domain.opposite rel in + let rel' = Domain.cil_rel_of_rel rel in + let init_value = Domain.to_cil_term init_value in + let exit_value = Domain.to_cil_term exit_value in + let require = Logic_const.prel (rel', init_value, exit_value) in + let counter = cil_logic_int_var counter in + let prop = Logic_const.prel (Cil_types.Req, counter, init_value) in + let invariant = Logic_const.pimplies (require, prop) in + Some (mk_invariant invariant) + else None + + let cost_to_cil cost_id tmp_loop iteration_nb body_cost = + if Domain.is_concrete iteration_nb && AbsCost.is_concrete body_cost then + let cost_var = cil_logic_int_var cost_id in + let body_cost = AbsCost.to_ext body_cost in + let loop_cost = Domain.mul iteration_nb body_cost in + let cost = Domain.add (Domain.of_var tmp_loop) loop_cost in + if Domain.is_concrete cost then + let cost = Domain.to_cil_term cost in + let invariant = Logic_const.prel (Cil_types.Rle, cost_var, cost) in + Some (mk_invariant invariant) + else None + else None + + let to_cil = function + | Variant v -> variant_to_cil v + | CounterMod (v1, v2) -> counter_mod_to_cil v1 v2 + | CounterLastValue(counter, rel, init_value, exit_value, last_value) -> + counter_last_value_to_cil counter rel init_value exit_value last_value + | NoIteration (counter, rel, init_value, exit_value) -> + no_iteration_to_cil counter rel init_value exit_value + | Cost (cost_id, tmp_loop, iteration_nb, body_cost) -> + cost_to_cil cost_id tmp_loop iteration_nb body_cost + + let make_variant loop_annot_info = + let rel = LoopAnnotInfo.relation loop_annot_info in + let counter = LoopAnnotInfo.counter loop_annot_info in + let last_value = LoopAnnotInfo.last_value loop_annot_info in + let counter_var = Domain.of_var counter in + let (v1, v2) = match rel with + | Domain.Lt | Domain.Le -> (last_value, counter_var) + | Domain.Gt | Domain.Ge -> (counter_var, last_value) in + Variant (Domain.minus v1 v2) + + let make_counter_mod loop_annot_info = + let counter = LoopAnnotInfo.counter loop_annot_info in + let init_value = LoopAnnotInfo.init_value loop_annot_info in + let increment = LoopAnnotInfo.increment loop_annot_info in + let mk_value value = Domain.modulo value (Domain.abs increment) in + let v1 = mk_value (Domain.of_var counter) in + let v2 = mk_value init_value in + CounterMod (v1, v2) + + let make_counter_last_value loop_annot_info = + let counter = LoopAnnotInfo.counter loop_annot_info in + let rel = LoopAnnotInfo.relation loop_annot_info in + let init_value = LoopAnnotInfo.init_value loop_annot_info in + let exit_value = LoopAnnotInfo.exit_value loop_annot_info in + let last_value = LoopAnnotInfo.last_value loop_annot_info in + CounterLastValue (counter, rel, init_value, exit_value, last_value) + + let make_no_iteration loop_annot_info = + let counter = LoopAnnotInfo.counter loop_annot_info in + let rel = LoopAnnotInfo.relation loop_annot_info in + let init_value = LoopAnnotInfo.init_value loop_annot_info in + let exit_value = LoopAnnotInfo.exit_value loop_annot_info in + NoIteration (counter, rel, init_value, exit_value) + + let make_cost loop_annot_info = + let cost_id = LoopAnnotInfo.cost_id loop_annot_info in + let tmp_loop = LoopAnnotInfo.tmp_loop loop_annot_info in + let iteration_nb = LoopAnnotInfo.iteration_nb loop_annot_info in + let body_cost = LoopAnnotInfo.body_cost loop_annot_info in + Cost (cost_id, tmp_loop, iteration_nb, body_cost) + +end + +module LoopAnnots = struct + + include Eset.Make (LoopAnnot) + + let make loop_annot_info = + let variant = LoopAnnot.make_variant loop_annot_info in + (* let counter_mod = LoopAnnot.make_counter_mod loop_annot_info in *) + let counter_last_value = + LoopAnnot.make_counter_last_value loop_annot_info in + let no_iteration = LoopAnnot.make_no_iteration loop_annot_info in + let cost = LoopAnnot.make_cost loop_annot_info in + of_list [variant ; (* counter_mod ; *) + counter_last_value ; no_iteration ; cost] + + let to_cil loop_annots = + let f loop_annot res = match LoopAnnot.to_cil loop_annot with + | Some loop_annot -> loop_annot :: res + | None -> res in + fold f loop_annots [] + + let reduce prototypes costs loop_annots = + let f loop_annot res = + add (LoopAnnot.reduce prototypes costs loop_annot) res in + fold f loop_annots empty + +end + +module LoopsAnnots = struct + + type t = LoopAnnots.t IntMap.t + + let empty = IntMap.empty + + let mem = IntMap.mem + + let find = IntMap.find + + let add = IntMap.add + + let to_cil loops_annots = + IntMap.map LoopAnnots.to_cil loops_annots + + let reduce prototypes costs loops_annots = + IntMap.map (LoopAnnots.reduce prototypes costs) loops_annots + +end + +module CostInfo = struct + + type t = { cost : AbsCost.t ; requires : Requires.t ; + loops_annots : LoopsAnnots.t } + + let cost cost_info = cost_info.cost + + let requires cost_info = cost_info.requires + + let make cost requires loops_annots = { cost ; requires ; loops_annots } + + let set_cost cost_info cost = { cost_info with cost } + + let init cost = + { cost ; requires = Requires.empty ; loops_annots = LoopsAnnots.empty } + + let loops_annots cost = cost.loops_annots + + let mem_loop_annots id cost = LoopsAnnots.mem id (loops_annots cost) + + let find_loop_annots id cost = LoopsAnnots.find id (loops_annots cost) + + let to_string cost_info = AbsCost.to_string (cost cost_info) + + let reduce_loops_annots prototypes costs cost_info = + let loops_annots = + LoopsAnnots.reduce prototypes costs cost_info.loops_annots in + { cost_info with loops_annots } + + let replace_vars replacements cost_info = + let cost = AbsCost.replace_vars replacements (cost cost_info) in + let requires = Requires.replace_vars replacements (requires cost_info) in + { cost_info with cost ; requires } + +end + +module Costs = struct + + type t = CostInfo.t Misc.String.Map.t + + let empty = Misc.String.Map.empty + + let init extern_costs = + let f fun_name cost costs = + let cost_info = CostInfo.init (AbsCost.of_extern cost) in + Misc.String.Map.add fun_name cost_info costs in + Misc.String.Map.fold f extern_costs empty + + let mem = Misc.String.Map.mem + + let add fun_name cost requires loops_annots costs = + Misc.String.Map.add fun_name + (CostInfo.make cost requires loops_annots) costs + + let find_cost fun_name costs = + CostInfo.cost (Misc.String.Map.find fun_name costs) + + let find_requires fun_name costs = + CostInfo.requires (Misc.String.Map.find fun_name costs) + + let fun_costs = Misc.String.Map.map CostInfo.cost + + let set_fun_costs costs fun_costs = + let f fun_name cost_info = + let cost = + if Misc.String.Map.mem fun_name fun_costs then + Misc.String.Map.find fun_name fun_costs + else CostInfo.cost cost_info in + CostInfo.set_cost cost_info cost in + Misc.String.Map.mapi f costs + + let fold = Misc.String.Map.fold + + let to_string costs = + let f fun_name cost_info res = + res ^ "\n" ^ fun_name ^ ": " ^ (CostInfo.to_string cost_info) in + fold f costs "" + + let mem_loop_point fun_name id costs = + (Misc.String.Map.mem fun_name costs) && + (CostInfo.mem_loop_annots id (Misc.String.Map.find fun_name costs)) + + let find_loop_annots fun_name id costs = + let error = Invalid_argument "Costs.find_loop_annotations" in + let fun_info = Misc.String.Map.error_find fun_name costs error in + CostInfo.find_loop_annots id fun_info + + let reduce_loops_annots prototypes costs = + let fun_costs = fun_costs costs in + Misc.String.Map.map + (CostInfo.reduce_loops_annots prototypes fun_costs) costs + + let restore_formals static_env costs = + let f fun_name cost_info = + if StaticEnv.mem_fun_name fun_name static_env then + let formals = StaticEnv.formals fun_name static_env in + let f (formal, tmp) = (tmp, Domain.of_var formal.Cil_types.vname) in + let replacements = Misc.String.Map.of_list (List.map f formals) in + CostInfo.replace_vars replacements cost_info + else cost_info in + Misc.String.Map.mapi f costs + +end + + +(*** Abstract interpretation ***) + +module MakeAI (M : sig val static_env : StaticEnv.t end) = struct + + let rec addressed e = match e.Cil_types.enode with + | Cil_types.Const _ | Cil_types.SizeOf _ | Cil_types.SizeOfStr _ + | Cil_types.AlignOf _ -> + Misc.String.Set.empty + | Cil_types.Lval lval | Cil_types.AddrOf lval | Cil_types.StartOf lval -> + lval_addressed lval + | Cil_types.SizeOfE e | Cil_types.AlignOfE e | Cil_types.UnOp (_, e, _) + | Cil_types.CastE (_, e) | Cil_types.Info (e, _) -> addressed e + | Cil_types.BinOp (_, e1, e2, _) -> + Misc.String.Set.union (addressed e1) (addressed e2) + + and lhost_addressed = function + | Cil_types.Var _ -> Misc.String.Set.empty + | Cil_types.Mem e -> addressed e + + and offset_addressed = function + | Cil_types.Index (e, offset) -> + Misc.String.Set.union (addressed e) (offset_addressed offset) + | _ -> Misc.String.Set.empty + + and lval_addressed (lhost, offset) = + Misc.String.Set.union (lhost_addressed lhost) (offset_addressed offset) + + let branch abs_env _ = [abs_env ; abs_env] + + let abs_fun_of_unop = function + | Cil_types.Neg -> Domain.neg + | _ -> (fun _ -> Domain.top) + + let abs_fun_of_binop = function + | Cil_types.PlusA -> Domain.add + | Cil_types.MinusA -> Domain.minus + | Cil_types.Mult -> Domain.mul + | Cil_types.Div -> Domain.div + | Cil_types.Mod -> Domain.modulo + | _ -> (fun _ _ -> Domain.top) + + let rec exp abs_env e = match e.Cil_types.enode with + | Cil_types.Const (Cil_types.CInt64 (i, _, _)) -> + Domain.of_int (My_bigint.to_int i) + | Cil_types.Lval (Cil_types.Var varinfo, _) -> + AbsEnv.find varinfo.Cil_types.vname abs_env + | Cil_types.Info (e, _) -> exp abs_env e + | Cil_types.UnOp (unop, e, _) -> + abs_fun_of_unop unop (exp abs_env e) + | Cil_types.BinOp (binop, e1, e2, _) -> + abs_fun_of_binop binop (exp abs_env e1) (exp abs_env e2) + | Cil_types.CastE (_, e) -> exp abs_env e (* TODO: may be incorrect *) + | _ -> Domain.top + + let cost_incr_cost = function + | e :: _ -> + (match e.Cil_types.enode with + | Cil_types.Const (Cil_types.CInt64 (i, _, _)) -> + AbsCost.of_int (My_bigint.to_int i) + | _ -> AbsCost.top) + | _ -> AbsCost.top + + let call_proc_cost fun_name abs_env sid f args = + let f_add_addrd addrd e = Misc.String.Set.union addrd (addressed e) in + let addrd = List.fold_left f_add_addrd Misc.String.Set.empty (f :: args) in + let abs_env = AbsEnv.add_addressed abs_env addrd in + let cost = match f.Cil_types.enode with + | Cil_types.Lval (Cil_types.Var var, _) + when var.Cil_types.vname = StaticEnv.cost_incr M.static_env -> + cost_incr_cost args + | Cil_types.Lval (Cil_types.Var var, _) -> + AbsCost.of_fun_call + fun_name sid var.Cil_types.vname (List.map (exp abs_env) args) + | _ -> AbsCost.top in + let vars_to_top = + Misc.String.Set.union (StaticEnv.globals M.static_env) addrd in + AbsEnv.add_cost (AbsEnv.top_vars abs_env vars_to_top) cost + + (* Executing a goto may create a loop. We over-approximate its cost with a + Top. There is one exception though: Frama-C transforms programs so that + there is exactly one return statement that previous return statements in + the code point to with a goto. So if a goto leads to a return, the cost + remains the same; in other cases, it is Top. *) + + let stmt_goto abs_env stmt = match stmt.Cil_types.skind with + | Cil_types.Return _ -> [abs_env] + | _ -> [AbsEnv.set_cost abs_env AbsCost.top] + + let stmt fun_name abs_env stmt = match stmt.Cil_types.skind with + | Cil_types.Return _ -> [] + | Cil_types.Break _ | Cil_types.Continue _ + | Cil_types.Loop _ | Cil_types.Block _ | Cil_types.Switch _ + | Cil_types.Instr (Cil_types.Skip _ | Cil_types.Code_annot _) -> [abs_env] + | Cil_types.Goto (stmt_ref, _) -> stmt_goto abs_env !stmt_ref + | Cil_types.UnspecifiedSequence l -> make_list (List.length l) abs_env + | Cil_types.If (e, _, _, _) -> branch abs_env e + | Cil_types.Instr (Cil_types.Set (lval, e, _)) -> + let addressed = + Misc.String.Set.union (lval_addressed lval) (addressed e) in + let v = exp abs_env e in + let abs_env = AbsEnv.add_addressed abs_env addressed in + [AbsEnv.set_lval abs_env lval v] + | Cil_types.Instr (Cil_types.Call (None, f, args, _)) -> + [call_proc_cost fun_name abs_env stmt.Cil_types.sid f args] + | Cil_types.Instr (Cil_types.Call (Some lval, f, args, _)) -> + let addressed = lval_addressed lval in + let abs_env = AbsEnv.add_addressed abs_env addressed in + let abs_env = call_proc_cost fun_name abs_env stmt.Cil_types.sid f args in + [AbsEnv.set_lval abs_env lval Domain.top] + | Cil_types.Instr (Cil_types.Asm _) -> raise ASM_unsupported + | Cil_types.TryFinally _ | Cil_types.TryExcept _ -> raise Try_unsupported + + let merge_succ_regular points_abs_env abs_env stmt = + let id = stmt.Cil_types.sid in + let abs_env' = PointsAbsEnv.find id points_abs_env in + let abs_env' = AbsEnv.join abs_env abs_env' in + PointsAbsEnv.add id abs_env' points_abs_env + + let merge_succ_uloop_start src_id points_abs_env abs_env = + let points_abs_env = + PointsAbsEnv.set_cost src_id AbsCost.top points_abs_env in + let abs_env = AbsEnv.set_cost abs_env (AbsCost.of_int 0) in + merge_succ_regular points_abs_env abs_env + + let prev_init_and_cost fun_name counter points_abs_env prev_stmts = + let f (init_value, before_cost) (stmt_, pos) = + let abs_env = PointsAbsEnv.find (stmt_.Cil_types.sid) points_abs_env in + let abs_env = List.nth (stmt fun_name abs_env stmt_) pos in + let init_value = Domain.join init_value (AbsEnv.find counter abs_env) in + let before_cost = AbsCost.join before_cost (AbsEnv.cost abs_env) in + (init_value, before_cost) in + List.fold_left f (Domain.bot, AbsCost.bot) prev_stmts + + let body_cost points_abs_env last_stmts = + (* Exiting a loop can only be done through a break or a goto or whatever, + but certainly not with a cost increment instruction. Thus, executing the + last statements of a loop should not change the cost information, so its + unnecessary when this is all we care about. *) + let f res stmt = + let id = stmt.Cil_types.sid in + AbsCost.join res (AbsEnv.cost (PointsAbsEnv.find id points_abs_env)) in + List.fold_left f AbsCost.bot last_stmts + + let loop_cost fun_name id loop_info points_abs_env abs_env = + let cost_id = StaticEnv.cost_id M.static_env in + let tmp_loop = LoopInfo.tmp_loop loop_info in + let counter = LoopInfo.counter loop_info in + let relation = LoopInfo.relation loop_info in + let prev_stmts = LoopInfo.prev_stmts loop_info in + let last_stmts = LoopInfo.last_stmts loop_info in + let (init_value, before_cost) = + prev_init_and_cost fun_name counter points_abs_env prev_stmts in + let exit_value = exp abs_env (LoopInfo.exit_exp loop_info) in + let increment = exp abs_env (LoopInfo.increment loop_info) in + let last_value = + Domain.last_value relation init_value exit_value increment in + let iteration_nb = Domain.iteration_nb init_value counter increment in + let body_cost = body_cost points_abs_env last_stmts in + let loop_cost = + if AbsCost.is_top body_cost then AbsCost.top + else + AbsCost.of_loop_cost + fun_name id relation init_value exit_value increment + (AbsCost.extract body_cost) in + let succ_loop_cost = AbsCost.add before_cost loop_cost in + (counter, relation, init_value, exit_value, increment, last_value, cost_id, + tmp_loop, iteration_nb, body_cost, succ_loop_cost) + + let merge_succ_loop_start + fun_name src_id loop_info points_abs_env points_abs_env' abs_env = + let src_abs_env = PointsAbsEnv.find src_id points_abs_env in + let (_, rel, init_value, exit_value, increment, _, _, _, _, _, _) = + loop_cost fun_name src_id loop_info points_abs_env src_abs_env in + let require = Require.make rel init_value exit_value increment in + let abs_env = AbsEnv.add_require abs_env src_id require in + merge_succ_uloop_start src_id points_abs_env' abs_env + + let merge_succ_loop_exit + fun_name loop_start_id loop_info points_abs_env points_abs_env' + abs_env stmt = + let start_abs_env = PointsAbsEnv.find loop_start_id points_abs_env in + let (_, _, _, _, _, _, _, _, _, _, succ_loop_cost) = + loop_cost fun_name loop_start_id loop_info points_abs_env start_abs_env + in + let abs_env = AbsEnv.set_cost abs_env succ_loop_cost in + merge_succ_regular points_abs_env' abs_env stmt + + let merge_succ_uloop_exit points_abs_env abs_env = + let abs_env = AbsEnv.set_cost abs_env AbsCost.top in + merge_succ_regular points_abs_env abs_env + + let merge_succ fun_name src_id points_abs_env = + if StaticEnv.mem_point fun_name src_id M.static_env then + match StaticEnv.find_point fun_name src_id M.static_env with + | PointKind.RegularPoint -> merge_succ_regular + | PointKind.LoopStart loop_info -> + merge_succ_loop_start fun_name src_id loop_info points_abs_env + | PointKind.LoopExit loop_info -> + merge_succ_loop_exit fun_name src_id loop_info points_abs_env + | PointKind.ULoopStart -> merge_succ_uloop_start src_id + | PointKind.ULoopExit -> merge_succ_uloop_exit + else raise (Invalid_argument "AI.merge_succ") + + let fundec_stmt fun_name points_abs_env points_abs_env' stmt_ = + let id = stmt_.Cil_types.sid in + let abs_env = PointsAbsEnv.find id points_abs_env in + let abs_envs = stmt fun_name abs_env stmt_ in + (* Otherwise the [stmt] function is not correct. *) + assert (List.length abs_envs = List.length stmt_.Cil_types.succs) ; + let f = merge_succ fun_name id points_abs_env in + List.fold_left2 f points_abs_env' abs_envs stmt_.Cil_types.succs + + let rec fundec_stmts fun_name points_abs_env cmp merge stmts = + if !debug then + Printf.printf "%s\n%!" (PointsAbsEnv.to_string points_abs_env) ; + let f = fundec_stmt fun_name points_abs_env in + let points_abs_env' = List.fold_left f PointsAbsEnv.bot stmts in + let points_abs_env' = merge points_abs_env points_abs_env' in + if cmp points_abs_env' points_abs_env then + (if !debug then + Printf.printf "%s\n%!" (PointsAbsEnv.to_string points_abs_env') ; + points_abs_env') + else fundec_stmts fun_name points_abs_env' cmp merge stmts + + let fundec_stmts_widen fun_name points_abs_env = + fundec_stmts fun_name points_abs_env PointsAbsEnv.le PointsAbsEnv.widen + + let fundec_stmts_narrow fun_name points_abs_env = + let cmp env1 env2 = PointsAbsEnv.le env2 env1 in + fundec_stmts fun_name points_abs_env cmp PointsAbsEnv.narrow + + let loop_annot_info fun_name id points_abs_env loop_info = + let abs_env = PointsAbsEnv.find id points_abs_env in + let (counter, relation, init_value, exit_value, last_value, increment, + cost_id, tmp_loop, iteration_nb, body_cost, _) = + loop_cost fun_name id loop_info points_abs_env abs_env in + LoopAnnotInfo.make + counter relation init_value exit_value last_value increment cost_id + tmp_loop.Cil_types.vname iteration_nb body_cost + + let loop_annots fun_name points_abs_env id point_kind loops_annots = + match point_kind with + | PointKind.LoopStart loop_info -> + let loop_annot_info = + loop_annot_info fun_name id points_abs_env loop_info in + let loop_annots = LoopAnnots.make loop_annot_info in + LoopsAnnots.add id loop_annots loops_annots + | PointKind.ULoopStart -> + let loop_annots = LoopAnnots.empty in + LoopsAnnots.add id loop_annots loops_annots + | _ -> loops_annots + + let loops_annots fun_name points_abs_env = + PointKinds.fold (loop_annots fun_name points_abs_env) + (StaticEnv.point_kinds fun_name M.static_env) LoopsAnnots.empty + +end + + +(*** Dependent costs computation ***) + +class compute_costs widen narrow loops_annots static_env costs prj = +object inherit Visitor.frama_c_copy prj as super + + method vfunc fundec = + let fun_name = fundec.Cil_types.svar.Cil_types.vname in + if fun_name = StaticEnv.cost_incr static_env then begin + costs := Costs.add fun_name AbsCost.top Requires.empty + LoopsAnnots.empty !costs ; + Cil.SkipChildren end + else begin + (* The function should be in the static environment because of the + initializations. *) + assert (StaticEnv.mem_fun_name fun_name static_env) ; + let _ = match StaticEnv.start_and_end_points fun_name static_env with + | None -> + costs := Costs.add fun_name AbsCost.top Requires.empty + LoopsAnnots.empty !costs + | Some (start_point, end_point) -> + if !debug then Printf.printf "Interpreting %s\n%!" fun_name ; + let formals = StaticEnv.formals fun_name static_env in + let f_formals (varinfo, tmp) = (varinfo.Cil_types.vname, tmp) in + let globals = StaticEnv.globals static_env in + let formals = List.map f_formals formals in + let env = PointsAbsEnv.init start_point globals formals in + if !debug then Printf.printf "WIDEN\n%!" ; + let env = widen fun_name env fundec.Cil_types.sallstmts in + if !debug then Printf.printf "NARROW\n%!" ; + let env = narrow fun_name env fundec.Cil_types.sallstmts in + let cost = PointsAbsEnv.cost end_point env in + let requires = PointsAbsEnv.requires end_point env in + let loops_annots = loops_annots fun_name env in + (* The last instruction should be a return. Executing it shouldn't + change the environment. *) + costs := Costs.add fun_name cost requires loops_annots !costs in + Cil.SkipChildren end + +end + +let compute_costs static_env = + let module AI = MakeAI (struct let static_env = static_env end) in + let costs = ref (Costs.init (StaticEnv.extern_costs static_env)) in + let compute_costs_prj = + File.create_project_from_visitor + "compute_costs" + (new compute_costs AI.fundec_stmts_widen AI.fundec_stmts_narrow + AI.loops_annots static_env costs) in + let f () = !costs in + Project.on compute_costs_prj f () + + +(*** Costs solver ***) + +let solve_end costs1 costs2 = + let f fun_name cost res = + res && (Misc.String.Map.mem fun_name costs1) && + (cost = Misc.String.Map.find fun_name costs1) in + Misc.String.Map.fold f costs2 true + +let string_of_fun_costs fun_costs = + let f fun_name cost res = + Printf.sprintf "%s%s: %s\n%!" res fun_name (AbsCost.to_string cost) in + Misc.String.Map.fold f fun_costs "" + +let solve_costs static_env costs = + let costs = Costs.restore_formals static_env costs in + let fun_costs = Costs.fun_costs costs in + let prototypes = StaticEnv.prototypes static_env in + let rec aux fun_costs = + if !debug then Printf.printf "%s\n%!" (string_of_fun_costs fun_costs) ; + let fun_costs' = AbsCost.reduces prototypes fun_costs in + if solve_end fun_costs fun_costs' then fun_costs + else aux fun_costs' in + let fun_costs = aux fun_costs in + let costs = Costs.set_fun_costs costs fun_costs in + Costs.reduce_loops_annots prototypes costs + + +(*** Add annotations ***) + +let add_tmp_loop_init cost_varinfo tmp_loop stmt = + let lval = Cil.var tmp_loop in + let e = + Cil.new_exp dummy_location (Cil_types.Lval (Cil.var cost_varinfo)) in + let new_stmt = + Cil_types.Instr (Cil_types.Set (lval, e, dummy_location)) in + let new_stmt = Cil.mkStmt new_stmt in + Cil.mkStmt (Cil_types.Block (Cil.mkBlock [new_stmt ; stmt])) + +let make_tmp_formal_init fundec varinfo tmp_var = + let tmp_var = Cil.makeTempVar fundec ~name:tmp_var varinfo.Cil_types.vtype in + let lval = Cil.var tmp_var in + let e = Cil.new_exp dummy_location (Cil_types.Lval (Cil.var varinfo)) in + let new_stmt = Cil_types.Instr (Cil_types.Set (lval, e, dummy_location)) in + Cil.mkStmt new_stmt + +let make_tmp_formals_init fundec l = + let f (varinfo, tmp_var) = make_tmp_formal_init fundec varinfo tmp_var in + List.map f l + +let add_tmp_formals_init formals fundec = + let tmp_formals_init = make_tmp_formals_init fundec formals in + let block = tmp_formals_init @ fundec.Cil_types.sbody.Cil_types.bstmts in + let body = { fundec.Cil_types.sbody with Cil_types.bstmts = block } in + { fundec with Cil_types.sbody = body } + +let make_require require = + let rel = Require.relation require in + let init_value = Require.init_value require in + let exit_value = Require.exit_value require in + let increment = Require.increment require in + if Domain.is_concrete init_value && + Domain.is_concrete exit_value && + Domain.is_concrete increment then + let zero = Domain.of_int 0 in + let rel' = Domain.mk_strict rel in + let cil_init_value = Domain.to_cil_term init_value in + let cil_exit_value = Domain.to_cil_term exit_value in + let cil_zero = Domain.to_cil_term zero in + let cil_increment = Domain.to_cil_term increment in + let cil_rel = Domain.cil_rel_of_rel rel in + let cil_rel' = Domain.cil_rel_of_rel rel' in + let t1 = Logic_const.prel (cil_rel, cil_init_value, cil_exit_value) in + let t2 = Logic_const.prel (cil_rel', cil_zero, cil_increment) in + let t3 = Logic_const.pimplies (t1, t2) in + Some t3 +(* + if Domain.bool_of_cond rel' zero increment then None + else + if Domain.bool_of_cond (Domain.opposite rel) init_value exit_value then + None + else + if Domain.bool_of_cond rel init_value exit_value then Some t2 + else Some t3 +*) + else None + +let make_requires requires = + let f require res = + let added_require = match make_require require with + | None -> [] + | Some require -> [require] in + added_require @ res in + Requires.fold f requires [] + +let add_spec pres post spec = + let requires = List.map Logic_const.new_predicate pres in + let post_cond = [(Cil_types.Normal, Logic_const.new_predicate post)] in + let new_behavior = Cil.mk_behavior ~requires ~post_cond () in + spec.Cil_types.spec_behavior <- new_behavior :: spec.Cil_types.spec_behavior + +let add_cost_annotation requires rel cost_id cost spec = + let post = mk_fun_cost_pred rel cost_id cost in + add_spec (make_requires requires) post spec ; + Cil.ChangeDoChildrenPost (spec, identity) + +let add_cost_incr_annotation cost_id fundec = + let rel = Cil_types.Req in + let cost = + Logic_const.tvar (Cil_const.make_logic_var "incr" Cil_types.Linteger) in + add_cost_annotation Requires.empty rel cost_id cost fundec + +let add_regular_fun_annotation cost_id requires cost spec = + if AbsCost.is_concrete cost then + let cost = AbsCost.to_ext cost in + let rel = Cil_types.Rle in + if Domain.is_concrete cost then + add_cost_annotation requires rel cost_id (Domain.to_cil_term cost) spec + else Cil.DoChildren + else Cil.DoChildren + +let add_fundec_annotation static_env costs fun_name spec = + assert (Costs.mem fun_name costs) ; + let cost = Costs.find_cost fun_name costs in + let requires = Costs.find_requires fun_name costs in + let cost_id = StaticEnv.cost_id static_env in + let cost_incr = StaticEnv.cost_incr static_env in + if fun_name = cost_incr then add_cost_incr_annotation cost_id spec + else add_regular_fun_annotation cost_id requires cost spec + +class add_annotations static_env costs prj = +object (self) inherit Visitor.frama_c_copy prj as super + + val mutable current_fun_name : string = "" + + method vstmt_aux stmt = match stmt.Cil_types.skind with + | Cil_types.Loop _ + when StaticEnv.mem_loop_start current_fun_name stmt.Cil_types.sid + static_env -> + let cost_varinfo = StaticEnv.cost_varinfo static_env in + (* only use with costs correctly set and initialized *) + assert (Costs.mem_loop_point current_fun_name stmt.Cil_types.sid costs) ; + let tmp_loop = + StaticEnv.find_tmp_loop current_fun_name stmt.Cil_types.sid + static_env in + let annots = + Costs.find_loop_annots current_fun_name stmt.Cil_types.sid costs in + add_loop_annots self stmt (LoopAnnots.to_cil annots) ; + let change = add_tmp_loop_init cost_varinfo tmp_loop in + Cil.ChangeDoChildrenPost (stmt, change) + | _ -> Cil.DoChildren + + method vfunc fundec = + let fun_name = fundec.Cil_types.svar.Cil_types.vname in + current_fun_name <- fun_name ; + if fun_name = StaticEnv.cost_incr static_env then Cil.DoChildren + else + let formals = StaticEnv.formals fun_name static_env in + Cil.ChangeDoChildrenPost (fundec, add_tmp_formals_init formals) + + method vspec spec = match self#current_kf with + | None -> Cil.JustCopy + | Some kf -> + match kf.Cil_types.fundec with + | Cil_types.Definition (fundec, _) -> + let fun_name = fundec.Cil_types.svar.Cil_types.vname in + add_fundec_annotation static_env costs fun_name spec + | Cil_types.Declaration (_, f, _, _) -> + let fun_name = f.Cil_types.vname in + add_fundec_annotation static_env costs fun_name spec + +end + +let add_annotations static_env costs = + let add_annotations_prj = + File.create_project_from_visitor + "add_annotations" (new add_annotations static_env costs) in + let f () = + Kernel.CodeOutput.set (StaticEnv.fname static_env) ; + File.pretty_ast () in + Project.on add_annotations_prj f () + + +(*** Save results ***) + +let save_results static_env costs = + let fname = StaticEnv.f_old_name static_env in + let f fun_name cost_info res = + let cost = CostInfo.cost cost_info in + res ^ + (if AbsCost.is_concrete cost then + fun_name ^ " " ^ (Domain.to_string (AbsCost.to_ext cost)) ^ "\n" + else "") in + let s = Costs.fold f costs "" in + let save_file = + try Filename.chop_extension fname + with Invalid_argument "Filename.chop_extension" -> fname in + let save_file = save_file ^ ".cost_results" in + try + let oc = open_out save_file in + output_string oc s ; + close_out oc + with Sys_error _ -> + Printf.eprintf "Could not save plug-in results in file %s.\n%!" save_file + + +(*** Main ***) + +let cost ((fname, _), f_old_name, {Cerco.cost_id = cost_id; + cost_incr = cost_incr; + extern_costs = extern_costs} , _) = + try + Kernel.Files.set [fname] ; + File.init_from_cmdline () ; + if !debug then Printf.printf "Make CFG\n%!" ; + make_CFG () ; + if !debug then print_CFG () ; + if !debug then Printf.printf "Initialize\n%!" ; + let static_env = + initialize "__tmp" fname f_old_name cost_id cost_incr extern_costs in + if !debug then Printf.printf "Compute costs\n%!" ; + let costs = compute_costs static_env in + if !debug then Printf.printf "%s\n%!" (Costs.to_string costs) ; + if !debug then Printf.printf "Solve costs\n%!" ; + let costs = solve_costs static_env costs in + if !debug then Printf.printf "Costs:\n%s\n%!" (Costs.to_string costs) ; + if !debug then Printf.printf "Save results\n%!" ; + save_results static_env costs ; + if !debug then Printf.printf "Add annotations\n%!" ; + add_annotations static_env costs + with e -> Printf.eprintf "** ERROR: %s.\n%!" (string_of_exception e) diff --git a/plugin/compute_simple.ml b/plugin/compute_simple.ml new file mode 100644 index 0000000..0fd8e86 --- /dev/null +++ b/plugin/compute_simple.ml @@ -0,0 +1,787 @@ + +open Parameters +open Cil_types +open Simplify_terms +module Varinfo = Cil_datatype.Varinfo +module Logic_var = Cil_datatype.Logic_var +module Stmt = Cil_datatype.Stmt +module Term = Cil_datatype.Term +module Logic_label = Cil_datatype.Logic_label + +(** This module defines the main analysis of the plug-in. Its actions are: + - build the CFG of the program; + - compute the cost of each function depending on the costs of the others + at the same time add the needed invariant and at the cost of each function +*) + + +(*** Helpers ***) + +let identity x = x + +let string_of_list sep f l = + let rec aux = function + | [] -> "" + | [e] -> f e + | e :: l -> (f e) ^ sep ^ (aux l) in + aux l + +let integer_term term = Logic_const.term term Linteger + +let tinteger i = + let cint64 = CInt64 (My_bigint.of_int i, IInt, None) in + let iterm = TConst cint64 in + integer_term iterm + +let cil_logic_int_var x = + Logic_const.tvar (Cil_const.make_logic_var x Linteger) + +let current_kf obj = match obj#current_kf with + | None -> raise (Failure "Compute.current_kf") + | Some kf -> kf + +let add_loop_annot obj stmt annot = + let annot = User annot in + let kf = + Cil.get_original_kernel_function (Cil.copy_visit ()) (current_kf obj) in + Queue.add (fun () -> Annotations.add kf stmt [Ast.self] annot) + obj#get_filling_actions + +let add_loop_annots obj stmt annots = List.iter (add_loop_annot obj stmt) annots + +let mk_invariant pred = + Logic_const.new_code_annotation (AInvariant ([], true, pred)) + +let mk_variant term = + Logic_const.new_code_annotation (AVariant (term, None)) + +let mk_fun_cost_pred rel cost_id cost = + let cost_var = Cil_const.make_logic_var cost_id Linteger in + let cost_var = Logic_const.tvar cost_var in + let old_cost = Logic_const.told cost_var in + let new_cost = TBinOp (PlusA, old_cost, cost) in + let new_cost = integer_term new_cost in + Logic_const.prel (rel, cost_var, new_cost) + +let rec exp_is_var name e = match (remove_casts e).enode with + | Lval (Var v, _) -> v.vname = name + | Info (e, _) -> exp_is_var name e + | _ -> false + +let has_fun_type varinfo = match varinfo.vtype with + | TFun _ -> true + | _ -> false + +let formals_of_varinfo varinfo = match varinfo.vtype with + | TFun (_, args, _, _) -> + List.map (fun (x, t, _) -> Cil.makeVarinfo false true x t) + (Cil.argsToList args) + | _ -> assert false (* do not use on these arguments *) + +let dummy_location = (Lexing.dummy_pos, Lexing.dummy_pos) + +let dummy_varinfo = Cil.makeVarinfo false false "" (TVoid []) + +let make_list n a = + let rec aux acc i = if i >= n then acc else aux (a :: acc) (i+1) in + aux [] 0 + +let rec stmt_subs stmt = + let added = match stmt.skind with + | If (_, block1, block2, _) + | TryFinally (block1, block2, _) + | TryExcept (block1, _, block2, _) -> + (block_subs block1) @ (block_subs block2) + | Switch (_, block, _, _) + | Loop (_, block, _, _, _) + | Block block -> block_subs block + | UnspecifiedSequence l -> + List.map (fun (stmt, _, _, _, _) -> stmt) l + | _ -> [] in + stmt :: added + +and block_subs block = List.flatten (List.map stmt_subs block.bstmts) + +let rec first_stmt block = match block.bstmts with + | [] -> None + | stmt :: _ -> match stmt.skind with + | Block block -> first_stmt block + | _ -> Some stmt + +let stmt_is_break stmt = match stmt.skind with + | Break _ -> true + | _ -> false + +let starts_with_break block = match first_stmt block with + | Some stmt -> + (match stmt.skind with + | Goto (stmt_ref, _) -> stmt_is_break !stmt_ref + | _ -> stmt_is_break stmt) + | _ -> false + +let rec last = function + | [] -> None + | [e] -> Some e + | _ :: l -> last l + +let rec last_stmt block = match last block.bstmts with + | None -> None + | Some stmt -> match stmt.skind with + | Block block -> last_stmt block + | _ -> Some stmt + +class print_CFG = object inherit Visitor.frama_c_inplace as super + + method vfunc func = + Format.printf "*** %s ***\n\n%!" func.svar.vname ; + List.iter + (fun stmt -> + Format.printf "%d: %a\n--> %!" stmt.sid Cil.d_stmt stmt ; + List.iter (fun stmt -> Format.printf "%d %!" stmt.sid) + stmt.succs ; + Format.printf "\n\n%!") + func.sallstmts ; + Format.printf "\n\n%!" ; + Cil.SkipChildren + +end + +let print_CFG () = + Visitor.visitFramacFile (new print_CFG) (Ast.get ()) + +(*** Make CFG ***) + +class make_CFG = object inherit Visitor.frama_c_inplace as super + + method vfile file = + Cfg.clearFileCFG ~clear_id:false file ; + Cfg.computeFileCFG file ; + Cil.SkipChildren + +end + +let make_CFG () = + Visitor.visitFramacFile (new make_CFG) (Ast.get ()) + +(** Extract variant *) + +let rec extract_added_value counter e = match e.enode with + | BinOp (PlusA, e1, e2, _) when exp_is_var counter e1 -> + Some (counter, e2) + | BinOp (MinusA, e1, e2, typ) + when exp_is_var counter e1 -> + let enode = UnOp (Neg, e2, typ) in + let e2 = { e2 with enode = enode } in + Some (counter, e2) + | CastE (_, e) -> extract_added_value counter e + | _ -> + if !debug then + Format.printf + "Could not find added increment value for counter %s in %a.\n%!" + counter Cil.d_exp e ; + None + +let extract_increment block = + let open Misc.Option in + last_stmt block >>= + (fun stmt -> match stmt.skind with + | Instr (Set ((Var v, _), e, _)) -> + extract_added_value v.vname e + | _ -> + if !debug then + Format.printf + "Could not find increment instruction; found %a instead.\n%!" + Cil.d_stmt stmt ; + None) + +let gen_variant counter rel guard increment = + let counter = term_of_exp counter in + let guard = term_of_exp guard in + let increment = term_of_exp increment in + let guard = match rel with + | Lt | Gt | Ne -> guard + | Le | Ge | Eq -> make_binop PlusA (Cil.lconstant My_bigint.one) guard + | _ -> assert false (* not implemented TODO be gentle *) in + let variant = make_binop MinusA guard counter in + let variant = + if no_division_in_generated_variant + then make_binop Mult variant (make_sign increment) + else make_binop Div variant increment in + simplify_term variant + +let opposite = function + | Lt -> Gt + | Gt -> Lt + | Le -> Ge + | Ge -> Le + | Eq -> Eq + | Ne -> Ne + | _ -> assert false (* not implemented TODO be gentle *) + + +let extract_guard block (counter, increment) = + let open Misc.Option in + first_stmt block >>= + (fun stmt -> match stmt.skind with + | If (e, _, block, _) when starts_with_break block -> + (match e.enode with + | BinOp (rel, e1, e2, _) + when exp_is_var counter e1 (* && Domain.is_supported_rel rel *) -> + (*Some (counter, rel, e2, increment)*) + Some (gen_variant e1 rel e2 increment) + | BinOp (rel, e1, e2, _) + when exp_is_var counter e2 (* && Domain.is_supported_rel rel *) -> + (* let rel = rel in *) + (* let rel = Domain.opposite rel in *) + (* Some (counter, rel, e1, increment) *) + let rel = opposite rel in + Some (gen_variant e2 rel e1 increment) + | _ -> + if !debug then + Format.printf "Unsupported guard condition %a on counter %s.\n%!" + Cil.d_exp e counter ; + None) + | If (_, _, block, _) -> + if !debug then + Format.printf "Loop not guarded by a break:\n%a\n%!" Cil.d_block block ; + None + | _ -> + if !debug then Format.printf "Loop not guarded:\n%a\n%!" Cil.d_stmt stmt ; + None) + +let extract_variant body = + let open Misc.Option in + extract_increment body >>= extract_guard body + +let rec find_variant = function + | [] -> None + | {annot_content = AVariant (t,_)}::_ -> Some t + | _::l -> find_variant l + + +(** Function computing cost of special instruction *) + +type env = + { env_fun_cost : term Varinfo.Hashtbl.t; + env_cost_incr_name : string; (* TODO put the varinfo *) + env_cost_var : logic_var; + mutable env_loop_name : unit -> string; + } + +let init_loop_name env file = + let i = ref 0 in + let f () = + incr i; + Format.sprintf "__cost_%s_loop_%i" file !i in + env.env_loop_name <- f + +let dumb_env_loop_name () : string = assert false + +let linteger t = Logic_const.term t Linteger + +(** Create a function which compute the cost of a loop. +It uses the variant as the strictly decreasing positive argument. +The cost depend of the other arguments \vec x. + +\bcost if the cost of the body of the loop (must be always positive!) +\phi compute the modification of \vec x by one turn of the loop + +f(v,\vec x) = + if v < 0 then 0 + else (f(v-1,\phi(\vec x)) + \bcost(\vec x)) + +It also create some needed lemmas: + - f is always positive + +or simplifying lemmas: + - simpler (eg. algebraic) formulation of f: + * \vec x = \empty, \phi = identity, \bcost = c >= 0 + f(v) = c (v + 1) + * \phi = identity + f(v,\vec x) = \bcost(\vec x) * (v + 1) + * \phi(\vec x) = x_1 + 1,x_2,...,x_n + \bcost(\vec x) = max(c x_1,0) + \phi(x_2,...,x_n) + \phi(x_2,...,x_n) >= 0, c >= 0 + f(v,\vec x) = \phi(x_2,...,x_n) (v + 1) + + c * [y(y+1) - (max(y-v-1,0)(y-v)]/2 +*) +let create_fun_loop env dep bcost = + let v = Cil_const.make_logic_var "v" Linteger in + let tv = Logic_const.tvar v in + let xargs = List.map fst dep in (** \vec x *) + let mod_dep = List.map snd dep in (** \phi *) + let args = v::xargs in + let targs = List.map Logic_const.tvar args in + (** The function *) + let signature = Larrow (List.map (fun _ -> Linteger) args, Linteger) in + let new_loop_name = env.env_loop_name () in + let li = { l_var_info = Cil_const.make_logic_var new_loop_name signature; + l_labels = []; + l_tparams = []; + l_type = Some Linteger; + l_profile = args; + l_body = LBnone (* temporary *) } in + let lzero = Cil.lzero () in + let tvminusone = + linteger (TBinOp(MinusA, tv, Cil.lconstant (My_bigint.one))) in + (* let body = linteger (Tapp(li,[],tvminusone::mod_dep)) in *) + let body = linteger (tapp li (tvminusone::mod_dep)) in + let body = linteger (TBinOp(PlusA, body, bcost)) in + let body = + Tif(linteger (TBinOp(Lt, tv, lzero)), lzero, body) in + li.l_body <- LBterm (linteger body); + (** Axiom positive *) + let lemma = Logic_const.unamed + (Pforall(args, + Logic_const.unamed + (Prel (Rge, linteger (Tapp(li, [], targs)), lzero)))) in + let lemma = Dlemma (new_loop_name ^ "_is_positive", false, [], [], lemma, + Cil_datatype.Location.unknown) in + (** Register them as global (in reverse order) *) + Globals.Annotations.add_generated lemma; + Globals.Annotations.add_generated + (Dfun_or_pred (li, Cil_datatype.Location.unknown)); + li + +(** TODO: extend it to some more interesting cases *) +let cost_loop_term_simple env kern_fun stmt lab_before_loop variant cost_body = + (** The number of iteration is bounded by the variant + 1, because + the variant must be positive at the *start* of an iteration *) + let variant = make_binop PlusA variant (Cil.lconstant (My_bigint.one)) in + (** Simple version, just do the multiplication *) + let nbr_iteration = make_at lab_before_loop variant in + (** the nbr_iteration must be positive *) + let nbr_iteration = make_max nbr_iteration (Cil.lzero ()) in + let sum = make_binop Mult nbr_iteration cost_body in + + (** make the cost invariant of the loop *) + let remaining_nbr_iteration = make_max variant (Cil.lzero ()) in + (** ensures cost <= \old(cost) + + ([nbr_iteration]-[remaining_nbr_iteration]) * [cost_body] *) + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = make_at lab_before_loop cost_var in + let cost_iterations = + make_binop Mult + (make_binop MinusA nbr_iteration remaining_nbr_iteration) + cost_body in + let new_cost = make_binop PlusA old_cost cost_iterations in + let new_cost = simplify_term new_cost in + let invariant = Logic_const.prel (Rle, cost_var, new_cost) in + let annot = + Logic_const.new_code_annotation + (AInvariant ([time_cost_behavior],true,invariant)) in + Annotations.add kern_fun stmt [Ast.self] (User annot); + sum + +let cost_loop_term_complexe + env kern_fun stmt lab_before_loop variant deps cost_body = + (** the nbr_iteration must be positive *) + let variant = make_max variant (Cil.lzero ()) in + let args = List.map fst deps in (** \phi *) + let targs = List.map Logic_const.tvar args in + let fl = create_fun_loop env deps cost_body in + let app = linteger (tapp fl (variant::targs)) in + let sum = make_at lab_before_loop app in + + (** make the cost invariant of the loop *) + (** ensures cost <= \old(cost) + + ([nbr_iteration]-[remaining_nbr_iteration]) * [cost_body] *) + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = make_at lab_before_loop cost_var in + let cost_iterations = make_binop MinusA sum app in + let new_cost = make_binop PlusA old_cost cost_iterations in + let new_cost = simplify_term new_cost in + let invariant = Logic_const.prel (Rle, cost_var, new_cost) in + let annot = + Logic_const.new_code_annotation + (AInvariant ([time_cost_behavior],true,invariant)) in + Annotations.add kern_fun stmt [Ast.self] (User annot); + sum + +let cost_loop_term env kern_fun stmt lab_before_loop variant deps cost_body = +(* + let const_during_loop = List.for_all (fun (_,_) -> (** TODO *) false) deps in + if const_during_loop + then cost_loop_term_simple env kern_fun stmt lab_before_loop variant cost_body + else cost_loop_term_complexe + env kern_fun stmt lab_before_loop variant deps cost_body +*) + let cost_body = simplify_term cost_body in + match cost_body.term_node with + | TConst _ -> + cost_loop_term_simple env kern_fun stmt lab_before_loop variant cost_body + | _ -> + cost_loop_term_complexe + env kern_fun stmt lab_before_loop variant deps cost_body + + +(** computing cost of fundec which contain a call to funvar *) +let cost_of_fun_call env funvar args = + (** can't fail since we use the callgraph *) + let cost = Varinfo.Hashtbl.find env.env_fun_cost funvar in + (* match cost.term_node with *) + (* | TConst (CInt64 (_,_,_)) -> cost *) + (* | _ -> *) + (** arguments of the function *) + let formals = Cil.getFormalsDecl funvar in +(* (** The real arguments are binded using a let and the formal argument are + replaced by fresh variable *) + let letvars = List.map + (fun vi -> Cil.make_temp_logic_var (Ctype vi.vtype)) + formals in + let subst = List.fold_left2 (fun map vi v -> + Varinfo.Map.add vi v map) Varinfo.Map.empty formals letvars in + let cost = + Visitor.visitFramacTerm (new subst_lval subst (Project.current ())) + cost in + let cost = List.fold_left2 (fun tlet v arg -> + let logic_info = { l_var_info = v; l_type = None; l_tparams = []; + l_labels = []; l_profile = []; + l_body = LBnone; } in + let arg = term_of_exp arg in + let tlet = + Logic_const.term (Tlet (logic_info, arg)) + tlet.term_type in + tlet) + cost letvars args in*) + let subst = List.fold_left2 (fun map vi arg -> + try + Varinfo.Map.add vi (term_of_exp arg) map + with Untranslatable_expr _ -> map (** TODO verify that this formal doesn't + appear in the cost of the function *) + ) Varinfo.Map.empty formals args in + let cost = remove_logic_label Logic_const.pre_label cost in + let cost = + Visitor.visitFramacTerm (new subst_lval subst (Project.current ())) + cost in + cost + +(** Compute the "wp" of a stmt, in fact just make some substitution *) +let stmt_wp stmt term = + (** try to propagate \at(i,Label) *) + match stmt.skind with + | Instr (Set ((Var vi,_),e,_)) -> + begin + try + let t = term_of_exp e in + let subst = Varinfo.Map.singleton vi t in + let term = + Visitor.visitFramacTerm + (new subst_with_label stmt subst (Project.current ())) + term in + term + with exn -> + if !debug then Format.eprintf "can't convert exp %a to term: %a.@." + Cil.defaultCilPrinter#pExp e print_exception exn; + term + end + | _ -> term + +let rec stmts_wp bad_stmts stop_stmts stmt term = + if !debug then + Format.printf "stmts_wp sid: %i,@ bad_stmts: %a,@ stop_stmts: %a,@\n" + stmt.sid + Stmt.Set.pretty bad_stmts + Stmt.Set.pretty stop_stmts; + (** statement in last statement *) + if Stmt.Set.mem stmt stop_stmts + then Some term + else if Stmt.Set.mem stmt bad_stmts + then None + else + (** successors *) + let succs_bad_stmts = + match stmt.skind with + | Loop (_,_,_,_,_) -> Stmt.Set.add stmt bad_stmts + | _ -> bad_stmts in + (** Cost of the successors of the instruction *) + let cost_succs = + stmts_wp_succs succs_bad_stmts stop_stmts stmt.succs term in + match cost_succs with + | [] -> None (** can't go in a good state so count nothing *) + | (a::l) -> (** TODO take care of conditions *) + assert (l = []); + let a' = stmt_wp stmt a in + if !debug then + Format.printf "[WP]stmt:@,%a@.a:@,%a@.a':@,%a@." + Cil.defaultCilPrinter#pStmt stmt + Cil.defaultCilPrinter#pTerm a + Cil.defaultCilPrinter#pTerm a'; + Some a' + +and stmts_wp_succs bad_stmts stop_stmts stmts term = + let fold acc stmt = + match stmts_wp bad_stmts stop_stmts stmt term with + | None -> acc + | Some t -> t::acc in + List.fold_left fold [] stmts + + +(** We go through the cfg we assume that: + - all functions called have a cost already computed + - no implicit loop (goto), all are explicit Loop + - all loops have an invariant (given by the user or previously computed for + for-loops) + + We iterate on the cfg except when arriving on a loop where we compute the + body alone and after that go to the next statements (the break statement) + + break_statement in which statement to stop the sum (for loop) + *) + + +let rec find_variant = function + | [] -> None + | {annot_content = AVariant (t,_)}::_ -> Some t + | _::l -> find_variant l + +(** TODO: cache the statement already done after if-then-else + (otherwise exponential) *) +(** return None if no path arrive to a good_statement or don't go through + a bad_statetement *) +let rec cfg_sum env kern_fun bad_stmts stop_stmts stmt = + if !debug then + Format.printf "sid: %i,@ bad_stmts: %a,@ stop_stmts: %a,@\n" + stmt.sid + Stmt.Set.pretty bad_stmts + Stmt.Set.pretty stop_stmts; + (** statement in last statement *) + if Stmt.Set.mem stmt stop_stmts + then Some (Cil.lzero ()) + else if Stmt.Set.mem stmt bad_stmts + then None + else + (** successors *) + let succs_bad_stmts = + match stmt.skind with + | Loop (_,_,_,_,_) -> Stmt.Set.add stmt bad_stmts + | _ -> bad_stmts in + (** Cost of the successors of the instruction *) + let cost_succs = + cfg_sum_succs env kern_fun succs_bad_stmts stop_stmts + stmt.succs in + match cost_succs with + | None -> None (** can't go in a good state so count nothing *) + | Some cost_succs -> + (** Cost of the instruction *) + let cost_instr = + match stmt.skind with + (* (\** call to cost_incr *\) *) (** cost_incr is an usual function *) + (* | Instr *) + (* (Call (None, *) + (* { enode = *) + (* Lval (Var var, _)} , *) + (* [cost], _)) *) + (* when var.vname = env.env_cost_incr_name -> *) + (* term_of_cost_expr cost *) + (** function call *) + | Instr + (Call (_, { enode = + Lval (Var var, _)}, + args,_)) -> + cost_of_fun_call env var args + (** loops *) + | Loop (_,body,_,_,_) -> + cost_loop env kern_fun bad_stmts stop_stmts stmt body + | _ -> Cil.lzero () in + (** normalize the cost of the instruction regarding the labels *) + let labels = NormAtLabels.labels_stmt_pre stmt in + let cost_instr = NormAtLabels.preproc_annot_term labels cost_instr in + let cost_succs = stmt_wp stmt cost_succs in + let sum = make_binop PlusA cost_instr cost_succs in + (** remove the at that point to this statement we don't know the value at + this point perhaps we will know before ( use Here?? ) *) + let sum = + Visitor.visitFramacTerm + (new remove_stmt_label stmt (Project.current ())) + sum in + if !debug then + Format.printf "Stmt %i sum=%a@." + stmt.sid Term.pretty sum; + Some sum + +and cfg_sum_succs env kern_fun bad_stmts stop_stmts stmts = + let fold cost stmt = + let cost_succ = cfg_sum env kern_fun bad_stmts stop_stmts stmt in + make_max_opt cost cost_succ in + List.fold_left fold None stmts + +and cost_loop env kern_fun bad_stmts stop_stmts stmt body = + (** the first one perhaps not needed *) + let bad_stmts = Stmt.Set.union bad_stmts stop_stmts in + let stop_stmts = Stmt.Set.singleton stmt in + let cost_body = + cfg_sum_succs env kern_fun bad_stmts stop_stmts stmt.succs in + let cost_body = match cost_body with + | None -> (* no cycle in fact *) Cil.lzero () + | Some cost -> simplify_term cost in + (** compute free variable and compute their modification by the loop body *) + let deps = freevar Logic_var.Set.empty cost_body in + let deps = + let fold e acc = + let result = + stmts_wp_succs bad_stmts stop_stmts stmt.succs (Logic_const.tvar e) in + match result with + | [] -> assert false (** No cycle? impossible it find one before *) + | t::l -> + assert (l = []); (* TODO *) + (e, t)::acc in + Logic_var.Set.fold fold deps [] in + (** this stmt is the continue *) + let annots = Annotations.get_filter Logic_utils.is_variant stmt in + let variant = match annots with + | [] -> (** TODO put it somewhere else *) + begin match extract_variant body with + | None -> + Format.printf + "Can't@ compute@ cost@ without@ variant@ for@ statement:@,%a@." + Stmt.pretty stmt; exit 1 + | Some variant -> + let annot = + Logic_const.new_code_annotation (AVariant (variant,None)) in + Annotations.add kern_fun stmt [Ast.self] (User annot); + variant end + | ( User { annot_content = + AVariant (v,_) } + | AI (_, { annot_content = + AVariant (v,_) }) (** usefule case ? *) + ) + :: _ -> + let v = NormAtLabels.preproc_annot_term + (NormAtLabels.labels_loop_inv stmt) v in + let v = remove_logic_label Logic_const.here_label v in + v + | _ -> assert false (* result of the filter *) + in + if stmt.labels = [] then + stmt.labels <- (** ugly but... *) + Label("__stmt_"^(string_of_int stmt.sid),Cil.builtinLoc,false):: + stmt.labels; + let label_before_loop = StmtLabel (ref stmt) in + cost_loop_term env kern_fun stmt label_before_loop variant deps cost_body + +let make_leq_cost env sum = + (** ensures cost <= \old(cost) + [sum] *) + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = Logic_const.told cost_var in + let new_cost = Logic_const.term + (Cil_types.TBinOp (Cil_types.PlusA, old_cost, sum)) Linteger in + let post = Logic_const.prel (Rle, cost_var, new_cost) in + let post = Logic_const.new_predicate post in + post + +let fun_sum env vi kernel_fun = + let fst_stmt = Kernel_function.find_first_stmt kernel_fun in + let last_stmt = Kernel_function.find_return kernel_fun in + let bad_stmts = Stmt.Set.empty in + let stop_stmts = Stmt.Set.singleton last_stmt in + let sum = cfg_sum env kernel_fun bad_stmts stop_stmts fst_stmt in + let sum = match sum with + | None -> assert false (* Oups return not achievable?? *) + (* Infinity!! *) + | Some sum -> + let sum = simplify_term sum in + let sum = Logic_const.told sum in (** add old and push it *) + let labels = NormAtLabels.labels_fct_post in + let sum = NormAtLabels.preproc_annot_term labels sum in + sum in + if !debug then + Format.printf "@[sum of %a: %a@]@." + Cil.defaultCilPrinter#pVar vi + Cil.defaultCilPrinter#pTerm sum; +(** add postcondition about cost *) + let mod_funspec funspec = + let post = make_leq_cost env sum in + let behavior = + Cil.mk_behavior ~name:time_cost_behavior ~post_cond:[Normal, post] () in + {funspec with spec_behavior = behavior::funspec.spec_behavior;} + in + Kernel_function.set_spec kernel_fun mod_funspec; + sum + +(** Before computing the sum check that the user doesn't specify the cost. + In this case use it *) +let fun_sum env vi = + init_loop_name env "fun_sum"; + let kernel_fun = Globals.Functions.get vi in + let funspec = Kernel_function.get_spec kernel_fun in + let rec find_cost = function + | [] -> None + | {b_name = name; + b_requires = []; + b_assumes = []; (** TODO? allow more general contract? *) + (** ensores __cost <= \old(__cost) + t; *) + b_post_cond = [_,{ip_content=Prel + (Rle, + {term_node = (TLval(TVar cost_var,TNoOffset))}, + {term_node = TBinOp(PlusA,{term_node = Tat( + {term_node = (TLval(TVar cost_var2,TNoOffset))}, old_label)}, + t)})}] + }::_ when name = time_cost_behavior && + Logic_var.equal cost_var env.env_cost_var && + Logic_var.equal cost_var2 env.env_cost_var && + Logic_label.equal old_label Logic_const.old_label + -> Some t + | _::l -> find_cost l in + match find_cost funspec.spec_behavior with + | None -> fun_sum env vi kernel_fun + | Some sum -> + if !debug then + Format.printf "@[User sum of %a: %a@]@." + Cil.defaultCilPrinter#pVar vi + Cil.defaultCilPrinter#pTerm sum; + let labels = NormAtLabels.labels_fct_post in + let sum = NormAtLabels.preproc_annot_term labels sum in + sum + +let initialize _tmp_prefix _fname cost_var cost_incr _extern_costs = + (** TODO? use extern_costs for initializing env_fun_cost ? *) + let callgraph = Callgraph.computeGraph (Ast.get ()) in + if !debug then + Printf.printf "callgraph size: %a\n%!" Callgraph.printGraph callgraph; + let env = { env_fun_cost = Varinfo.Hashtbl.create 10; + env_cost_incr_name = cost_incr; + env_cost_var = cost_var; + env_loop_name = dumb_env_loop_name} in + let rec iter : 'a. 'a -> Callgraph.callnode -> unit = fun _ callnode -> + match callnode.Callgraph.cnInfo with + | Callgraph.NIVar (vi,{contents = true }) -> + if not (Varinfo.Hashtbl.mem env.env_fun_cost vi) then begin + Inthash.iter iter callnode.Callgraph.cnCallees; + let sum = fun_sum env vi in + Varinfo.Hashtbl.add env.env_fun_cost vi sum + end + | _ -> () (** put an undefined constant here for top *) + in + (** add the cost of cost_incr *) + let cost_incr = Hashtbl.find callgraph cost_incr in + let cost_incr = match cost_incr.Callgraph.cnInfo with + | Callgraph.NIVar (vi,_) -> vi + | _ -> assert false (* cost_incr must be at least declared *) in + let arg_cost_incr = List.hd (Cil.getFormalsDecl cost_incr) in + let sum_cost_incr = Logic_const.tvar (Cil.cvar_to_lvar arg_cost_incr) in + let post_cost_incr = make_leq_cost env sum_cost_incr in + Kernel_function.set_spec (Globals.Functions.get cost_incr) (fun funspec -> + let assigns = + Writes [Logic_const.(new_identified_term (tvar cost_var)), FromAny] in + let behavior = + Cil.mk_behavior ~name:time_cost_behavior + ~post_cond:[Normal, post_cost_incr] + ~assigns () in + {funspec with spec_behavior = behavior::funspec.spec_behavior;} ); + Varinfo.Hashtbl.add env.env_fun_cost cost_incr sum_cost_incr; + (** make the other functions *) + Hashtbl.iter iter callgraph + + +(*** Main ***) + +let cost ((fname, _), _, cost_time, _) = + try + if !debug then Printf.printf "Initialize Cost\n%!" ; + let cost_var = + Cil.cvar_to_lvar (Globals.Vars.find_from_astinfo + cost_time.Cerco.cost_id VGlobal) in + initialize "__tmp" fname cost_var + cost_time.Cerco.cost_incr cost_time.Cerco.extern_costs; + with e -> Format.eprintf "** ERROR: %a.@." print_exception_raise e diff --git a/plugin/compute_simple_stack_size.ml b/plugin/compute_simple_stack_size.ml new file mode 100644 index 0000000..56b55e7 --- /dev/null +++ b/plugin/compute_simple_stack_size.ml @@ -0,0 +1,356 @@ +open Parameters +open Cil_types +open Simplify_terms +module Varinfo = Cil_datatype.Varinfo +module Stmt = Cil_datatype.Stmt +module Term = Cil_datatype.Term +module Logic_label = Cil_datatype.Logic_label + + +(** This module defines the main analysis of the plug-in. Its actions are: + - build the CFG of the program; + - initialize the static environment of analysis (parameters of the + functions, number of loops, etc); + - compute the cost of each function depending on the costs of the others; + - try to solve the inequations formed from the previous step so as to obtain + an independent cost for each function; + - save the results; + - add the annotations on the program. *) + + +(** Function computing cost of special instruction *) + +type env = + { env_fun_cost : term Varinfo.Hashtbl.t; + env_cost_incr_name : string; (* TODO put the varinfo *) + env_cost_var_max : logic_var; + env_cost_var : logic_var; + } + + +let cost_loop env kern_fun stmt lab_before_loop cost_body = + (** invariant cost_max <= max(\old(cost_max), \old(cost) + [cost_body]) + invariant cost = \old(cost) + *) + (** first *) + let cost_var_max = Logic_const.tvar env.env_cost_var_max in + let old_cost_max = make_at lab_before_loop cost_var_max in + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = make_at lab_before_loop cost_var in + let cost_iterations = make_binop PlusA old_cost cost_body in + let invariant = if Term.equal old_cost cost_iterations + then Logic_const.prel (Req, cost_var_max, old_cost_max) + else + let new_cost = make_max old_cost_max cost_iterations in + let new_cost = simplify_term new_cost in + Logic_const.prel (Rle, cost_var_max, new_cost) in + let annot = + Logic_const.new_code_annotation + (AInvariant ([stack_cost_behavior],true,invariant)) in + Annotations.add kern_fun stmt [Ast.self] (User annot); + (** second *) + let invariant = Logic_const.prel (Req, cost_var, old_cost) in + let annot = + Logic_const.new_code_annotation + (AInvariant ([stack_cost_behavior],true,invariant)) in + Annotations.add kern_fun stmt [Ast.self] (User annot); + cost_body + +(** computing cost of fundec which contain a call to funvar *) +let cost_of_fun_call env funvar args = + (** can't fail since we use the callgraph *) + let cost = Varinfo.Hashtbl.find env.env_fun_cost funvar in + (* match cost.term_node with *) + (* | TConst (CInt64 (_,_,_)) -> cost *) + (* | _ -> *) + (** arguments of the function *) + let formals = Cil.getFormalsDecl funvar in +(* (** The real arguments are binded using a let and the formal argument are + replaced by fresh variable *) + let letvars = List.map + (fun vi -> Cil.make_temp_logic_var (Ctype vi.vtype)) + formals in + let subst = List.fold_left2 (fun map vi v -> + Varinfo.Map.add vi v map) Varinfo.Map.empty formals letvars in + let cost = + Visitor.visitFramacTerm (new subst_lval subst (Project.current ())) + cost in + let cost = List.fold_left2 (fun tlet v arg -> + let logic_info = { l_var_info = v; l_type = None; l_tparams = []; + l_labels = []; l_profile = []; + l_body = LBnone; } in + let arg = term_of_exp arg in + let tlet = + Logic_const.term (Tlet (logic_info, arg)) + tlet.term_type in + tlet) + cost letvars args in*) + let subst = List.fold_left2 (fun map vi arg -> + try + Varinfo.Map.add vi (term_of_exp arg) map + with Untranslatable_expr _ -> map (** TODO verify that this formal doesn't + appear in the cost of the function *) + ) Varinfo.Map.empty formals args in + let cost = remove_logic_label Logic_const.pre_label cost in + let cost = + Visitor.visitFramacTerm (new subst_lval subst (Project.current ())) + cost in + cost + + +(** We go through the cfg we assume that: + - all functions called have a cost already computed + - no implicit loop (goto), all are explicit Loop + - all loops have an invariant (given by the user or previously computed for + for-loops) + + We iterate on the cfg except when arriving on a loop where we compute the + body alone and after that go to the next statements (the break statement) + + break_statement in which statement to stop the sum (for loop) + *) + + +let rec find_variant = function + | [] -> None + | {annot_content = AVariant (t,_)}::_ -> Some t + | _::l -> find_variant l + +(** TODO: cache the statement already done after if-then-else + (otherwise exponential) *) +(** return None if no path arrive to a good_statement or don't go through + a bad_statetement *) +let rec cfg_sum env kern_fun bad_stmts stop_stmts stmt = + if !debug then + Format.printf "sid: %i,@ bad_stmts: %a,@ stop_stmts: %a,@\n" + stmt.sid + Stmt.Set.pretty bad_stmts + Stmt.Set.pretty stop_stmts; + (** statement in last statement *) + if Stmt.Set.mem stmt stop_stmts + then Some (Cil.lzero ()) + else if Stmt.Set.mem stmt bad_stmts + then None + else + (** successors *) + let succs_bad_stmts = + match stmt.skind with + | Loop (_,_,_,_,_) -> Stmt.Set.add stmt bad_stmts + | _ -> bad_stmts in + (** Cost of the successors of the instruction *) + let cost_succs = + cfg_sum_succs env kern_fun succs_bad_stmts stop_stmts + stmt.succs in + match cost_succs with + | None -> None (** can't go in a good state so count nothing *) + | Some cost_succs -> + (** normalize the cost of the instruction regarding the labels *) + let labels = NormAtLabels.labels_stmt_pre stmt in + (** Cost of the instruction *) + + let sum = + match stmt.skind with + (* (\** call to cost_incr *\) *) + (** cost_stack_incr is not an usual function *) + | Instr + (Call (None, + { enode = + Lval (Var var, _)} , + [cost], _)) + when var.vname = env.env_cost_incr_name -> + make_binop PlusA cost_succs + (make_max (Cil.lzero ()) (term_of_cost_expr cost)) + (** function call *) + | Instr + (Call (_, { enode = + Lval (Var var, _)}, + args,_)) -> + let cost_instr = NormAtLabels.preproc_annot_term labels + (cost_of_fun_call env var args) in + make_max cost_succs cost_instr + (** loops *) + | Loop (_,_,_,_,_) -> + (** the first one perhaps not needed *) + let bad_stmts = Stmt.Set.union bad_stmts stop_stmts in + let stop_stmts = Stmt.Set.singleton stmt in + let cost_body = + cfg_sum_succs env kern_fun bad_stmts stop_stmts stmt.succs in + let cost_body = match cost_body with + | None -> (* no cycle in fact *) Cil.lzero () + | Some cost -> simplify_term cost in + if stmt.labels = [] then + stmt.labels <- (** ugly but... *) + Label("__stmt_"^(string_of_int stmt.sid),Cil.builtinLoc,false):: + stmt.labels; + let label_before_loop = StmtLabel (ref stmt) in + let cost_instr = + cost_loop env kern_fun stmt label_before_loop cost_body in + let cost_instr = NormAtLabels.preproc_annot_term labels cost_instr in + make_max cost_instr cost_succs + | _ -> cost_succs in + (** try to propagate \at(i,Label) *) + let sum = match stmt.skind with + | Instr (Set ((Var vi,_),e,_)) -> + begin try + let t = term_of_exp e in + let subst = Varinfo.Map.singleton vi t in + let sum = + Visitor.visitFramacTerm + (new subst_with_label stmt subst (Project.current ())) + sum in + sum + with exn -> + if !debug then Format.eprintf "can't convert exp %a to term: %a.@." + Cil.defaultCilPrinter#pExp e print_exception exn; + sum end + | _ -> sum + in + (** remove the at that point to this statement we don't know the value at + this point perhaps we will know before ( use Here?? ) *) + let sum = + Visitor.visitFramacTerm + (new remove_stmt_label stmt (Project.current ())) + sum in + Some sum + +and cfg_sum_succs env kern_fun bad_stmts stop_stmts stmts = + let fold cost stmt = + let cost_succ = cfg_sum env kern_fun bad_stmts stop_stmts stmt in + make_max_opt cost cost_succ in + List.fold_left fold None stmts + +let make_leq_cost env sum = + (** ensures cost_max <= max(\old(cost_max), [sum] + cost) *) + let cost_var_max = Logic_const.tvar env.env_cost_var_max in + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = Logic_const.told cost_var in + let old_cost_max = Logic_const.told cost_var_max in + let expr = make_binop PlusA sum old_cost in + let expr = make_max old_cost_max expr in + let post = Logic_const.prel (Rle, cost_var_max, expr) in + let post = Logic_const.new_predicate post in + post + +let make_eq_cost env = + (** ensures cost = old cost *) + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = Logic_const.told cost_var in + let post = Logic_const.prel (Req, cost_var, old_cost) in + let post = Logic_const.new_predicate post in + post + + +let fun_sum env vi = + let kernel_fun = Globals.Functions.get vi in + let fst_stmt = Kernel_function.find_first_stmt kernel_fun in + let last_stmt = Kernel_function.find_return kernel_fun in + let bad_stmts = Stmt.Set.empty in + let stop_stmts = Stmt.Set.singleton last_stmt in + let sum = cfg_sum env kernel_fun bad_stmts stop_stmts fst_stmt in + let sum = match sum with + | None -> assert false (* Oups return not achievable?? *) + (* Infinity!! *) + | Some sum -> + let sum = simplify_term sum in + let sum = Logic_const.told sum in (** add old and push it *) + let labels = NormAtLabels.labels_fct_post in + let sum = NormAtLabels.preproc_annot_term labels sum in + sum in + if !debug then + Format.printf "@[sum of %a: %a@]@." + Cil.defaultCilPrinter#pVar vi + Cil.defaultCilPrinter#pTerm sum; +(** add postcondition about cost *) + let mod_funspec funspec = + let post = make_leq_cost env sum in + let post2 = make_eq_cost env in + let behavior = + Cil.mk_behavior ~name:stack_cost_behavior ~post_cond:[Normal, post; + Normal, post2] () in + {funspec with spec_behavior = behavior::funspec.spec_behavior;} + in + Kernel_function.set_spec kernel_fun mod_funspec; + sum + + +let initialize _tmp_prefix _fname + cost_var cost_var_max cost_incr _extern_costs = + (** TODO? use extern_costs for initializing env_fun_cost ? *) + let callgraph = Callgraph.computeGraph (Ast.get ()) in + if !debug then + Printf.printf "callgraph size: %a\n%!" Callgraph.printGraph callgraph; + let env = { env_fun_cost = Varinfo.Hashtbl.create 10; + env_cost_incr_name = cost_incr; + env_cost_var_max = cost_var_max; + env_cost_var = cost_var + } in + let rec iter : 'a. 'a -> Callgraph.callnode -> unit = fun _ callnode -> + match callnode.Callgraph.cnInfo with + | Callgraph.NIVar (vi,{contents = true }) -> + if not (Varinfo.Hashtbl.mem env.env_fun_cost vi) then begin + Inthash.iter iter callnode.Callgraph.cnCallees; + let sum = fun_sum env vi in + Varinfo.Hashtbl.add env.env_fun_cost vi sum + end + | _ -> () (** put an undefined constant here for top *) + in + (** add the cost of cost_incr *) + let cost_incr = Hashtbl.find callgraph cost_incr in + let cost_incr = match cost_incr.Callgraph.cnInfo with + | Callgraph.NIVar (vi,_) -> vi + | _ -> assert false (* cost_incr must be at least declared *) in + let arg_cost_incr = List.hd (Cil.getFormalsDecl cost_incr) in + let sum_cost_incr = Logic_const.tvar (Cil.cvar_to_lvar arg_cost_incr) in + let post_cost_incr = make_leq_cost env sum_cost_incr in + let post_cost_incr2 = + (** ensures cost = cost + incr *) + let cost_var = Logic_const.tvar env.env_cost_var in + let old_cost = Logic_const.told cost_var in + let expr = make_binop PlusA sum_cost_incr old_cost in + let post = Logic_const.prel (Req, cost_var, expr) in + let post = Logic_const.new_predicate post in + post in + Kernel_function.set_spec (Globals.Functions.get cost_incr) (fun funspec -> + let assigns = + Writes [Logic_const.(new_identified_term (tvar cost_var_max)), FromAny; + Logic_const.(new_identified_term (tvar cost_var)), FromAny] in + let behavior = + Cil.mk_behavior ~name:stack_cost_behavior + ~post_cond:[Normal, post_cost_incr;Normal, post_cost_incr2] + ~assigns () in + {funspec with spec_behavior = behavior::funspec.spec_behavior;} ); + Varinfo.Hashtbl.add env.env_fun_cost cost_incr sum_cost_incr; + (** make the other functions *) + Hashtbl.iter iter callgraph + +(** Save file *) +let save_file fname = + Kernel.CodeOutput.set fname ; + File.pretty_ast () + +(*** Main ***) + +exception NoStackInst + +let cost ((fname, _), _, _cost_time, cost_stack) = + match cost_stack with + | None -> () + | Some (cost_stack_max, cost_stack_id) -> + try + if !debug then Printf.printf "Initialize stack size\n%!" ; + let cost_var_max = + try + Cil.cvar_to_lvar (Globals.Vars.find_from_astinfo + cost_stack_max.Cerco.cost_id VGlobal) + with _ -> raise NoStackInst in + let cost_var = + Cil.cvar_to_lvar (Globals.Vars.find_from_astinfo + cost_stack_id VGlobal) in + initialize "__tmp" fname + cost_var cost_var_max + cost_stack_max.Cerco.cost_incr + cost_stack_max.Cerco.extern_costs; + with + | NoStackInst -> + Format.eprintf "No stack information found.\n%!" + | e -> Format.eprintf "** ERROR: %a.@." print_exception_raise e diff --git a/plugin/cost.ml b/plugin/cost.ml new file mode 100644 index 0000000..776b91b --- /dev/null +++ b/plugin/cost.ml @@ -0,0 +1,163 @@ +(**************************************************************************) +(* *) +(* This file is part of Frama-C. *) +(* *) +(* Copyright (C) 2007-2011 *) +(* CEA (Commissariat à l'énergie atomique et aux énergies *) +(* alternatives) *) +(* *) +(* you can redistribute it and/or modify it under the terms of the GNU *) +(* Lesser General Public License as published by the Free Software *) +(* Foundation, version 2.1. *) +(* *) +(* It 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 Lesser General Public License for more details. *) +(* *) +(* See the GNU Lesser General Public License version 2.1 *) +(* for more details (enclosed in the file licenses/LGPLv2.1). *) +(* *) +(**************************************************************************) + +(** This is the main module of the plug-in. It makes itself available in + Frama-C and apply the cost synthesis on every input file. *) + + +module Self = + Plugin.Register + (struct + let name = "cost synthesis" + let shortname = "cost" + let module_name = "Cost.Self" + let help = "synthesis of the execution cost of each function" + let is_dynamic = true + end) + + +module Enabled = Self.False + (struct + let module_name = "Cost.Enabled" + let option_name = "-cost" + let help = "makes a synthesis of the execution cost of each function" + let kind = `Tuning + end) + +module Lustre = Self.False + (struct + let option_name = "-cost-lustre" + let help = "input file is a Lustre file" + let kind = `Tuning + end) + +module Lustre_verify = Self.False + (struct + let option_name = "-cost-lustre-verify" + let help = + "input file is a Lustre file, verification of the results requested" + let kind = `Tuning + end) + +module Lustre_test = Self.False + (struct + let option_name = "-cost-lustre-test" + let help = + "input file is a Lustre file, testing of the results requested" + let kind = `Tuning + end) + +module Old_computation = Self.False + (struct + let option_name = "-cost-old-computation" + let help = + "Compute the cost formula by the old way" + let kind = `Tuning + end) + +module Output_suffix = Self.String + (struct + let option_name = "-cost-output" + let help = + "Choose the prefix to output the annotation (without -annotated.c)" + let kind = `Tuning + let arg_name = "" + let default = "" + end) + +module Acc_prog = Self.String + (struct + let option_name = "-cost-acc" + let help = + "Specify which program must be used for annotation (default: acc)" + let kind = `Tuning + let arg_name = "" + let default = "acc" + end) + +module Already_instrumented = Self.False + (struct + let option_name = "-cost-already-instrumented" + let help = "input file is already instrumented" + let kind = `Tuning + end) + + +(** The main function: apply CerCo's compiler and the cost synthesis on each + input file. *) + +(** Save file *) +let save_file fname = + Kernel.CodeOutput.set fname ; + File.pretty_ast () + +let run () = + if Enabled.get () then + let lustre_option = Lustre.get () in + let lustre_verify_option = Lustre_verify.get () in + let lustre_test_option = Lustre_test.get () in + let acc_name = Acc_prog.get () in + let user_output_filename = Output_suffix.get () in + let debug = Self.Debug.get () <> 0 in + Compute.debug := debug; + Parameters.debug := debug; + let files : Cabs.file list = Ast.UntypedFiles.get () in + let run_one ((f_name,_) as file) = + let (_,new_name,_,_) as file = + if Already_instrumented.get () then + let default_time = { Cerco.cost_id = "__cost"; + cost_incr = "__cost_incr"; + extern_costs = Misc.String.Map.empty; + } in + let default_stack_max = Some ({ Cerco.cost_id = "__stack_size_max"; + cost_incr = "__stack_size_incr"; + extern_costs = Misc.String.Map.empty; + },"__stack_size") in + let new_name = + (if user_output_filename <> "" then user_output_filename else + (Filename.chop_extension f_name))^"-annotated.c" in + (file,new_name,default_time,default_stack_max) + else + let (((fname,_),_,_,_) as file) = Cerco.apply + acc_name lustre_option lustre_verify_option lustre_test_option + user_output_filename file in + Kernel.Files.set [fname] ; + File.init_from_cmdline () ; + file + in + if Old_computation.get () + then Compute.cost file + else begin + save_file "toto1.c"; + if debug then Printf.printf "Make CFG\n%!" ; + Compute_simple.make_CFG () ; + save_file "toto2.c"; + if debug then Compute_simple.print_CFG () ; + Compute_simple.cost file; + Compute_simple_stack_size.cost file; + Simplify_terms.add_def_max_logic_info (); + if debug then Printf.printf "Save file\n%!" ; + save_file new_name + end in + List.iter run_one files + +let () = Db.Main.extend run diff --git a/plugin/cost_value.ml b/plugin/cost_value.ml new file mode 100644 index 0000000..bbce302 --- /dev/null +++ b/plugin/cost_value.ml @@ -0,0 +1,704 @@ + +(** This module describes the values manipulated by the plug-in. *) + +exception Unknown_cost of string +exception Unknown_prototype of string + + +let string_of_mset to_list sep f mset = + let filter (_, occ) = occ <> 0 in + let f' (elt, occ) = + if occ = 1 then (f elt) + else Printf.sprintf "%d*%s" occ (f elt) in + Misc.List.to_string sep f' (List.filter filter (to_list mset)) + +type prototypes = string list Misc.String.Map.t + + +module type S = sig + + type relation + val is_large : relation -> bool + val has_lower_type : relation -> bool + + type t + + val top : t + val of_int : int -> t + val of_var : string -> t + val add : t -> t -> t + val minus : t -> t -> t + val mul : t -> t -> t + val div : t -> t -> t + val max : t -> t -> t + val cond : t -> relation -> t -> t -> t -> t + val join : t -> t -> t + val widen : t -> t -> t + val narrow : t -> t -> t + + val le : t -> t -> bool + + val replace_vars : t Misc.String.Map.t -> t -> t + + val to_string : t -> string + val string_of_relation : relation -> string + + val compare : t -> t -> int + +end + + +module Make (S : S) = struct + + let s_add_list = function + | [] -> S.of_int 0 + | e :: l -> List.fold_left S.add e l + + module Args = struct + + type t = S.t list + + let compare = Misc.List.compare S.compare + + let le args1 args2 = + if List.length args1 <> List.length args2 then false + else + let f res arg1 arg2 = res && (S.le arg1 arg2) in + List.fold_left2 f true args1 args2 + + let replace_vars replacements = List.map (S.replace_vars replacements) + + let to_string = Misc.List.to_string ", " S.to_string + + end + + + module Externs = struct + + module M = Misc.String.MSet + include M + + let add = union + + let le = subset + + let replace_vars _ externs = externs + + let to_string = string_of_mset to_list " + " (fun x -> x) + + let to_ext externs = + let f x occ ext = S.add (S.mul (S.of_int occ) (S.of_var x)) ext in + fold f externs (S.of_int 0) + + end + + + module FunCall = struct + + type t = + { caller : string ; + id : int ; + callee : string ; + args : Args.t } + let compare = Pervasives.compare + + let caller fun_call = fun_call.caller + let id fun_call = fun_call.id + let callee fun_call = fun_call.callee + let args fun_call = fun_call.args + + let make caller id callee args = { caller ; id ; callee ; args } + + let apply f f_caller f_id f_callee f_args fun_call = + let caller_res = f_caller (caller fun_call) in + let id_res = f_id (id fun_call) in + let callee_res = f_callee (callee fun_call) in + let args_res = f_args (args fun_call) in + f caller_res id_res callee_res args_res + + let apply2 f f_caller f_id f_callee f_args fun_call1 fun_call2 = + let caller_res = f_caller (caller fun_call1) (caller fun_call2) in + let id_res = f_id (id fun_call1) (id fun_call2) in + let callee_res = f_callee (callee fun_call1) (callee fun_call2) in + let args_res = f_args (args fun_call1) (args fun_call2) in + f caller_res id_res callee_res args_res + + let le = + let f b1 b2 b3 b4 = b1 && b2 && b3 && b4 in + apply2 f (=) (=) (=) Args.le + + let replace_vars replacement = + apply make Misc.id Misc.id Misc.id (Args.replace_vars replacement) + + let reduce + to_list is_solved replace_vars of_fun_call + prototypes costs fun_call = + let callee = callee fun_call in + let args = args fun_call in + if Misc.String.Map.mem callee prototypes then + let formals = Misc.String.Map.find callee prototypes in + if List.length formals = List.length args then + let replacements = + Misc.String.Map.of_list (List.combine formals args) in + if Misc.String.Map.mem callee costs then + let cost' = Misc.String.Map.find callee costs in + if is_solved cost' then to_list (replace_vars replacements cost') + else [of_fun_call fun_call] + else raise (Unknown_cost callee) + else + raise + (Failure ("FunCall.reduce: formals and actuals for " ^ + "function " ^ callee ^ " have different sizes.")) + else raise (Unknown_prototype callee) + + let to_string fun_call = + Printf.sprintf "%s@[%s,%d](%s)" + (callee fun_call) (caller fun_call) (id fun_call) + (Args.to_string (args fun_call)) + + end + + module FunCalls = struct + + module M = Multiset.Make (FunCall) + include M + + let singleton_ fun_call = M.add fun_call empty + + let singleton caller id callee args = + singleton (FunCall.make caller id callee args) + + let add = union + + let le1 fun_call occ fun_calls = + let f fun_call' occ' = (FunCall.le fun_call fun_call') && (occ <= occ') in + exists f fun_calls + + let le fun_calls1 fun_calls2 = + let f fun_call occ = le1 fun_call occ fun_calls2 in + for_all f fun_calls1 + + let called_funs fun_calls = + let f fun_call _ called_funs = + Misc.String.Set.add (FunCall.callee fun_call) called_funs in + fold f fun_calls Misc.String.Set.empty + + let replace_vars replacements fun_calls = + let f fun_call _ fun_calls = + let fun_call = FunCall.replace_vars replacements fun_call in + add (singleton_ fun_call) fun_calls in + fold f fun_calls empty + + let to_string = string_of_mset to_list " + " FunCall.to_string + + end + + + module rec LoopCost : sig + type t + val compare : t -> t -> int + val make : string -> int -> S.relation -> S.t -> S.t -> S.t -> Cost.t -> t + val le : t -> t -> bool + val called_funs : t -> Misc.String.Set.t + val replace_vars : S.t Misc.String.Map.t -> t -> t + val reduce : prototypes -> Cost.t Misc.String.Map.t -> t -> t + val to_string : t -> string + val to_ext : t -> S.t + end = struct + + type t = + { fun_name : string ; + id : int ; + relation : S.relation ; + init_value : S.t ; + exit_value : S.t ; + increment : S.t ; + body_cost : Cost.t } + + let make fun_name id relation init_value exit_value increment body_cost = + { fun_name ; id ; relation ; init_value ; exit_value ; increment ; + body_cost } + + let fun_name loop_cost = loop_cost.fun_name + let id loop_cost = loop_cost.id + let relation loop_cost = loop_cost.relation + let init_value loop_cost = loop_cost.init_value + let exit_value loop_cost = loop_cost.exit_value + let increment loop_cost = loop_cost.increment + let body_cost loop_cost = loop_cost.body_cost + + let compare = Pervasives.compare + + let apply f + f_fun_name f_id f_relation f_init_value f_exit_value f_increment + f_body_cost loop_cost = + let fun_name_res = f_fun_name (fun_name loop_cost) in + let id_res = f_id (id loop_cost) in + let relation_res = f_relation (relation loop_cost) in + let init_value_res = f_init_value (init_value loop_cost) in + let exit_value_res = f_exit_value (exit_value loop_cost) in + let increment_res = f_increment (increment loop_cost) in + let body_cost_res = f_body_cost (body_cost loop_cost) in + f + fun_name_res id_res relation_res init_value_res exit_value_res + increment_res body_cost_res + + let apply2 f + f_fun_name f_id f_relation f_init_value f_exit_value f_increment + f_body_cost loop_cost1 loop_cost2 = + let fun_name_res = + f_fun_name (fun_name loop_cost1) (fun_name loop_cost2) in + let id_res = f_id (id loop_cost1) (id loop_cost2) in + let relation_res = + f_relation (relation loop_cost1) (relation loop_cost2) in + let init_value_res = + f_init_value (init_value loop_cost1) (init_value loop_cost2) in + let exit_value_res = + f_exit_value (exit_value loop_cost1) (exit_value loop_cost2) in + let increment_res = + f_increment (increment loop_cost1) (increment loop_cost2) in + let body_cost_res = + f_body_cost (body_cost loop_cost1) (body_cost loop_cost2) in + f + fun_name_res id_res relation_res init_value_res exit_value_res + increment_res body_cost_res + + let le = + let f b1 b2 b3 b4 b5 b6 b7 = b1 && b2 && b3 && b4 && b5 && b6 && b7 in + apply2 f (=) (=) (=) S.le S.le S.le Cost.le + + let called_funs loop_cost = Cost.called_funs (body_cost loop_cost) + + let replace_vars replacements = + let arg_replace_vars = S.replace_vars replacements in + apply make Misc.id Misc.id Misc.id arg_replace_vars arg_replace_vars + arg_replace_vars (Cost.replace_vars replacements) + + let reduce prototypes costs = + apply make Misc.id Misc.id Misc.id Misc.id Misc.id Misc.id + (Cost.reduce prototypes costs) + + let to_string loop_cost = + Printf.sprintf "%s@%d(%s %s %s %s (%s))" + (fun_name loop_cost) + (id loop_cost) + (S.string_of_relation (relation loop_cost)) + (S.to_string (init_value loop_cost)) + (S.to_string (exit_value loop_cost)) + (S.to_string (increment loop_cost)) + (Cost.to_string (body_cost loop_cost)) + + let to_ext loop_cost = + let rel = relation loop_cost in + let init_value = init_value loop_cost in + let exit_value = exit_value loop_cost in + let increment = increment loop_cost in + let body_cost = body_cost loop_cost in + let rel_op = if S.has_lower_type rel then S.minus else S.add in + let rel_added = S.of_int (if S.is_large rel then 0 else 1) in + let iteration_nb = rel_op increment rel_added in + let iteration_nb = S.minus iteration_nb init_value in + let iteration_nb = S.add exit_value iteration_nb in + let iteration_nb = S.div iteration_nb increment in + let body_cost = Cost.to_ext body_cost in + let cond_body_cost = + S.cond init_value rel exit_value body_cost (S.of_int 0) in + S.mul iteration_nb cond_body_cost + + end + + + and LoopCosts : sig + type t + val empty : t + val singleton : + string -> int -> S.relation -> S.t -> S.t -> S.t -> Cost.t -> t + val add : t -> t -> t + val replace_vars : S.t Misc.String.Map.t -> t -> t + val called_funs : t -> Misc.String.Set.t + val reduce : prototypes -> Cost.t Misc.String.Map.t -> t -> t + val to_string : t -> string + val le : t -> t -> bool + val to_ext : t -> S.t + end = struct + + module M = Multiset.Make (LoopCost) + include M + + let singleton_ loop_cost = M.add loop_cost empty + + let singleton + fun_name id relation init_value exit_value increment body_cost = + let loop_cost = + LoopCost.make + fun_name id relation init_value exit_value increment body_cost in + singleton_ loop_cost + + let add = union + + let le1 loop_cost occ loop_costs = + let f loop_cost' occ' res = + res || ((LoopCost.le loop_cost loop_cost') && (occ <= occ')) in + fold f loop_costs false + + let le loop_costs1 loop_costs2 = + let f loop_cost occ res = res && le1 loop_cost occ loop_costs2 in + fold f loop_costs1 true + + let called_funs loop_costs = + let f loop_cost _ called_funs = + Misc.String.Set.union (LoopCost.called_funs loop_cost) called_funs in + fold f loop_costs Misc.String.Set.empty + + let replace_vars replacements loop_costs = + let f loop_cost _ loop_costs = + let loop_cost = LoopCost.replace_vars replacements loop_cost in + add (singleton_ loop_cost) loop_costs in + fold f loop_costs empty + + let reduce prototypes replacements loop_costs = + let f loop_cost occ loop_costs = + add_occ (LoopCost.reduce prototypes replacements loop_cost) occ + loop_costs in + fold f loop_costs empty + + let to_string = string_of_mset to_list " + " LoopCost.to_string + + let to_ext loop_costs = + let f loop_cost occ ext = + S.add (S.mul (S.of_int occ) (LoopCost.to_ext loop_cost)) ext in + fold f loop_costs (S.of_int 0) + + end + + + and Base : sig + type t + val compare : t -> t -> int + val of_int : int -> t + val of_extern : string -> t + val of_fun_call_ : FunCall.t -> t + val of_fun_call : string -> int -> string -> Args.t -> t + val of_loop_cost : + string -> int -> S.relation -> S.t -> S.t -> S.t -> Cost.t -> t + val add : t -> t -> t + val called_funs : t -> Misc.String.Set.t + val replace_vars : S.t Misc.String.Map.t -> t -> t + val reduce : prototypes -> Cost.t Misc.String.Map.t -> t -> Base.t list + val le : t -> t -> bool + val to_string : t -> string + val to_ext : t -> S.t + end = struct + + type t = + { constant : int ; + externs : Externs.t ; + fun_calls : FunCalls.t ; + loop_costs : LoopCosts.t } + + let make constant externs fun_calls loop_costs = + { constant ; externs ; fun_calls ; loop_costs } + + let compare = Pervasives.compare + + let constant base = base.constant + let externs base = base.externs + let fun_calls base = base.fun_calls + let loop_costs base = base.loop_costs + + let set_fun_calls fun_calls base = { base with fun_calls } + let set_loop_costs loop_costs base = { base with loop_costs } + + let to_string base = + Printf.sprintf "%d + (%s) + (%s) + (%s)" + (constant base) + (Externs.to_string (externs base)) + (FunCalls.to_string (fun_calls base)) + (LoopCosts.to_string (loop_costs base)) + + let of_int i = make i Externs.empty FunCalls.empty LoopCosts.empty + + let of_extern x = + make 0 (Externs.singleton x) FunCalls.empty LoopCosts.empty + + let of_fun_call_ fun_call = + make 0 Externs.empty (FunCalls.singleton_ fun_call) LoopCosts.empty + + let of_fun_call caller id callee args = + let fun_call = FunCall.make caller id callee args in + of_fun_call_ fun_call + + let of_loop_cost + fun_name id relation init_value exit_value increment body_cost = + let loop_costs = + LoopCosts.singleton + fun_name id relation init_value exit_value increment body_cost in + make 0 Externs.empty FunCalls.empty loop_costs + + let apply f f_constant f_externs f_fun_calls f_loop_costs base = + let constant_res = f_constant (constant base) in + let externs_res = f_externs (externs base) in + let fun_calls_res = f_fun_calls (fun_calls base) in + let loop_costs_res = f_loop_costs (loop_costs base) in + f constant_res externs_res fun_calls_res loop_costs_res + + let apply2 f f_constant f_externs f_fun_calls f_loop_costs base1 base2 = + let constant_res = f_constant (constant base1) (constant base2) in + let externs_res = f_externs (externs base1) (externs base2) in + let fun_calls_res = f_fun_calls (fun_calls base1) (fun_calls base2) in + let loop_costs_res = f_loop_costs (loop_costs base1) (loop_costs base2) in + f constant_res externs_res fun_calls_res loop_costs_res + + let add = apply2 make (+) Externs.add FunCalls.add LoopCosts.add + + let le = + let f b1 b2 b3 b4 = b1 && b2 && b3 && b4 in + apply2 f (<=) Externs.le FunCalls.le LoopCosts.le + + let replace_vars replacements = + apply make Misc.id + (Externs.replace_vars replacements) + (FunCalls.replace_vars replacements) + (LoopCosts.replace_vars replacements) + + let called_funs base = + Misc.String.Set.union + (FunCalls.called_funs (fun_calls base)) + (LoopCosts.called_funs (loop_costs base)) + + let reduce prototypes costs base = + let f fun_call occ base_list = + let added_bases = + FunCall.reduce + Cost.to_list Cost.is_solved Cost.replace_vars of_fun_call_ + prototypes costs fun_call in + let added_bases = + if added_bases = [] then [of_int 0] else added_bases in + let added_bases = + let f base = Misc.repeat occ (add base) (of_int 0) in + List.map f added_bases in + let f_base_list res added_base = + res @ (List.map (add added_base) base_list) in + List.fold_left f_base_list [] added_bases in + let loop_costs = LoopCosts.reduce prototypes costs (loop_costs base) in + let base = set_loop_costs loop_costs base in + let base' = set_fun_calls FunCalls.empty base in + FunCalls.fold f (fun_calls base) [base'] + + let to_ext base = + let f_fun_calls fun_calls = + if not (FunCalls.is_empty fun_calls) then + raise (Failure "Base.to_ext: function calls") + else S.of_int 0 in + let f ext1 ext2 ext3 ext4 = s_add_list [ext1 ; ext2 ; ext3 ; ext4] in + apply f S.of_int Externs.to_ext f_fun_calls LoopCosts.to_ext base + + end + + + and Cost : sig + type t + val of_int : int -> t + val of_extern : string -> t + val of_fun_call : string -> int -> string -> Args.t -> t + val of_loop_cost : + string -> int -> S.relation -> S.t -> S.t -> S.t -> Cost.t -> t + val of_base : Base.t -> t + val empty : t + val add : t -> t -> t + val join : t -> t -> t + val widen : t -> t -> t + val narrow : t -> t -> t + val called_funs : t -> Misc.String.Set.t + val has_fun_calls : t -> bool + val replace_vars : S.t Misc.String.Map.t -> t -> t + val reduce : prototypes -> Cost.t Misc.String.Map.t -> t -> t + val is_solved : t -> bool + val to_list : t -> Base.t list + val to_string : t -> string + val le : t -> t -> bool + val to_ext : t -> S.t + end = struct + + module M = Eset.Make (Base) + include M + + let to_string cost = + if is_empty cost then "0" + else Misc.List.to_string " max " Base.to_string (to_list cost) + + let of_base base = singleton base + + let of_int i = of_base (Base.of_int i) + + let of_extern x = of_base (Base.of_extern x) + + let of_fun_call caller id callee args = + of_base (Base.of_fun_call caller id callee args) + + let of_loop_cost + fun_name loop_id relation init_value exit_value increment body_cost = + of_base + (Base.of_loop_cost + fun_name loop_id relation init_value exit_value increment body_cost) + + let join1 base cost = + let f_exists base' = Base.le base base' in + if exists f_exists cost then cost + else + let f_absorb base' = Base.le base' base in + M.add base (M.diff cost (M.filter f_absorb cost)) + + let add cost1 cost2 = + if is_empty cost1 then cost2 + else + if is_empty cost2 then cost1 + else + let f2 base1 base2 = join1 (Base.add base1 base2) in + let f1 base1 = fold (f2 base1) cost2 in + fold f1 cost1 empty + + let join cost1 cost2 = + if is_empty cost1 then cost2 + else + if is_empty cost2 then cost1 + else fold join1 cost1 cost2 + + let widen = join + + let narrow = join (* TODO: improve *) + + let mem base cost = + let f base' res = res || (Base.le base base') in + fold f cost false + + let le cost1 cost2 = + let f base res = res && (mem base cost2) in + fold f cost1 true + + + let called_funs cost = + let f base called_funs = + Misc.String.Set.union (Base.called_funs base) called_funs in + fold f cost Misc.String.Set.empty + + let has_fun_calls cost = not (Misc.String.Set.is_empty (called_funs cost)) + + let replace_vars replacements cost = + let f base cost = join1 (Base.replace_vars replacements base) cost in + fold f cost empty + + let reduce prototypes costs cost = + let f base cost = + let base_list = Base.reduce prototypes costs base in + let f_join cost base = join1 base cost in + List.fold_left f_join cost base_list in + fold f cost empty + + let is_solved cost = not (has_fun_calls cost) + + let to_ext cost = + if is_empty cost then S.of_int 0 + else + let f base ext = S.max (Base.to_ext base) ext in + let base = choose cost in + let cost = remove base cost in + fold f cost (Base.to_ext base) + + end + + + type t = Top | C of Cost.t + + + let to_string = function + | Top -> "top" + | C cost -> Cost.to_string cost + + + let of_int i = C (Cost.of_int i) + + let of_extern fun_name = C (Cost.of_extern fun_name) + + let of_fun_call caller id callee args = + C (Cost.of_fun_call caller id callee args) + + let of_loop_cost + fun_name loop_id relation init_value exit_value increment body_cost = + C (Cost.of_loop_cost + fun_name loop_id relation init_value exit_value increment body_cost) + + + let is_top = function Top -> true | _ -> false + + let extract = function + | Top -> raise (Failure "Cost_value.extract") + | C cost -> cost + + let top = Top + + let bot = of_int 0 + + + let top_absorbs f = function + | Top -> Top + | C cost -> C (f cost) + + let top_absorbs2 f cost1 cost2 = match cost1, cost2 with + | Top, _ | _, Top -> Top + | C cost1, C cost2 -> C (f cost1 cost2) + + + let add = top_absorbs2 Cost.add + + let join = top_absorbs2 Cost.join + + let widen = top_absorbs2 Cost.widen + + let narrow cost1 cost2 = match cost1, cost2 with + | cost, Top | Top, cost -> cost + | C cost1, C cost2 -> C (Cost.narrow cost1 cost2) + + let le cost1 cost2 = match cost1, cost2 with + | _, Top -> true + | Top, _ -> false + | C cost1, C cost2 -> Cost.le cost1 cost2 + + + let reduce_ prototypes costs cost = + let called_funs = Cost.called_funs cost in + let costs = + let f fun_name _ = Misc.String.Set.mem fun_name called_funs in + Misc.String.Map.filter f costs in + let f fun_name cost costs = match cost, costs with + | _, None -> None + | Top, _ -> None + | C cost, Some costs -> Some (Misc.String.Map.add fun_name cost costs) in + match Misc.String.Map.fold f costs (Some Misc.String.Map.empty) with + | None -> Top + | Some costs -> C (Cost.reduce prototypes costs cost) + + let reduce prototypes costs = function + | Top -> Top + | C cost -> reduce_ prototypes costs cost + + let reduces prototypes costs = + Misc.String.Map.map (reduce prototypes costs) costs + + + let replace_vars replacements = top_absorbs (Cost.replace_vars replacements) + + + let has_fun_calls = function + | Top -> false + | C cost -> Cost.has_fun_calls cost + + + let is_concrete cost = (not (is_top cost)) && (not (has_fun_calls cost)) + + let to_ext = function + | Top -> S.top + | C cost -> Cost.to_ext cost + + +end diff --git a/plugin/emap.ml b/plugin/emap.ml new file mode 100644 index 0000000..f5775bf --- /dev/null +++ b/plugin/emap.ml @@ -0,0 +1,120 @@ + +module type OrderedType = sig + include Map.OrderedType +end + +module type S = sig + include Map.S + + val merge_f : ('a -> 'a -> 'a) -> 'a t -> 'a t -> 'a t + val split_couple : ('a * 'b) t -> 'a t * 'b t + val combine : 'a t -> 'b t -> ('a * 'b) t + val error_find : key -> 'a t -> exn -> 'a + val of_list : (key * 'a) list -> 'a t + val to_list : 'a t -> (key * 'a) list +end + +module Make (Ord : OrderedType) : S with type key = Ord.t = struct + include Map.Make (Ord) + + let merge_f f map1 map2 = + let f_merge _ e1 e2 = match e1, e2 with + | None, None -> None + | Some e, None | None, Some e -> Some e + | Some e1, Some e2 -> Some (f e1 e2) in + merge f_merge map1 map2 + + let split_couple map = + let f key (a, b) (resa, resb) = (add key a resa, add key b resb) in + fold f map (empty, empty) + + let combine mapa mapb = + let f key a res = + if mem key mapb then add key (a, find key mapb) res + else res in + fold f mapa empty + + let error_find x map error = if mem x map then find x map else raise error + + let of_list l = + let f map (key, binding) = add key binding map in + List.fold_left f empty l + + let to_list = bindings +end + + +module type S1 = sig + type key + type img + type t + val empty : t + val is_empty : t -> bool + val mem : key -> t -> bool + val add : key -> img -> t -> t + val singleton : key -> img -> t + val remove : key -> t -> t + val merge_f : (img -> img -> img) -> t -> t -> t + val merge : (key -> img option -> img option -> img option) -> t -> t -> t + val compare : t -> t -> int + val equal : t -> t -> bool + val iter : (key -> img -> unit) -> t -> unit + val fold : (key -> img -> 'b -> 'b) -> t -> 'b -> 'b + val for_all : (key -> img -> bool) -> t -> bool + val exists : (key -> img -> bool) -> t -> bool + val filter : (key -> img -> bool) -> t -> t + val partition : (key -> img -> bool) -> t -> t * t + val cardinal : t -> int + val bindings : t -> (key * img) list + val min_binding : t -> key * img + val max_binding : t -> key * img + val choose : t -> key * img + val split : key -> t -> t * img option * t + val find : key -> t -> img + val map : (img -> img) -> t -> t + val mapi : (key -> img -> img) -> t -> t + val error_find : key -> t -> exn -> img + val of_list : (key * img) list -> t + val to_list : t -> (key * img) list +end + +module Make1 (Key : OrderedType) (Img : OrderedType) + : S1 with type key = Key.t and type img = Img.t = +struct + + module M = Make (Key) + + type key = M.key + type img = Img.t + type t = img M.t + + let empty = M.empty + let is_empty = M.is_empty + let mem = M.mem + let add = M.add + let singleton = M.singleton + let remove = M.remove + let merge_f = M.merge_f + let merge = M.merge + let compare = M.compare Img.compare + let equal = M.equal (fun img1 img2 -> Img.compare img1 img2 = 0) + let iter = M.iter + let fold = M.fold + let for_all = M.for_all + let exists = M.exists + let filter = M.filter + let partition = M.partition + let cardinal = M.cardinal + let bindings = M.bindings + let min_binding = M.min_binding + let max_binding = M.max_binding + let choose = M.choose + let split = M.split + let find = M.find + let map = M.map + let mapi = M.mapi + let error_find = M.error_find + let of_list = M.of_list + let to_list = M.to_list + +end diff --git a/plugin/eset.ml b/plugin/eset.ml new file mode 100644 index 0000000..a58858c --- /dev/null +++ b/plugin/eset.ml @@ -0,0 +1,24 @@ + +module type OrderedType = Set.OrderedType + +module type S = sig + include Set.S + + val of_list : elt list -> t + val to_list : t -> elt list + val disjoint : t -> t -> bool + val is_subset : t -> t -> bool +end + +module Make (Ord : OrderedType) : S with type elt = Ord.t = struct + module M = Set.Make (Ord) + include M + + let to_list = elements + let of_list l = List.fold_right M.add l M.empty + let disjoint s1 s2 = M.inter s1 s2 = M.empty + + let is_subset set1 set2 = + let f x res = res && (mem x set2) in + fold f set1 true +end diff --git a/plugin/misc.ml b/plugin/misc.ml new file mode 100644 index 0000000..8f7baa9 --- /dev/null +++ b/plugin/misc.ml @@ -0,0 +1,108 @@ + +(** This module provides extended functions for some datatypes. *) + + +module List = struct + + (** [split_nth n l] returns the list of elements of [l] before the [n]th + (exclusive, starting at 0) and those after. Raises [Failure + "Misc.List.split_nth"] if [n] is negative. *) + + let split_nth n l = + if n >= 0 then raise (Failure "Misc.List.split_nth") + else + let rec aux i acc = function + | [] -> (List.rev acc, []) + | l when i = n -> (List.rev acc, l) + | e :: l -> aux (i+1) (e :: acc) l in + aux 0 [] l + + let to_string sep f l = + let rec aux = function + | [] -> "" + | [e] -> f e + | e :: l -> (f e) ^ sep ^ (aux l) in + aux l + + let rec fold_left3 f res l1 l2 l3 = match l1, l2, l3 with + | [], [], [] -> res + | e1 :: l1, e2 :: l2, e3 :: l3 -> fold_left3 f (f res e1 e2 e3) l1 l2 l3 + | _ -> raise (Invalid_argument "Misc.List.fold_left3") + + let foldi f l b = + let rec aux i acc = function + | [] -> acc + | e :: l -> aux (i+1) (f i e acc) l in + aux 0 b l + + let pos e l = + let f i e' res = if e = e' then Some i else res in + foldi f l None + + let sub_unordered l1 l2 = List.for_all (fun e -> List.mem e l2) l1 + + let eq_unordered l1 l2 = (sub_unordered l1 l2) && (sub_unordered l2 l1) + + let compare cmp_a l1 l2 = + let f res e1 e2 = match res with + | None when cmp_a e1 e2 = 0 -> None + | None -> Some (cmp_a e1 e2) + | _ -> res in + let size1 = List.length l1 in + let size2 = List.length l2 in + if size1 < size2 then -1 + else + if size2 < size1 then 1 + else + match List.fold_left2 f None l1 l2 with + | None -> 0 + | Some i -> i + +end + +module Option = struct + + let extract = function + | Some a -> a + | None -> raise (Invalid_argument "Misc.Option.extract") + + let return (i : 'a) : 'a option = Some i + + let (>>=) a f = match a with + | None -> None + | Some a -> f a + + let (>>) a f = match a with + | None -> None + | Some a -> Some (f a) + +end + +module Int = struct + module OrdInt = struct type t = int let compare = Pervasives.compare end + module Set = Eset.Make (OrdInt) + module Map = Emap.Make (OrdInt) + module CMap = CompleteMap.Make (struct include Map let keys = None end) +end + +module String = struct + module Set = Eset.Make (String) + module Map = Emap.Make (String) + module CMap = CompleteMap.Make (struct include Map let keys = None end) + module MSet = Multiset.Make (String) +end + +let compare_couple cmp_a cmp_b (a, b) (a', b') = + let res_a = cmp_a a a' in + if res_a = 0 then cmp_b b b' + else res_a + +let string_of_bool = function + | true -> "true" + | false -> "false" + +let id x = x + +let rec repeat n f a = + if n <= 0 then a + else repeat (n-1) f (f a) diff --git a/plugin/multiset.ml b/plugin/multiset.ml new file mode 100644 index 0000000..e45f852 --- /dev/null +++ b/plugin/multiset.ml @@ -0,0 +1,58 @@ + +module type OrderedType = Eset.OrderedType + +module type S = sig + + type elt + type t + + val compare : t -> t -> int + val empty : t + val is_empty : t -> bool + val singleton : elt -> t + val upd : elt -> int -> t -> t + val add : elt -> t -> t + val add_occ : elt -> int -> t -> t + val find : elt -> t -> int + val union : t -> t -> t + val merge_f : (int -> int -> int) -> t -> t -> t + val fold : (elt -> int -> 'a -> 'a) -> t -> 'a -> 'a + val for_all : (elt -> int -> bool) -> t -> bool + val exists : (elt -> int -> bool) -> t -> bool + val subset : t -> t -> bool + val to_list : t -> (elt * int) list + +end + +module OrdInt = struct + type t = int let compare = Pervasives.compare +end + +module Make (Ord : OrderedType) : S with type elt = Ord.t = struct + + module M = Emap.Make1 (Ord) (OrdInt) + include M + + type elt = Ord.t + + let compare = M.compare + + let singleton x = M.add x 1 empty + + let upd = M.add + + let add_occ x occ mset = + let occ' = if mem x mset then find x mset else 0 in + upd x (occ+occ') mset + + let add x mset = add_occ x 1 mset + + let find x mset = if mem x mset then M.find x mset else 0 + + let union = merge_f (+) + + let subset mset1 mset2 = + let f x occ res = res && (occ <= find x mset2) in + M.fold f mset1 true + +end diff --git a/plugin/normAtLabels.ml b/plugin/normAtLabels.ml new file mode 100644 index 0000000..b449666 --- /dev/null +++ b/plugin/normAtLabels.ml @@ -0,0 +1,258 @@ +(**************************************************************************) +(* *) +(* This file is part of WP plug-in of Frama-C. *) +(* *) +(* Copyright (C) 2007-2011 *) +(* CEA (Commissariat a l'énergie atomique et aux énergies *) +(* alternatives) *) +(* *) +(* you can redistribute it and/or modify it under the terms of the GNU *) +(* Lesser General Public License as published by the Free Software *) +(* Foundation, version 2.1. *) +(* *) +(* It 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 Lesser General Public License for more details. *) +(* *) +(* See the GNU Lesser General Public License version 2.1 *) +(* for more details (enclosed in the file licenses/LGPLv2.1). *) +(* *) +(**************************************************************************) + + +open Cil_types + +(** Copied from clabels.ml *) +(*TODO [LC] : Use extension of Clabels instead *) +let mk_logic_label s = + LogicLabel (Some s, "cost!stmt_"^(string_of_int s.sid)) + + +type label_mapping = Cil_types.logic_label -> Cil_types.logic_label + + +(** push the Tat down to the 'data' operations. +* This can be useful in cases like \at (x + \at(y, Ly), Lx) because +* it gives \at(x, Lx) + \at(y, Ly) so there is no more \at imbrications. + * Also try to "normalize" label : + * - remove Here because its meaning change when propagating, + * - remove Old because its meaning depend on where it comes from. +* *) +class norm_at label_map = object(self) + inherit Visitor.generic_frama_c_visitor (Project.current()) (Cil.copy_visit()) + + val mutable current_label = None + + method private change_label label = + let label = label_map label in + let old_label = current_label in + current_label <- Some label; old_label + + method private restore_term old_label x = + current_label <- old_label; + let x = match x.term_node with + | Ttypeof x -> (* Ttypeof is used as a dummy unary construct *) x + | _ -> assert false + in x + + method private restore_pred old_label x = + current_label <- old_label; + let x = match x.content with + | Pnot x -> (* Pnot is used as a dummy unary construct *) x + | _ -> assert false + in x + + + method vterm t = + match t.term_node with + | Tat (t, l) -> + let old_label = self#change_label l in + let new_t = {t with term_node = Ttypeof t} in + Cil.ChangeDoChildrenPost (new_t, self#restore_term old_label) + | TAddrOf (h, _) | TLval (h, _) | TStartOf (h, _) -> + let old_label = current_label in + let at_label = match h with + | TResult _ -> Some Logic_const.post_label + | _ -> old_label + in + current_label <- None; + let post t = + current_label <- old_label; + match at_label with + | Some label -> {t with term_node = Tat (t, label)} + | None -> t + in Cil.ChangeDoChildrenPost (t, post) + (** logic function without label *) + | Tapp ({l_labels=[]},[],_) -> Cil.DoChildren + | Tapp (_,[],_) -> + begin match current_label with + | None -> Cil.DoChildren + | Some lab -> + let post = function + | {term_node=Tapp(predicate,[],args)} as t -> + { t with term_node=Tapp(predicate,[lab,lab],args) } + | _ -> assert false + in + Cil.ChangeDoChildrenPost (t,post) + end + | Tapp _ -> + let post = function + | {term_node=Tapp(predicate,labels,args)} as t -> + let new_labels = + List.map + (fun (logic_lab, stmt_lab) -> logic_lab, label_map stmt_lab) + labels + in { t with term_node=Tapp(predicate,new_labels,args) } + | _ -> assert false + in + Cil.ChangeDoChildrenPost (t,post) + | _ -> Cil.DoChildren + + method vpredicate_named p = match p.content with + | Pat (p, l) -> + let old_label = self#change_label l in + let new_p = {p with content = Pnot p} in + Cil.ChangeDoChildrenPost (new_p, self#restore_pred old_label) + (** logic function without label *) + | Papp ({l_labels=[]},[],_) -> Cil.DoChildren + | Papp (_,[],_) -> + begin match current_label with + | None -> Cil.DoChildren + | Some lab -> + let post = function + | {content=Papp(predicate,[],args)} as p -> + { p with content=Papp(predicate,[lab,lab],args) } + | _ -> assert false + in + Cil.ChangeDoChildrenPost (p,post) + end + | Papp _ -> + let post = function + | {content=Papp(predicate,labels,args)} as p -> + let new_labels = + List.map + (fun (logic,stmt) -> logic, label_map stmt) + labels + in { p with content=Papp(predicate,new_labels,args) } + | _ -> assert false + in + Cil.ChangeDoChildrenPost (p,post) + | _ -> Cil.DoChildren +end + +exception LabelError of logic_label + +let labels_empty l = raise (LabelError l) + +(* -------------------------------------------------------------------------- *) +(* --- Function Contracts --- *) +(* -------------------------------------------------------------------------- *) + +let labels_fct_pre = function + | LogicLabel (None, ("Pre" | "Here")) -> Logic_const.pre_label + | l -> raise (LabelError l) + + +let labels_fct_post = function + | LogicLabel (None, ("Pre" | "Old")) -> Logic_const.pre_label + | LogicLabel (None, ("Post" | "Here")) -> Logic_const.post_label + | l -> raise (LabelError l) + +let labels_fct_assigns = function + | LogicLabel (None, "Post") -> Logic_const.post_label + | LogicLabel (None, ("Pre" | "Old")) -> Logic_const.pre_label + | l -> raise (LabelError l) + +(* -------------------------------------------------------------------------- *) +(* --- Statements Contracts --- *) +(* -------------------------------------------------------------------------- *) +let labels_stmt_pre s = function + | LogicLabel (None, "Pre") -> Logic_const.pre_label (* fct pre-state *) + | LogicLabel (None, "Here") -> mk_logic_label s + | LogicLabel (Some s, _) -> mk_logic_label s + | StmtLabel rs -> mk_logic_label !rs + | l -> raise (LabelError l) + +let labels_stmt_post s l_post = function + | LogicLabel (None, "Pre") -> Logic_const.pre_label (* fct pre-state *) + | LogicLabel (None, "Old") -> mk_logic_label s (* contract pre-state *) + | LogicLabel (None, ("Here" | "Post")) as l -> + begin match l_post with Some l -> l + | None -> (* TODO ? *) raise (LabelError l) + end + | LogicLabel (Some s, _) -> mk_logic_label s + | StmtLabel rs -> mk_logic_label !rs + | l -> raise (LabelError l) + +let labels_stmt_assigns s l_post = function + | LogicLabel (None, "Pre") -> Logic_const.pre_label (* fct pre-state *) + | LogicLabel (None, ("Here" | "Old")) -> (* contract pre-state *) + mk_logic_label s + | LogicLabel (None, "Post") -> labels_stmt_post s l_post Logic_const.post_label + | LogicLabel (Some s, _) -> mk_logic_label s + | StmtLabel rs -> mk_logic_label !rs + | l -> raise (LabelError l) + +(* -------------------------------------------------------------------------- *) +(* --- User Assertions in Functions Code --- *) +(* -------------------------------------------------------------------------- *) + +let labels_assert_before s = function + | LogicLabel (None, "Pre") -> Logic_const.pre_label + | LogicLabel (None, "Here") -> mk_logic_label s + | LogicLabel (Some s, _) -> mk_logic_label s + | StmtLabel rs -> mk_logic_label !rs + | l -> raise (LabelError l) + +let labels_assert_after s l_post = function + | LogicLabel (None, "Pre") -> Logic_const.pre_label + | LogicLabel (None, "Here") -> + labels_stmt_post s l_post Logic_const.post_label + | LogicLabel (Some s, _) -> mk_logic_label s + | StmtLabel rs -> mk_logic_label !rs + | l -> raise (LabelError l) + +let labels_loop_inv _s = function + | LogicLabel (None, "Pre") -> Logic_const.pre_label + | LogicLabel (None, "Here") -> Logic_const.here_label + | LogicLabel (None, ("Old" | "Post")) as l -> raise (LabelError l) + | l -> l + +let labels_loop_assigns s l = labels_loop_inv s l + +(* -------------------------------------------------------------------------- *) +(* --- User Defined Predicates --- *) +(* -------------------------------------------------------------------------- *) + +let labels_predicate lab_pairs = fun l -> + try List.assoc l lab_pairs + with Not_found -> l + +let labels_axiom = function + | LogicLabel (None, ("Pre"|"Old"|"Post")) as l -> raise (LabelError l) + | LogicLabel (None, _) as l -> l + | l -> raise (LabelError l) + +(* -------------------------------------------------------------------------- *) +(* --- Apply Normalization --- *) +(* -------------------------------------------------------------------------- *) + +(** @raise LabelError if there is a label in [p] that is incompatible +* with the [labels] translation *) +let preproc_annot labels p = + let visitor = new norm_at labels in + Visitor.visitFramacPredicateNamed visitor p + +let preproc_annot_term labels t = + let visitor = new norm_at labels in + Visitor.visitFramacTerm visitor t + + +(** @raise LabelError if there is a label in [p] that is incompatible +* with the [labels] translation *) +let preproc_assigns labels asgns = + let visitor = new norm_at labels in + List.map (Visitor.visitFramacFrom visitor) asgns + +let preproc_label labels l = labels l diff --git a/plugin/normAtLabels.mli b/plugin/normAtLabels.mli new file mode 100644 index 0000000..3ce849e --- /dev/null +++ b/plugin/normAtLabels.mli @@ -0,0 +1,51 @@ +(**************************************************************************) +(* *) +(* This file is part of WP plug-in of Frama-C. *) +(* *) +(* Copyright (C) 2007-2011 *) +(* CEA (Commissariat a l'énergie atomique et aux énergies *) +(* alternatives) *) +(* *) +(* you can redistribute it and/or modify it under the terms of the GNU *) +(* Lesser General Public License as published by the Free Software *) +(* Foundation, version 2.1. *) +(* *) +(* It 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 Lesser General Public License for more details. *) +(* *) +(* See the GNU Lesser General Public License version 2.1 *) +(* for more details (enclosed in the file licenses/LGPLv2.1). *) +(* *) +(**************************************************************************) + +open Cil_types + +type label_mapping + +val labels_empty : label_mapping +val labels_fct_pre : label_mapping +val labels_fct_post : label_mapping +val labels_fct_assigns : label_mapping +val labels_assert_before : stmt -> label_mapping +val labels_assert_after : stmt -> logic_label option -> label_mapping +val labels_loop_inv : stmt -> label_mapping +val labels_loop_assigns : stmt -> label_mapping +val labels_stmt_pre : stmt -> label_mapping +val labels_stmt_post : stmt -> logic_label option -> label_mapping +val labels_stmt_assigns : stmt -> logic_label option -> label_mapping +val labels_predicate : (logic_label * logic_label) list -> label_mapping +val labels_axiom : label_mapping + +val preproc_annot : label_mapping -> predicate named -> predicate named +val preproc_annot_term : label_mapping -> term -> term + +val preproc_assigns : + label_mapping -> identified_term from list -> identified_term from list + +val preproc_label : label_mapping -> logic_label -> logic_label + +(** from clabels.mli *) +(** create a virtual label to a statement (it can have no label) *) +val mk_logic_label : Cil_types.stmt -> Cil_types.logic_label diff --git a/plugin/parameters.ml b/plugin/parameters.ml new file mode 100644 index 0000000..c3ff847 --- /dev/null +++ b/plugin/parameters.ml @@ -0,0 +1,23 @@ + +(** Parameters *) +let remove_casts_in_annotations = true +let put_const_at_the_top_in_annotations = true + +(** Less precise cost *) +let no_division_in_generated_variant = false + +(** name of the behavior generated *) +let time_cost_behavior = "time_cost" + +(** name of the behavior generated *) +let stack_cost_behavior = "stack_cost" + + +(*** Debug flag ***) + +let debug = ref false + + + + + diff --git a/plugin/simplify_terms.ml b/plugin/simplify_terms.ml new file mode 100644 index 0000000..c3fb74f --- /dev/null +++ b/plugin/simplify_terms.ml @@ -0,0 +1,415 @@ +(** This module gives utility functions for creating terms and + simplifying them *) + +open Parameters +open Cil_types +module Varinfo = Cil_datatype.Varinfo +module Stmt = Cil_datatype.Stmt +module Term = Cil_datatype.Term +module Logic_label = Cil_datatype.Logic_label + +(** {Add needed logic function} *) + +let get_max_logic_info, add_def_max_logic_info = + (* TODO the name can collide with other logic function *) + let module M = State_builder.Option_ref(Cil_datatype.Logic_info) + (struct + let name = "max_logic_fun" + let dependencies = [Annotations.self] + let kind = `Internal + end) in + let create () = + let x = Cil_const.make_logic_var "x" Linteger in + let y = Cil_const.make_logic_var "y" Linteger in + let tx = Logic_const.tvar x in let ty = Logic_const.tvar y in + let body = + let cond = Logic_const.term (TBinOp (Gt,tx,ty)) Linteger in + let term = Logic_const.term (Tif (cond,tx,ty)) Linteger in + term in + let signature = Larrow ([Linteger;Linteger],Linteger) in + let li = { l_var_info = Cil_const.make_logic_var "__max" signature; + l_labels = []; + l_tparams = []; + l_type = Some Linteger; + l_profile = [x;y]; + l_body = LBterm body } in + li + in + (fun () -> M.memo create), + (fun () -> + match M.get_option () with + | None -> () + | Some li -> + Globals.Annotations.add_generated + (Dfun_or_pred (li, Cil_datatype.Location.unknown))) + + +(** {2 Simplify casts} *) +(** Casts may get in the way when looking for a loop counter, just remove + them. *) + +let rec remove_casts e = match e.enode with + | Lval lval -> + { e with enode = Lval (remove_casts_lval lval) } + | SizeOfE e -> + { e with enode = SizeOfE (remove_casts e) } + | AlignOfE e -> + { e with enode = AlignOfE (remove_casts e) } + | UnOp (unop, e, typ) -> + { e with enode = UnOp (unop, remove_casts e, typ) } + | BinOp (binop, e1, e2, typ) -> + let enode = + BinOp (binop, remove_casts e1, remove_casts e2, typ) in + { e with enode } + | CastE (_, e) -> remove_casts e + | AddrOf lval -> + { e with enode = AddrOf (remove_casts_lval lval) } + | StartOf lval -> + { e with enode = StartOf (remove_casts_lval lval) } + | Info (e, info) -> + { e with enode = Info (remove_casts e, info) } + | _ -> e + +and remove_casts_lval (lhost, offset) = + (remove_casts_lhost lhost, remove_casts_offset offset) + +and remove_casts_lhost = function + | Mem e -> Mem (remove_casts e) + | lhost -> lhost + +and remove_casts_offset = function + | Field (fieldinfo, offset) -> + Field (fieldinfo, remove_casts_offset offset) + | Index (e, offset) -> + Index (remove_casts e, remove_casts_offset offset) + | offset -> offset + + +(** {2 Simplify and convert terms} *) + + +(*** Exceptions ***) +exception Untranslatable_expr of exp + +let print_exception_raise fmt = function + | Untranslatable_expr exp -> + Format.fprintf fmt "Can't convert exp %a to term.@." + Cil.defaultCilPrinter#pExp exp; + | e -> raise e + +let print_exception fmt exn = + try + print_exception_raise fmt exn + with _ -> Format.fprintf fmt "%s" (Printexc.to_string exn) + + +(** raised when a function call contains something that can't be translated to + term *) + +(** cost of incr_cost (cost of all the instruction until the next one) *) +let rec term_of_exp e = + let open Cil_types in + match e.enode with + | Const (CInt64 _ as c) -> + Logic_const.term (TConst c) (Ctype (Cil.typeOf e)) + | Lval (Var varinfo, offset) -> + let logic_var = Cil.cvar_to_lvar varinfo in + let offset = term_offset_of_offset offset in + Logic_const.term (TLval (TVar logic_var, offset)) (Ctype (Cil.typeOf e)) + | Info (e, _) -> term_of_exp e + | UnOp (unop, e, typ) -> + Logic_const.term (TUnOp (unop, term_of_exp e)) (Ctype typ) + | BinOp (binop, e1, e2, typ) -> + Logic_const.term (TBinOp (binop, term_of_exp e1, term_of_exp e2)) + (Ctype typ) + | CastE (typ, e) -> + Logic_const.term (TCastE (typ, term_of_exp e)) (Ctype typ) + | _ -> raise (Untranslatable_expr e) + +and term_offset_of_offset = function + | NoOffset -> TNoOffset + | Field (fi, offset) -> + TField(fi, term_offset_of_offset offset) + | Index (exp, offset) -> + TIndex(term_of_exp exp, term_offset_of_offset offset) + +let term_of_exp e = + let e = if remove_casts_in_annotations then remove_casts e else e in + term_of_exp e + +(** Same as before but use integer for all the types *) +let term_of_cost_expr e = + match e.enode with + | Const (CInt64 _ as c) -> + Logic_const.term (TConst c) Linteger + (** TODO: convert the other function use integer when needed *) + | _ -> raise (Untranslatable_expr e) + +(** Operation simplifying (** same as termFoldConst ? *) *) + +let make_at label x = + let open Cil_types in + match x.term_node with + | TConst (CInt64 (_,_,_)) -> x + | _ -> Logic_const.tat (x,label) + +(** Use only for cost *) +let make_max x y = + match x, y with + (** two constants *) + | {term_node = TConst (CInt64 (xn,_,_))}, + {term_node = TConst (CInt64 (yn,_,_))} -> + (Cil.lconstant (My_bigint.max xn yn)) + (* (\** one null *\) *) (* correct but dangerous *) + (* | {term_node = TConst (CInt64 (zero,_,_))}, other *) + (* | other, {term_node = TConst (CInt64 (zero,_,_))} *) + (* when My_bigint.is_zero zero -> other *) + (** generic case *) + | x, y -> + Logic_const.term (Tapp (get_max_logic_info (), [], [x;y])) Linteger + +let make_max_opt x y = + match x, y with + (** one inaccessible *) + | None, other | other, None -> other + | Some x, Some y -> Some (make_max x y) + +let make_sign = function + (** two constants *) + | {term_node = TConst (CInt64 (xn,_,_))} -> + if My_bigint.ge xn My_bigint.zero + then (Cil.lconstant (My_bigint.one)) + else (Cil.lconstant (My_bigint.minus_one)) + (* (\** one null *\) *) (* correct but dangerous *) + (* | {term_node = TConst (CInt64 (zero,_,_))}, other *) + (* | other, {term_node = TConst (CInt64 (zero,_,_))} *) + (* when My_bigint.is_zero zero -> other *) + (** generic case *) + | x -> + let cond = Logic_const.term (TBinOp (Ge,x,Cil.lzero ())) Linteger in + let term = Logic_const.term (Tif (cond, + (Cil.lconstant (My_bigint.one)), + (Cil.lconstant (My_bigint.minus_one)))) + Linteger in + term + +let make_unop unop x = + match unop, x.term_node with + | Neg, TUnOp(Neg,y) -> y + | Neg, TConst (CInt64 (xn,_,_)) -> Cil.lconstant (My_bigint.neg xn) + | _ -> Logic_const.term (TUnOp (unop,x)) Linteger + +let make_binop binop x y = + match binop, x.term_node, y.term_node with + | PlusA, TConst (CInt64 (xn,_,_)), TConst (CInt64 (yn,_,_)) -> + Cil.lconstant (My_bigint.add xn yn) + | PlusA, TConst (CInt64 (zero,_,_)), _ when My_bigint.is_zero zero -> y + | PlusA, _, TConst (CInt64 (zero,_,_)) when My_bigint.is_zero zero -> x + + | MinusA, TConst (CInt64 (xn,_,_)), TConst (CInt64 (yn,_,_)) -> + Cil.lconstant (My_bigint.sub xn yn) + | MinusA, TConst (CInt64 (zero,_,_)), _ when My_bigint.is_zero zero -> + make_unop Neg y + | MinusA, _, TConst (CInt64 (zero,_,_)) when My_bigint.is_zero zero -> x + | Mult, TConst (CInt64 (xn,_,_)), TConst (CInt64 (yn,_,_)) -> + Cil.lconstant (My_bigint.mul xn yn) + | Mult, TConst (CInt64 (zero,_,_)), _ when My_bigint.is_zero zero -> x + | Mult, _, TConst (CInt64 (zero,_,_)) when My_bigint.is_zero zero -> y + | Mult, TConst (CInt64 (one,_,_)), _ when My_bigint.is_one one -> y + | Mult, _, TConst (CInt64 (one,_,_)) when My_bigint.is_one one -> x + | Div, TConst (CInt64 (xn,_,_)), TConst (CInt64 (yn,_,_)) -> + Cil.lconstant (My_bigint.div xn yn) + (* | Div, TConst (CInt64 (zero,_,_)), _ when My_bigint.is_zero zero -> x *) + (* | Div, _, TConst (CInt64 (zero,_,_)) when My_bigint.is_zero zero -> y *) + | Div, _, TConst (CInt64 (one,_,_)) when My_bigint.is_one one -> x + | Div, _, TConst (CInt64 (minus_one,_,_)) + when My_bigint.equal My_bigint.minus_one minus_one -> + make_unop Neg x + | _ -> Logic_const.term (TBinOp (binop,x,y)) Linteger + +let simplify_term_top t = + match t.term_node with + | TBinOp(binop,x,y) -> make_binop binop x y + | TUnOp(unop,x) -> make_unop unop x + | Tif({term_node = + TBinOp ((Lt|Le|Gt|Ge|Eq|Ne) as rel, + {term_node = TConst (CInt64 (xn,_,_))}, + {term_node = TConst (CInt64 (yn,_,_))})},t1,t2) -> + let b = match rel with + | Lt -> My_bigint.lt xn yn + | Gt -> My_bigint.gt xn yn + | Le -> My_bigint.le xn yn + | Ge -> My_bigint.ge xn yn + | Eq -> My_bigint.equal xn yn + | Ne -> not (My_bigint.equal xn yn) + | _ -> assert false in + if b then t1 else t2 + | Tapp(f, [], [{term_node = TConst (CInt64 (xn,_,_))} as xt; + {term_node = TConst (CInt64 (yn,_,_))} as yt]) when + Cil_datatype.Logic_info.equal f (get_max_logic_info ()) -> + if My_bigint.gt xn yn then xt else yt + | _ -> t + +class simplify_term prj = +object inherit Visitor.frama_c_copy prj as super + method vterm term = Cil.ChangeDoChildrenPost(term,simplify_term_top) +end + +let rec top_const_form t = + match t.term_node with + | TConst _ -> t, (Cil.lzero ()) + | TUnOp(unop,x) -> + let cx,x = top_const_form x in + begin match unop with + | Neg -> make_unop unop cx, make_unop unop x + | _ -> (Cil.lzero ()), + Logic_const.term (TUnOp (unop,make_binop PlusA cx x)) Linteger end + | TBinOp(binop,x,y) -> + let cx,x = top_const_form x in + let cy,y = top_const_form y in + begin match binop with + | PlusA -> make_binop binop cx cy, make_binop binop x y + | MinusA -> make_binop binop cx cy, make_binop binop x y + | Mult -> make_binop binop cx cy, + make_binop PlusA (make_binop binop x y) + (make_binop PlusA (make_binop binop cx y) + (make_binop binop cy x)) + | _ -> (Cil.lzero ()), + Logic_const.term (TBinOp (binop, make_binop PlusA cx x, + make_binop PlusA cy y)) Linteger end + | Tif(t1,t2,t3) -> + let c1,t1 = top_const_form t1 in + let c2,t2 = top_const_form t2 in + let c3,t3 = top_const_form t3 in + Cil.lzero (), + Logic_const.term (Tif(make_binop PlusA c1 t1, + make_binop PlusA c2 t2, + make_binop PlusA c3 t3)) Linteger + | Tapp(f, labs, l) -> + Cil.lzero (), + Logic_const.term + (Tapp(f, labs, List.map (fun t -> let c,t = top_const_form t in + make_binop PlusA c t) l)) + Linteger + | _ -> (Cil.lzero ()),t + + +let top_const_form t = + let ct,t = top_const_form t in + make_binop PlusA ct t + +let simplify_term term = + let term = + Visitor.visitFramacTerm (new simplify_term (Project.current ())) term in + if put_const_at_the_top_in_annotations then top_const_form term else term + + +(** {2 Simply labels} *) + +class subst_lval subst prj = +object inherit Visitor.frama_c_copy prj as super + method vterm term = + let open Cil_types in + match term.term_node with + | TLval (TVar {lv_origin = Some vi},TNoOffset) + when Varinfo.Map.mem vi subst -> + Cil.ChangeTo (Varinfo.Map.find vi subst) + | _ -> Cil.DoChildren + +end + +class subst_with_label stmt_label subst prj = +object inherit Visitor.frama_c_copy prj as super + method vterm term = + let open Cil_types in + match term.term_node with + | TLval (TVar {lv_origin = Some vi},TNoOffset) (**TODO other offset *) + when Varinfo.Map.mem vi subst -> + Cil.ChangeTo (Varinfo.Map.find vi subst) + | Tat _ -> Cil.JustCopy (* don't touch if we don't see it *) + | _ -> Cil.ChangeDoChildrenPost(term,simplify_term_top) + +end + +class remove_stmt_label stmt_label prj = +object inherit Visitor.frama_c_copy prj as super + method vterm term = + let open Cil_types in + match term.term_node with + | Tat(t, (LogicLabel (Some stmt,_))) + when Stmt.equal stmt stmt_label -> + Cil.ChangeTo t + | Tapp(li,l,t) -> + let rec filter_label l = + match l with + | [] -> l + (** TODO understand what the differences between la and lb *) + | (( LogicLabel(Some stmt,_),_) | (_,LogicLabel(Some stmt,_)))::ll + when Stmt.equal stmt stmt_label -> filter_label ll + | a::ll -> + let ll' = filter_label ll in + if ll == ll' then l else a::ll' in + let l' = filter_label l in + if l == l' then Cil.DoChildren + else Cil.ChangeDoChildrenPost + ({term with term_node = Tapp(li,l',t)},fun x -> x) + | _ -> Cil.DoChildren +end + + +class remove_logic_label lab prj = +object inherit Visitor.frama_c_copy prj as super + method vterm term = + let open Cil_types in + match term.term_node with + | Tat(t, label) + when Logic_label.equal label lab -> + Cil.ChangeTo t + | Tapp(li,l,t) -> + let rec filter_label l = + match l with + | [] -> l + (** TODO understand what the differences between la and lb *) + | (label1,label2)::ll + when Logic_label.equal label1 lab || + Logic_label.equal label2 lab -> filter_label ll + | a::ll -> + let ll' = filter_label ll in + if ll == ll' then l else a::ll' in + let l' = filter_label l in + if l == l' then Cil.DoChildren + else Cil.ChangeDoChildrenPost + ({term with term_node = Tapp(li,l',t)},fun x -> x) + | _ -> Cil.DoChildren +end + +let remove_logic_label lab cost = + Visitor.visitFramacTerm + (new remove_logic_label lab (Project.current ())) + cost + + +let rec freevar acc t = + match t.term_node with + | TConst _ -> acc + | TUnOp(_,x) -> freevar acc x + | TBinOp(_,x,y) -> freevar (freevar acc x) y + | Tif(t1,t2,t3) -> freevar (freevar (freevar acc t1) t2) t3 + | Tapp(_, _, l) -> List.fold_left freevar acc l + | Tat(t,_) -> freevar acc t + | (TLval(TVar lv,_)) -> Cil_datatype.Logic_var.Set.add lv acc + | _ -> assert false + + +let tapp li args = + let cast lv t = + match lv.lv_type with + | Ctype typ -> + (** the main handle cases is t is an integer, lv an is int so we + need a cast (int)t *) + (* if Logic_utils.is_same_type lv.lv_type t.term_type *) + (* then t *) + (* else *) Logic_const.term (TCastE(typ,t)) lv.lv_type + | _ -> t in + let args = List.map2 cast li.l_profile args in + Tapp(li,[],args) diff --git a/plugin/tests/fail/blowfish.c b/plugin/tests/fail/blowfish.c new file mode 100644 index 0000000..d117d95 --- /dev/null +++ b/plugin/tests/fail/blowfish.c @@ -0,0 +1,829 @@ +/* + * Author : Paul Kocher + * E-mail : pck@netcom.com + * Date : 1997 + * Description: C implementation of the Blowfish algorithm. + */ + +#include "blowfish.h" + + + +#define N 16 + + + +static unsigned long F(BLOWFISH_CTX *ctx, unsigned long x); + + + + + + + +static const unsigned long ORIG_P[16 + 2] = { + + 0x243F6A88L, 0x85A308D3L, 0x13198A2EL, 0x03707344L, + + 0xA4093822L, 0x299F31D0L, 0x082EFA98L, 0xEC4E6C89L, + + 0x452821E6L, 0x38D01377L, 0xBE5466CFL, 0x34E90C6CL, + + 0xC0AC29B7L, 0xC97C50DDL, 0x3F84D5B5L, 0xB5470917L, + + 0x9216D5D9L, 0x8979FB1BL + +}; + + + +static const unsigned long ORIG_S[4][256] = { + + { 0xD1310BA6L, 0x98DFB5ACL, 0x2FFD72DBL, 0xD01ADFB7L, + + 0xB8E1AFEDL, 0x6A267E96L, 0xBA7C9045L, 0xF12C7F99L, + + 0x24A19947L, 0xB3916CF7L, 0x0801F2E2L, 0x858EFC16L, + + 0x636920D8L, 0x71574E69L, 0xA458FEA3L, 0xF4933D7EL, + + 0x0D95748FL, 0x728EB658L, 0x718BCD58L, 0x82154AEEL, + + 0x7B54A41DL, 0xC25A59B5L, 0x9C30D539L, 0x2AF26013L, + + 0xC5D1B023L, 0x286085F0L, 0xCA417918L, 0xB8DB38EFL, + + 0x8E79DCB0L, 0x603A180EL, 0x6C9E0E8BL, 0xB01E8A3EL, + + 0xD71577C1L, 0xBD314B27L, 0x78AF2FDAL, 0x55605C60L, + + 0xE65525F3L, 0xAA55AB94L, 0x57489862L, 0x63E81440L, + + 0x55CA396AL, 0x2AAB10B6L, 0xB4CC5C34L, 0x1141E8CEL, + + 0xA15486AFL, 0x7C72E993L, 0xB3EE1411L, 0x636FBC2AL, + + 0x2BA9C55DL, 0x741831F6L, 0xCE5C3E16L, 0x9B87931EL, + + 0xAFD6BA33L, 0x6C24CF5CL, 0x7A325381L, 0x28958677L, + + 0x3B8F4898L, 0x6B4BB9AFL, 0xC4BFE81BL, 0x66282193L, + + 0x61D809CCL, 0xFB21A991L, 0x487CAC60L, 0x5DEC8032L, + + 0xEF845D5DL, 0xE98575B1L, 0xDC262302L, 0xEB651B88L, + + 0x23893E81L, 0xD396ACC5L, 0x0F6D6FF3L, 0x83F44239L, + + 0x2E0B4482L, 0xA4842004L, 0x69C8F04AL, 0x9E1F9B5EL, + + 0x21C66842L, 0xF6E96C9AL, 0x670C9C61L, 0xABD388F0L, + + 0x6A51A0D2L, 0xD8542F68L, 0x960FA728L, 0xAB5133A3L, + + 0x6EEF0B6CL, 0x137A3BE4L, 0xBA3BF050L, 0x7EFB2A98L, + + 0xA1F1651DL, 0x39AF0176L, 0x66CA593EL, 0x82430E88L, + + 0x8CEE8619L, 0x456F9FB4L, 0x7D84A5C3L, 0x3B8B5EBEL, + + 0xE06F75D8L, 0x85C12073L, 0x401A449FL, 0x56C16AA6L, + + 0x4ED3AA62L, 0x363F7706L, 0x1BFEDF72L, 0x429B023DL, + + 0x37D0D724L, 0xD00A1248L, 0xDB0FEAD3L, 0x49F1C09BL, + + 0x075372C9L, 0x80991B7BL, 0x25D479D8L, 0xF6E8DEF7L, + + 0xE3FE501AL, 0xB6794C3BL, 0x976CE0BDL, 0x04C006BAL, + + 0xC1A94FB6L, 0x409F60C4L, 0x5E5C9EC2L, 0x196A2463L, + + 0x68FB6FAFL, 0x3E6C53B5L, 0x1339B2EBL, 0x3B52EC6FL, + + 0x6DFC511FL, 0x9B30952CL, 0xCC814544L, 0xAF5EBD09L, + + 0xBEE3D004L, 0xDE334AFDL, 0x660F2807L, 0x192E4BB3L, + + 0xC0CBA857L, 0x45C8740FL, 0xD20B5F39L, 0xB9D3FBDBL, + + 0x5579C0BDL, 0x1A60320AL, 0xD6A100C6L, 0x402C7279L, + + 0x679F25FEL, 0xFB1FA3CCL, 0x8EA5E9F8L, 0xDB3222F8L, + + 0x3C7516DFL, 0xFD616B15L, 0x2F501EC8L, 0xAD0552ABL, + + 0x323DB5FAL, 0xFD238760L, 0x53317B48L, 0x3E00DF82L, + + 0x9E5C57BBL, 0xCA6F8CA0L, 0x1A87562EL, 0xDF1769DBL, + + 0xD542A8F6L, 0x287EFFC3L, 0xAC6732C6L, 0x8C4F5573L, + + 0x695B27B0L, 0xBBCA58C8L, 0xE1FFA35DL, 0xB8F011A0L, + + 0x10FA3D98L, 0xFD2183B8L, 0x4AFCB56CL, 0x2DD1D35BL, + + 0x9A53E479L, 0xB6F84565L, 0xD28E49BCL, 0x4BFB9790L, + + 0xE1DDF2DAL, 0xA4CB7E33L, 0x62FB1341L, 0xCEE4C6E8L, + + 0xEF20CADAL, 0x36774C01L, 0xD07E9EFEL, 0x2BF11FB4L, + + 0x95DBDA4DL, 0xAE909198L, 0xEAAD8E71L, 0x6B93D5A0L, + + 0xD08ED1D0L, 0xAFC725E0L, 0x8E3C5B2FL, 0x8E7594B7L, + + 0x8FF6E2FBL, 0xF2122B64L, 0x8888B812L, 0x900DF01CL, + + 0x4FAD5EA0L, 0x688FC31CL, 0xD1CFF191L, 0xB3A8C1ADL, + + 0x2F2F2218L, 0xBE0E1777L, 0xEA752DFEL, 0x8B021FA1L, + + 0xE5A0CC0FL, 0xB56F74E8L, 0x18ACF3D6L, 0xCE89E299L, + + 0xB4A84FE0L, 0xFD13E0B7L, 0x7CC43B81L, 0xD2ADA8D9L, + + 0x165FA266L, 0x80957705L, 0x93CC7314L, 0x211A1477L, + + 0xE6AD2065L, 0x77B5FA86L, 0xC75442F5L, 0xFB9D35CFL, + + 0xEBCDAF0CL, 0x7B3E89A0L, 0xD6411BD3L, 0xAE1E7E49L, + + 0x00250E2DL, 0x2071B35EL, 0x226800BBL, 0x57B8E0AFL, + + 0x2464369BL, 0xF009B91EL, 0x5563911DL, 0x59DFA6AAL, + + 0x78C14389L, 0xD95A537FL, 0x207D5BA2L, 0x02E5B9C5L, + + 0x83260376L, 0x6295CFA9L, 0x11C81968L, 0x4E734A41L, + + 0xB3472DCAL, 0x7B14A94AL, 0x1B510052L, 0x9A532915L, + + 0xD60F573FL, 0xBC9BC6E4L, 0x2B60A476L, 0x81E67400L, + + 0x08BA6FB5L, 0x571BE91FL, 0xF296EC6BL, 0x2A0DD915L, + + 0xB6636521L, 0xE7B9F9B6L, 0xFF34052EL, 0xC5855664L, + + 0x53B02D5DL, 0xA99F8FA1L, 0x08BA4799L, 0x6E85076AL }, + + { 0x4B7A70E9L, 0xB5B32944L, 0xDB75092EL, 0xC4192623L, + + 0xAD6EA6B0L, 0x49A7DF7DL, 0x9CEE60B8L, 0x8FEDB266L, + + 0xECAA8C71L, 0x699A17FFL, 0x5664526CL, 0xC2B19EE1L, + + 0x193602A5L, 0x75094C29L, 0xA0591340L, 0xE4183A3EL, + + 0x3F54989AL, 0x5B429D65L, 0x6B8FE4D6L, 0x99F73FD6L, + + 0xA1D29C07L, 0xEFE830F5L, 0x4D2D38E6L, 0xF0255DC1L, + + 0x4CDD2086L, 0x8470EB26L, 0x6382E9C6L, 0x021ECC5EL, + + 0x09686B3FL, 0x3EBAEFC9L, 0x3C971814L, 0x6B6A70A1L, + + 0x687F3584L, 0x52A0E286L, 0xB79C5305L, 0xAA500737L, + + 0x3E07841CL, 0x7FDEAE5CL, 0x8E7D44ECL, 0x5716F2B8L, + + 0xB03ADA37L, 0xF0500C0DL, 0xF01C1F04L, 0x0200B3FFL, + + 0xAE0CF51AL, 0x3CB574B2L, 0x25837A58L, 0xDC0921BDL, + + 0xD19113F9L, 0x7CA92FF6L, 0x94324773L, 0x22F54701L, + + 0x3AE5E581L, 0x37C2DADCL, 0xC8B57634L, 0x9AF3DDA7L, + + 0xA9446146L, 0x0FD0030EL, 0xECC8C73EL, 0xA4751E41L, + + 0xE238CD99L, 0x3BEA0E2FL, 0x3280BBA1L, 0x183EB331L, + + 0x4E548B38L, 0x4F6DB908L, 0x6F420D03L, 0xF60A04BFL, + + 0x2CB81290L, 0x24977C79L, 0x5679B072L, 0xBCAF89AFL, + + 0xDE9A771FL, 0xD9930810L, 0xB38BAE12L, 0xDCCF3F2EL, + + 0x5512721FL, 0x2E6B7124L, 0x501ADDE6L, 0x9F84CD87L, + + 0x7A584718L, 0x7408DA17L, 0xBC9F9ABCL, 0xE94B7D8CL, + + 0xEC7AEC3AL, 0xDB851DFAL, 0x63094366L, 0xC464C3D2L, + + 0xEF1C1847L, 0x3215D908L, 0xDD433B37L, 0x24C2BA16L, + + 0x12A14D43L, 0x2A65C451L, 0x50940002L, 0x133AE4DDL, + + 0x71DFF89EL, 0x10314E55L, 0x81AC77D6L, 0x5F11199BL, + + 0x043556F1L, 0xD7A3C76BL, 0x3C11183BL, 0x5924A509L, + + 0xF28FE6EDL, 0x97F1FBFAL, 0x9EBABF2CL, 0x1E153C6EL, + + 0x86E34570L, 0xEAE96FB1L, 0x860E5E0AL, 0x5A3E2AB3L, + + 0x771FE71CL, 0x4E3D06FAL, 0x2965DCB9L, 0x99E71D0FL, + + 0x803E89D6L, 0x5266C825L, 0x2E4CC978L, 0x9C10B36AL, + + 0xC6150EBAL, 0x94E2EA78L, 0xA5FC3C53L, 0x1E0A2DF4L, + + 0xF2F74EA7L, 0x361D2B3DL, 0x1939260FL, 0x19C27960L, + + 0x5223A708L, 0xF71312B6L, 0xEBADFE6EL, 0xEAC31F66L, + + 0xE3BC4595L, 0xA67BC883L, 0xB17F37D1L, 0x018CFF28L, + + 0xC332DDEFL, 0xBE6C5AA5L, 0x65582185L, 0x68AB9802L, + + 0xEECEA50FL, 0xDB2F953BL, 0x2AEF7DADL, 0x5B6E2F84L, + + 0x1521B628L, 0x29076170L, 0xECDD4775L, 0x619F1510L, + + 0x13CCA830L, 0xEB61BD96L, 0x0334FE1EL, 0xAA0363CFL, + + 0xB5735C90L, 0x4C70A239L, 0xD59E9E0BL, 0xCBAADE14L, + + 0xEECC86BCL, 0x60622CA7L, 0x9CAB5CABL, 0xB2F3846EL, + + 0x648B1EAFL, 0x19BDF0CAL, 0xA02369B9L, 0x655ABB50L, + + 0x40685A32L, 0x3C2AB4B3L, 0x319EE9D5L, 0xC021B8F7L, + + 0x9B540B19L, 0x875FA099L, 0x95F7997EL, 0x623D7DA8L, + + 0xF837889AL, 0x97E32D77L, 0x11ED935FL, 0x16681281L, + + 0x0E358829L, 0xC7E61FD6L, 0x96DEDFA1L, 0x7858BA99L, + + 0x57F584A5L, 0x1B227263L, 0x9B83C3FFL, 0x1AC24696L, + + 0xCDB30AEBL, 0x532E3054L, 0x8FD948E4L, 0x6DBC3128L, + + 0x58EBF2EFL, 0x34C6FFEAL, 0xFE28ED61L, 0xEE7C3C73L, + + 0x5D4A14D9L, 0xE864B7E3L, 0x42105D14L, 0x203E13E0L, + + 0x45EEE2B6L, 0xA3AAABEAL, 0xDB6C4F15L, 0xFACB4FD0L, + + 0xC742F442L, 0xEF6ABBB5L, 0x654F3B1DL, 0x41CD2105L, + + 0xD81E799EL, 0x86854DC7L, 0xE44B476AL, 0x3D816250L, + + 0xCF62A1F2L, 0x5B8D2646L, 0xFC8883A0L, 0xC1C7B6A3L, + + 0x7F1524C3L, 0x69CB7492L, 0x47848A0BL, 0x5692B285L, + + 0x095BBF00L, 0xAD19489DL, 0x1462B174L, 0x23820E00L, + + 0x58428D2AL, 0x0C55F5EAL, 0x1DADF43EL, 0x233F7061L, + + 0x3372F092L, 0x8D937E41L, 0xD65FECF1L, 0x6C223BDBL, + + 0x7CDE3759L, 0xCBEE7460L, 0x4085F2A7L, 0xCE77326EL, + + 0xA6078084L, 0x19F8509EL, 0xE8EFD855L, 0x61D99735L, + + 0xA969A7AAL, 0xC50C06C2L, 0x5A04ABFCL, 0x800BCADCL, + + 0x9E447A2EL, 0xC3453484L, 0xFDD56705L, 0x0E1E9EC9L, + + 0xDB73DBD3L, 0x105588CDL, 0x675FDA79L, 0xE3674340L, + + 0xC5C43465L, 0x713E38D8L, 0x3D28F89EL, 0xF16DFF20L, + + 0x153E21E7L, 0x8FB03D4AL, 0xE6E39F2BL, 0xDB83ADF7L }, + + { 0xE93D5A68L, 0x948140F7L, 0xF64C261CL, 0x94692934L, + + 0x411520F7L, 0x7602D4F7L, 0xBCF46B2EL, 0xD4A20068L, + + 0xD4082471L, 0x3320F46AL, 0x43B7D4B7L, 0x500061AFL, + + 0x1E39F62EL, 0x97244546L, 0x14214F74L, 0xBF8B8840L, + + 0x4D95FC1DL, 0x96B591AFL, 0x70F4DDD3L, 0x66A02F45L, + + 0xBFBC09ECL, 0x03BD9785L, 0x7FAC6DD0L, 0x31CB8504L, + + 0x96EB27B3L, 0x55FD3941L, 0xDA2547E6L, 0xABCA0A9AL, + + 0x28507825L, 0x530429F4L, 0x0A2C86DAL, 0xE9B66DFBL, + + 0x68DC1462L, 0xD7486900L, 0x680EC0A4L, 0x27A18DEEL, + + 0x4F3FFEA2L, 0xE887AD8CL, 0xB58CE006L, 0x7AF4D6B6L, + + 0xAACE1E7CL, 0xD3375FECL, 0xCE78A399L, 0x406B2A42L, + + 0x20FE9E35L, 0xD9F385B9L, 0xEE39D7ABL, 0x3B124E8BL, + + 0x1DC9FAF7L, 0x4B6D1856L, 0x26A36631L, 0xEAE397B2L, + + 0x3A6EFA74L, 0xDD5B4332L, 0x6841E7F7L, 0xCA7820FBL, + + 0xFB0AF54EL, 0xD8FEB397L, 0x454056ACL, 0xBA489527L, + + 0x55533A3AL, 0x20838D87L, 0xFE6BA9B7L, 0xD096954BL, + + 0x55A867BCL, 0xA1159A58L, 0xCCA92963L, 0x99E1DB33L, + + 0xA62A4A56L, 0x3F3125F9L, 0x5EF47E1CL, 0x9029317CL, + + 0xFDF8E802L, 0x04272F70L, 0x80BB155CL, 0x05282CE3L, + + 0x95C11548L, 0xE4C66D22L, 0x48C1133FL, 0xC70F86DCL, + + 0x07F9C9EEL, 0x41041F0FL, 0x404779A4L, 0x5D886E17L, + + 0x325F51EBL, 0xD59BC0D1L, 0xF2BCC18FL, 0x41113564L, + + 0x257B7834L, 0x602A9C60L, 0xDFF8E8A3L, 0x1F636C1BL, + + 0x0E12B4C2L, 0x02E1329EL, 0xAF664FD1L, 0xCAD18115L, + + 0x6B2395E0L, 0x333E92E1L, 0x3B240B62L, 0xEEBEB922L, + + 0x85B2A20EL, 0xE6BA0D99L, 0xDE720C8CL, 0x2DA2F728L, + + 0xD0127845L, 0x95B794FDL, 0x647D0862L, 0xE7CCF5F0L, + + 0x5449A36FL, 0x877D48FAL, 0xC39DFD27L, 0xF33E8D1EL, + + 0x0A476341L, 0x992EFF74L, 0x3A6F6EABL, 0xF4F8FD37L, + + 0xA812DC60L, 0xA1EBDDF8L, 0x991BE14CL, 0xDB6E6B0DL, + + 0xC67B5510L, 0x6D672C37L, 0x2765D43BL, 0xDCD0E804L, + + 0xF1290DC7L, 0xCC00FFA3L, 0xB5390F92L, 0x690FED0BL, + + 0x667B9FFBL, 0xCEDB7D9CL, 0xA091CF0BL, 0xD9155EA3L, + + 0xBB132F88L, 0x515BAD24L, 0x7B9479BFL, 0x763BD6EBL, + + 0x37392EB3L, 0xCC115979L, 0x8026E297L, 0xF42E312DL, + + 0x6842ADA7L, 0xC66A2B3BL, 0x12754CCCL, 0x782EF11CL, + + 0x6A124237L, 0xB79251E7L, 0x06A1BBE6L, 0x4BFB6350L, + + 0x1A6B1018L, 0x11CAEDFAL, 0x3D25BDD8L, 0xE2E1C3C9L, + + 0x44421659L, 0x0A121386L, 0xD90CEC6EL, 0xD5ABEA2AL, + + 0x64AF674EL, 0xDA86A85FL, 0xBEBFE988L, 0x64E4C3FEL, + + 0x9DBC8057L, 0xF0F7C086L, 0x60787BF8L, 0x6003604DL, + + 0xD1FD8346L, 0xF6381FB0L, 0x7745AE04L, 0xD736FCCCL, + + 0x83426B33L, 0xF01EAB71L, 0xB0804187L, 0x3C005E5FL, + + 0x77A057BEL, 0xBDE8AE24L, 0x55464299L, 0xBF582E61L, + + 0x4E58F48FL, 0xF2DDFDA2L, 0xF474EF38L, 0x8789BDC2L, + + 0x5366F9C3L, 0xC8B38E74L, 0xB475F255L, 0x46FCD9B9L, + + 0x7AEB2661L, 0x8B1DDF84L, 0x846A0E79L, 0x915F95E2L, + + 0x466E598EL, 0x20B45770L, 0x8CD55591L, 0xC902DE4CL, + + 0xB90BACE1L, 0xBB8205D0L, 0x11A86248L, 0x7574A99EL, + + 0xB77F19B6L, 0xE0A9DC09L, 0x662D09A1L, 0xC4324633L, + + 0xE85A1F02L, 0x09F0BE8CL, 0x4A99A025L, 0x1D6EFE10L, + + 0x1AB93D1DL, 0x0BA5A4DFL, 0xA186F20FL, 0x2868F169L, + + 0xDCB7DA83L, 0x573906FEL, 0xA1E2CE9BL, 0x4FCD7F52L, + + 0x50115E01L, 0xA70683FAL, 0xA002B5C4L, 0x0DE6D027L, + + 0x9AF88C27L, 0x773F8641L, 0xC3604C06L, 0x61A806B5L, + + 0xF0177A28L, 0xC0F586E0L, 0x006058AAL, 0x30DC7D62L, + + 0x11E69ED7L, 0x2338EA63L, 0x53C2DD94L, 0xC2C21634L, + + 0xBBCBEE56L, 0x90BCB6DEL, 0xEBFC7DA1L, 0xCE591D76L, + + 0x6F05E409L, 0x4B7C0188L, 0x39720A3DL, 0x7C927C24L, + + 0x86E3725FL, 0x724D9DB9L, 0x1AC15BB4L, 0xD39EB8FCL, + + 0xED545578L, 0x08FCA5B5L, 0xD83D7CD3L, 0x4DAD0FC4L, + + 0x1E50EF5EL, 0xB161E6F8L, 0xA28514D9L, 0x6C51133CL, + + 0x6FD5C7E7L, 0x56E14EC4L, 0x362ABFCEL, 0xDDC6C837L, + + 0xD79A3234L, 0x92638212L, 0x670EFA8EL, 0x406000E0L }, + + { 0x3A39CE37L, 0xD3FAF5CFL, 0xABC27737L, 0x5AC52D1BL, + + 0x5CB0679EL, 0x4FA33742L, 0xD3822740L, 0x99BC9BBEL, + + 0xD5118E9DL, 0xBF0F7315L, 0xD62D1C7EL, 0xC700C47BL, + + 0xB78C1B6BL, 0x21A19045L, 0xB26EB1BEL, 0x6A366EB4L, + + 0x5748AB2FL, 0xBC946E79L, 0xC6A376D2L, 0x6549C2C8L, + + 0x530FF8EEL, 0x468DDE7DL, 0xD5730A1DL, 0x4CD04DC6L, + + 0x2939BBDBL, 0xA9BA4650L, 0xAC9526E8L, 0xBE5EE304L, + + 0xA1FAD5F0L, 0x6A2D519AL, 0x63EF8CE2L, 0x9A86EE22L, + + 0xC089C2B8L, 0x43242EF6L, 0xA51E03AAL, 0x9CF2D0A4L, + + 0x83C061BAL, 0x9BE96A4DL, 0x8FE51550L, 0xBA645BD6L, + + 0x2826A2F9L, 0xA73A3AE1L, 0x4BA99586L, 0xEF5562E9L, + + 0xC72FEFD3L, 0xF752F7DAL, 0x3F046F69L, 0x77FA0A59L, + + 0x80E4A915L, 0x87B08601L, 0x9B09E6ADL, 0x3B3EE593L, + + 0xE990FD5AL, 0x9E34D797L, 0x2CF0B7D9L, 0x022B8B51L, + + 0x96D5AC3AL, 0x017DA67DL, 0xD1CF3ED6L, 0x7C7D2D28L, + + 0x1F9F25CFL, 0xADF2B89BL, 0x5AD6B472L, 0x5A88F54CL, + + 0xE029AC71L, 0xE019A5E6L, 0x47B0ACFDL, 0xED93FA9BL, + + 0xE8D3C48DL, 0x283B57CCL, 0xF8D56629L, 0x79132E28L, + + 0x785F0191L, 0xED756055L, 0xF7960E44L, 0xE3D35E8CL, + + 0x15056DD4L, 0x88F46DBAL, 0x03A16125L, 0x0564F0BDL, + + 0xC3EB9E15L, 0x3C9057A2L, 0x97271AECL, 0xA93A072AL, + + 0x1B3F6D9BL, 0x1E6321F5L, 0xF59C66FBL, 0x26DCF319L, + + 0x7533D928L, 0xB155FDF5L, 0x03563482L, 0x8ABA3CBBL, + + 0x28517711L, 0xC20AD9F8L, 0xABCC5167L, 0xCCAD925FL, + + 0x4DE81751L, 0x3830DC8EL, 0x379D5862L, 0x9320F991L, + + 0xEA7A90C2L, 0xFB3E7BCEL, 0x5121CE64L, 0x774FBE32L, + + 0xA8B6E37EL, 0xC3293D46L, 0x48DE5369L, 0x6413E680L, + + 0xA2AE0810L, 0xDD6DB224L, 0x69852DFDL, 0x09072166L, + + 0xB39A460AL, 0x6445C0DDL, 0x586CDECFL, 0x1C20C8AEL, + + 0x5BBEF7DDL, 0x1B588D40L, 0xCCD2017FL, 0x6BB4E3BBL, + + 0xDDA26A7EL, 0x3A59FF45L, 0x3E350A44L, 0xBCB4CDD5L, + + 0x72EACEA8L, 0xFA6484BBL, 0x8D6612AEL, 0xBF3C6F47L, + + 0xD29BE463L, 0x542F5D9EL, 0xAEC2771BL, 0xF64E6370L, + + 0x740E0D8DL, 0xE75B1357L, 0xF8721671L, 0xAF537D5DL, + + 0x4040CB08L, 0x4EB4E2CCL, 0x34D2466AL, 0x0115AF84L, + + 0xE1B00428L, 0x95983A1DL, 0x06B89FB4L, 0xCE6EA048L, + + 0x6F3F3B82L, 0x3520AB82L, 0x011A1D4BL, 0x277227F8L, + + 0x611560B1L, 0xE7933FDCL, 0xBB3A792BL, 0x344525BDL, + + 0xA08839E1L, 0x51CE794BL, 0x2F32C9B7L, 0xA01FBAC9L, + + 0xE01CC87EL, 0xBCC7D1F6L, 0xCF0111C3L, 0xA1E8AAC7L, + + 0x1A908749L, 0xD44FBD9AL, 0xD0DADECBL, 0xD50ADA38L, + + 0x0339C32AL, 0xC6913667L, 0x8DF9317CL, 0xE0B12B4FL, + + 0xF79E59B7L, 0x43F5BB3AL, 0xF2D519FFL, 0x27D9459CL, + + 0xBF97222CL, 0x15E6FC2AL, 0x0F91FC71L, 0x9B941525L, + + 0xFAE59361L, 0xCEB69CEBL, 0xC2A86459L, 0x12BAA8D1L, + + 0xB6C1075EL, 0xE3056A0CL, 0x10D25065L, 0xCB03A442L, + + 0xE0EC6E0EL, 0x1698DB3BL, 0x4C98A0BEL, 0x3278E964L, + + 0x9F1F9532L, 0xE0D392DFL, 0xD3A0342BL, 0x8971F21EL, + + 0x1B0A7441L, 0x4BA3348CL, 0xC5BE7120L, 0xC37632D8L, + + 0xDF359F8DL, 0x9B992F2EL, 0xE60B6F47L, 0x0FE3F11DL, + + 0xE54CDA54L, 0x1EDAD891L, 0xCE6279CFL, 0xCD3E7E6FL, + + 0x1618B166L, 0xFD2C1D05L, 0x848FD2C5L, 0xF6FB2299L, + + 0xF523F357L, 0xA6327623L, 0x93A83531L, 0x56CCCD02L, + + 0xACF08162L, 0x5A75EBB5L, 0x6E163697L, 0x88D273CCL, + + 0xDE966292L, 0x81B949D0L, 0x4C50901BL, 0x71C65614L, + + 0xE6C6C7BDL, 0x327A140AL, 0x45E1D006L, 0xC3F27B9AL, + + 0xC9AA53FDL, 0x62A80F00L, 0xBB25BFE2L, 0x35BDD2F6L, + + 0x71126905L, 0xB2040222L, 0xB6CBCF7CL, 0xCD769C2BL, + + 0x53113EC0L, 0x1640E3D3L, 0x38ABBD60L, 0x2547ADF0L, + + 0xBA38209CL, 0xF746CE76L, 0x77AFA1C5L, 0x20756060L, + + 0x85CBFE4EL, 0x8AE88DD8L, 0x7AAAF9B0L, 0x4CF9AA7EL, + + 0x1948C25CL, 0x02FB8A8CL, 0x01C36AE4L, 0xD6EBE1F9L, + + 0x90D4F869L, 0xA65CDEA0L, 0x3F09252DL, 0xC208E69FL, + + 0xB74E6132L, 0xCE77E25BL, 0x578FDFE3L, 0x3AC372E6L } + +}; + + + + + +unsigned long F(BLOWFISH_CTX *ctx, unsigned long x) { + + unsigned short a, b, c, d; + + unsigned long y; + + + + d = x & 0x00FF; + + x >>= 8; + + c = x & 0x00FF; + + x >>= 8; + + b = x & 0x00FF; + + x >>= 8; + + a = x & 0x00FF; + + y = ctx->S[0][a] + ctx->S[1][b]; + + y = y ^ ctx->S[2][c]; + + y = y + ctx->S[3][d]; + + + + return y; + +} + + + + + +void Blowfish_Encrypt(BLOWFISH_CTX *ctx, unsigned long *xl, unsigned long +*xr) { + + unsigned long Xl; + + unsigned long Xr; + + unsigned long temp; + + short i; + + + + Xl = *xl; + + Xr = *xr; + + + + for (i = 0; i < N; ++i) { + + Xl = Xl ^ ctx->P[i]; + + Xr = F(ctx, Xl) ^ Xr; + + + + temp = Xl; + + Xl = Xr; + + Xr = temp; + + } + + + + temp = Xl; + + Xl = Xr; + + Xr = temp; + + + + Xr = Xr ^ ctx->P[N]; + + Xl = Xl ^ ctx->P[N + 1]; + + + + *xl = Xl; + + *xr = Xr; + +} + + + + + +void Blowfish_Decrypt(BLOWFISH_CTX *ctx, unsigned long *xl, unsigned long +*xr) { + + unsigned long Xl; + + unsigned long Xr; + + unsigned long temp; + + short i; + + + + Xl = *xl; + + Xr = *xr; + + + + for (i = N + 1; i > 1; --i) { + + Xl = Xl ^ ctx->P[i]; + + Xr = F(ctx, Xl) ^ Xr; + + + + /* Exchange Xl and Xr */ + + temp = Xl; + + Xl = Xr; + + Xr = temp; + + } + + + + /* Exchange Xl and Xr */ + + temp = Xl; + + Xl = Xr; + + Xr = temp; + + + + Xr = Xr ^ ctx->P[1]; + + Xl = Xl ^ ctx->P[0]; + + + + *xl = Xl; + + *xr = Xr; + +} + + + + + +void Blowfish_Init(BLOWFISH_CTX *ctx, unsigned char *key, int keyLen) { + + int i, j, k; + + unsigned long data, datal, datar; + + + + for (i = 0; i < 4; i++) { + + for (j = 0; j < 256; j++) + + ctx->S[i][j] = ORIG_S[i][j]; + + } + + + + j = 0; + + for (i = 0; i < N + 2; ++i) { + + data = 0x00000000; + + for (k = 0; k < 4; ++k) { + + data = (data << 8) | key[j]; + + j = j + 1; + + if (j >= keyLen) + + j = 0; + + } + + ctx->P[i] = ORIG_P[i] ^ data; + + } + + + + datal = 0x00000000; + + datar = 0x00000000; + + + + for (i = 0; i < N + 2; i += 2) { + + Blowfish_Encrypt(ctx, &datal, &datar); + + ctx->P[i] = datal; + + ctx->P[i + 1] = datar; + + } + + + + for (i = 0; i < 4; ++i) { + + for (j = 0; j < 256; j += 2) { + + Blowfish_Encrypt(ctx, &datal, &datar); + + ctx->S[i][j] = datal; + + ctx->S[i][j + 1] = datar; + + } + + } + +} + + + + + +int Blowfish_Test(BLOWFISH_CTX *ctx) { + + unsigned long L = 1, R = 2; + + + + Blowfish_Init (ctx, (unsigned char*)"TESTKEY", 7); + + Blowfish_Encrypt(ctx, &L, &R); + + if (L != 0xDF333FD2L || R != 0x30A71BB4L) + + return (-1); + + Blowfish_Decrypt(ctx, &L, &R); + + if (L != 1 || R != 2) + + return (-1); + + return (0); + +} + + + diff --git a/plugin/tests/fail/blowfish.h b/plugin/tests/fail/blowfish.h new file mode 100644 index 0000000..cf154a9 --- /dev/null +++ b/plugin/tests/fail/blowfish.h @@ -0,0 +1,35 @@ +/* + * Author : Paul Kocher + * E-mail : pck@netcom.com + * Date : 1997 + * Description: C implementation of the Blowfish algorithm. + */ + +#define MAXKEYBYTES 56 /* 448 bits */ + + + +typedef struct { + + unsigned long P[16 + 2]; + + unsigned long S[4][256]; + +} BLOWFISH_CTX; + + + +void Blowfish_Init(BLOWFISH_CTX *ctx, unsigned char *key, int keyLen); + +void Blowfish_Encrypt(BLOWFISH_CTX *ctx, unsigned long *xl, unsigned long +*xr); + +void Blowfish_Decrypt(BLOWFISH_CTX *ctx, unsigned long *xl, unsigned long +*xr); + +int Blowfish_Test(BLOWFISH_CTX *ctx); /* 0=ok, -1=bad */ + + + + + diff --git a/plugin/tests/fail/bubble_sort.c b/plugin/tests/fail/bubble_sort.c new file mode 100644 index 0000000..84d7f2c --- /dev/null +++ b/plugin/tests/fail/bubble_sort.c @@ -0,0 +1,46 @@ + +#define SIZE 5 + +void swap (int tab[], int i, int j) { + int t; + t = tab[i] ; tab[i] = tab[j] ; tab[j] = t; + return; +} + +void bubble_sort(int tab[], int size) { + int i, j, min, min_index; + + for (i = 0 ; i < size ; i++) { + min_index = i; + min = tab[min_index]; + for (j = i + 1 ; j < size ; j++) { + if (tab[j] < min) { + min_index = j; + min = tab[min_index]; + } + } + swap(tab, i, min_index); + } + return; +} + +/* +void print_tab (int tab[], int size) { + int i; + + for (i = 0 ; i < size ; i++) { + print_sint(tab[i]); + space(); + } + newline(); +} + +int main () { + int tab[SIZE] = {26, -21, 43, -62, 8}; + + bubble_sort(tab, SIZE); + print_tab(tab, SIZE); + + return 0; +} +*/ diff --git a/plugin/tests/success/3-way.c b/plugin/tests/success/3-way.c new file mode 100644 index 0000000..0618705 --- /dev/null +++ b/plugin/tests/success/3-way.c @@ -0,0 +1,144 @@ +/********************************************************************\ +* * +* C specification of the threeway block cipher * +* * +\********************************************************************/ +/*file i/o main function by Pate Williams 1996*/ + +#include +#include +#include +#include + +#define STRT_E 0x0b0b /* round constant of first encryption round */ +#define STRT_D 0xb1b1 /* round constant of first decryption round */ +#define NMBR 11 /* number of rounds is 11 */ + +#define BLK_SIZE 12 /*number of bytes per block*/ + +typedef unsigned long int word32 ; + /* the program only works correctly if long = 32bits */ + +void mu(word32 *a) /* inverts the order of the bits of a */ +{ +int i ; +word32 b[3] ; + +b[0] = b[1] = b[2] = 0 ; +for( i=0 ; i<32 ; i++ ) + { + b[0] <<= 1 ; b[1] <<= 1 ; b[2] <<= 1 ; + if(a[0]&1) b[2] |= 1 ; + if(a[1]&1) b[1] |= 1 ; + if(a[2]&1) b[0] |= 1 ; + a[0] >>= 1 ; a[1] >>= 1 ; a[2] >>= 1 ; + } + +a[0] = b[0] ; a[1] = b[1] ; a[2] = b[2] ; +} + +void gamma(word32 *a) /* the nonlinear step */ +{ +word32 b[3] ; + +b[0] = a[0] ^ (a[1]|(~a[2])) ; +b[1] = a[1] ^ (a[2]|(~a[0])) ; +b[2] = a[2] ^ (a[0]|(~a[1])) ; + +a[0] = b[0] ; a[1] = b[1] ; a[2] = b[2] ; +} + +void theta(word32 *a) /* the linear step */ +{ +word32 b[3]; + +b[0] = a[0] ^ (a[0]>>16) ^ (a[1]<<16) ^ (a[1]>>16) ^ (a[2]<<16) ^ + (a[1]>>24) ^ (a[2]<<8) ^ (a[2]>>8) ^ (a[0]<<24) ^ + (a[2]>>16) ^ (a[0]<<16) ^ (a[2]>>24) ^ (a[0]<<8) ; +b[1] = a[1] ^ (a[1]>>16) ^ (a[2]<<16) ^ (a[2]>>16) ^ (a[0]<<16) ^ + (a[2]>>24) ^ (a[0]<<8) ^ (a[0]>>8) ^ (a[1]<<24) ^ + (a[0]>>16) ^ (a[1]<<16) ^ (a[0]>>24) ^ (a[1]<<8) ; +b[2] = a[2] ^ (a[2]>>16) ^ (a[0]<<16) ^ (a[0]>>16) ^ (a[1]<<16) ^ + (a[0]>>24) ^ (a[1]<<8) ^ (a[1]>>8) ^ (a[2]<<24) ^ + (a[1]>>16) ^ (a[2]<<16) ^ (a[1]>>24) ^ (a[2]<<8) ; + +a[0] = b[0] ; a[1] = b[1] ; a[2] = b[2] ; +} + +void pi_1(word32 *a) +{ +a[0] = (a[0]>>10) ^ (a[0]<<22); +a[2] = (a[2]<<1) ^ (a[2]>>31); +} + +void pi_2(word32 *a) +{ +a[0] = (a[0]<<1) ^ (a[0]>>31); +a[2] = (a[2]>>10) ^ (a[2]<<22); +} + +void rho(word32 *a) /* the round function */ +{ +theta(a) ; +pi_1(a) ; +gamma(a) ; +pi_2(a) ; +} + +void rndcon_gen(word32 strt,word32 *rtab) +{ /* generates the round constants */ +int i ; + +for(i=0 ; i<=NMBR ; i++ ) + { + rtab[i] = strt ; + strt <<= 1 ; + if( strt&0x10000 ) strt ^= 0x11011 ; + } +} + +void encrypt(word32 *a, word32 *k) +{ +char i ; +word32 rcon[NMBR+1] ; + +rndcon_gen(STRT_E,rcon) ; +for( i=0 ; i> 9) & 0x1) == 1) + + (((r2 >> 11) & 0x1) == 1) + + (((r3 >> 11) & 0x1) == 1); + + if (total > 1) + return (0); + else + return (1); +} + +unsigned long clock_r1(ctl, r1) +int ctl; +unsigned long r1; +{ +unsigned long feedback; + + /* + * Primitive polynomial x**19 + x**5 + x**2 + x + 1 + */ + + ctl ^= ((r1 >> 9) & 0x1); + if (ctl) + { + feedback = (r1 >> 18) ^ (r1 >> 17) ^ (r1 >> 16) ^ (r1 >> 13); + r1 = (r1 << 1) & 0x7ffff; + if (feedback & 0x01) + r1 ^= 0x01; + } + return (r1); +} + +unsigned long clock_r2(ctl, r2) +int ctl; +unsigned long r2; +{ +unsigned long feedback; + + + /* + * Primitive polynomial x**22 + x**9 + x**5 + x + 1 + */ + + ctl ^= ((r2 >> 11) & 0x1); + if (ctl) + { + feedback = (r2 >> 21) ^ (r2 >> 20) ^ (r2 >> 16) ^ (r2 >> 12); + r2 = (r2 << 1) & 0x3fffff; + if (feedback & 0x01) + r2 ^= 0x01; + } + return (r2); +} + +unsigned long clock_r3(ctl, r3) +int ctl; +unsigned long r3; +{ +unsigned long feedback; + + /* + * Primitive polynomial x**23 + x**5 + x**4 + x + 1 + */ + + ctl ^= ((r3 >> 11) & 0x1); + if (ctl) + { + feedback = (r3 >> 22) ^ (r3 >> 21) ^ (r3 >> 18) ^ (r3 >> 17); + r3 = (r3 << 1) & 0x7fffff; + if (feedback & 0x01) + r3 ^= 0x01; + } + return (r3); +} + +int keystream(key, frame, alice, bob) +unsigned char *key; /* 64 bit session key */ +unsigned long frame; /* 22 bit frame sequence number */ +unsigned char *alice; /* 114 bit Alice to Bob key stream */ +unsigned char *bob; /* 114 bit Bob to Alice key stream */ +{ +unsigned long r1; /* 19 bit shift register */ +unsigned long r2; /* 22 bit shift register */ +unsigned long r3; /* 23 bit shift register */ +int i; /* counter for loops */ +int clock_ctl; /* xored with clock enable on each shift register */ +unsigned char *ptr; /* current position in keystream */ +unsigned char byte; /* byte of keystream being assembled */ +unsigned int bits; /* number of bits of keystream in byte */ +unsigned int bit; /* bit output from keystream generator */ + + /* Initialise shift registers from session key */ + + r1 = (key[0] | (key[1] << 8) | (key[2] << 16) ) & 0x7ffff; + r2 = ((key[2] >> 3) | (key[3] << 5) | (key[4] << 13) | (key[5] << 21)) & 0x3fffff; + r3 = ((key[5] >> 1) | (key[6] << 7) | (key[7] << 15) ) & 0x7fffff; + + + /* Merge frame sequence number into shift register state, by xor'ing it + * into the feedback path + */ + + for (i=0;i<22;i++) + { + clock_ctl = threshold(r1, r2, r2); + r1 = clock_r1(clock_ctl, r1); + r2 = clock_r2(clock_ctl, r2); + r3 = clock_r3(clock_ctl, r3); + if (frame & 1) + { + r1 ^= 1; + r2 ^= 1; + r3 ^= 1; + } + frame = frame >> 1; + } + + /* Run shift registers for 100 clock ticks to allow frame number to + * be diffused into all the bits of the shift registers + */ + + for (i=0;i<100;i++) + { + clock_ctl = threshold(r1, r2, r2); + r1 = clock_r1(clock_ctl, r1); + r2 = clock_r2(clock_ctl, r2); + r3 = clock_r3(clock_ctl, r3); + } + + /* Produce 114 bits of Alice->Bob key stream */ + + ptr = alice; + bits = 0; + byte = 0; + for (i=0;i<114;i++) + { + clock_ctl = threshold(r1, r2, r2); + r1 = clock_r1(clock_ctl, r1); + r2 = clock_r2(clock_ctl, r2); + r3 = clock_r3(clock_ctl, r3); + + bit = ((r1 >> 18) ^ (r2 >> 21) ^ (r3 >> 22)) & 0x01; + byte = (byte << 1) | bit; + bits++; + if (bits == 8) + { + *ptr = byte; + ptr++; + bits = 0; + byte = 0; + } + } + if (bits) + *ptr = byte; + + /* Run shift registers for another 100 bits to hide relationship between + * Alice->Bob key stream and Bob->Alice key stream. + */ + + for (i=0;i<100;i++) + { + clock_ctl = threshold(r1, r2, r2); + r1 = clock_r1(clock_ctl, r1); + r2 = clock_r2(clock_ctl, r2); + r3 = clock_r3(clock_ctl, r3); + } + + /* Produce 114 bits of Bob->Alice key stream */ + + ptr = bob; + bits = 0; + byte = 0; + for (i=0;i<114;i++) + { + clock_ctl = threshold(r1, r2, r2); + r1 = clock_r1(clock_ctl, r1); + r2 = clock_r2(clock_ctl, r2); + r3 = clock_r3(clock_ctl, r3); + + bit = ((r1 >> 18) ^ (r2 >> 21) ^ (r3 >> 22)) & 0x01; + byte = (byte << 1) | bit; + bits++; + if (bits == 8) + { + *ptr = byte; + ptr++; + bits = 0; + byte = 0; + } + } + if (bits) + *ptr = byte; + + return (0); + +} + + + diff --git a/plugin/tests/success/fact.c b/plugin/tests/success/fact.c new file mode 100644 index 0000000..6dcf050 --- /dev/null +++ b/plugin/tests/success/fact.c @@ -0,0 +1,12 @@ + +int fact (int n) { + int i, res = 1; + + for (i = 1 ; i <= n ; i++) res *= i; + + return res; +} + +int main () { + return (fact(10)); +} diff --git a/plugin/tests/success/is_sorted.c b/plugin/tests/success/is_sorted.c new file mode 100644 index 0000000..d484b41 --- /dev/null +++ b/plugin/tests/success/is_sorted.c @@ -0,0 +1,8 @@ + +int is_sorted (int *tab, int size) { + int i, res = 1; + + for (i = 0 ; i < size-1 ; i++) if (tab[i] > tab[i+1]) res = 0; + + return res; +} diff --git a/plugin/tests/success/random.c b/plugin/tests/success/random.c new file mode 100644 index 0000000..9024eff --- /dev/null +++ b/plugin/tests/success/random.c @@ -0,0 +1,147 @@ +/* + $Id: random.c,v $ + + This program is public domain and was written by William S. England + (Oct 1988). It is based on an article by: + + Stephen K. Park and Keith W. Miller. RANDOM NUMBER GENERATORS: + GOOD ONES ARE HARD TO FIND. Communications of the ACM, + New York, NY.,October 1988 p.1192 + + Modifications; + + $Log: random.c,v $ + +###### + + The following is a portable c program for generating random numbers. + The modulus and multiplier have been extensively tested and should + not be changed except by someone who is a professional Lehmer generator + writer. THIS GENERATOR REPRESENTS THE MINIMUM STANDARD AGAINST WHICH + OTHER GENERATORS SHOULD BE JUDGED. ("Quote from the referenced article's + authors. WSE" ) +*/ + +/* +** These are pre-calculated below to compensate for c +** compilers that may overflow when building the code. +** +** q = (m / a) +** r = (m % a) +*/ + +/* +** To build the generator with the original ACM +** article's numbers use -DORIGINAL_NUMBERS when compiling. +** +** Original_numbers are the original published m and q in the +** ACM article above. John Burton has furnished numbers for +** a reportedly better generator. The new numbers are now +** used in this program by default. +*/ + +#ifndef ORIGINAL_NUMBERS +#define m (unsigned long)2147483647 +#define q (unsigned long)44488 + +#define a (unsigned int)48271 +#define r (unsigned int)3399 + +#define successfulltest 399268537 +#endif + +#ifdef ORIGINAL_NUMBERS +#define m (unsigned long)2147483647 +#define q (unsigned long)127773 + +#define a (unsigned int)16807 +#define r (unsigned int)2836 + +#define successfulltest 1043618065 +#endif + +/* +** F(z) = (az)%m +** = az-m(az/m) +** +** F(z) = G(z)+mT(z) +** G(z) = a(z%q)- r(z/q) +** T(z) = (z/q) - (az/m) +** +** F(z) = a(z%q)- rz/q+ m((z/q) - a(z/m)) +** = a(z%q)- rz/q+ m(z/q) - az +*/ + +unsigned long seed; + +void srand( /* unsigned long*/ initial_seed) +unsigned long initial_seed; +{ + seed = initial_seed; + return; +} +/* +** +*/ +unsigned long rand(/*void*/){ + +register +int lo, hi, test; + + hi = seed/q; + lo = seed%q; + + test = a*lo - r*hi; + + if (test > 0) + seed = test; + else + seed = test+ m; + + return seed; +} + +#ifdef TESTRAND +#include +/* +** The result of running this program should be +** "successfulltest". If this program does not yield this +** value then your compiler has not implemented this +** program correctly. +** +** To compile with test option under unix use; 'cc -DTESTRAND random.c' +** +** Be sure to compile without test option for use in applications. +** ( Now why did I have to say that ??? ) +*/ + +main(/*void*/) +{ +unsigned +long n_rand; + +register int i; +int success = 0; + + srand(1); + + for( i = 1; i <= 10001; i++){ + n_rand = rand(); + + if( i> 9998) + printf("Sequence %5i, Seed= %10i\n", i, seed ); + + if( i == 10000) + if( seed == successfulltest ) + success = 1; + } + + if (success){ + printf("The random number generator works correctly.\n\n"); + exit(0); + }else{ + printf("The random number generator DOES NOT WORK!\n\n"); + exit(1); + } +} +#endif diff --git a/plugin/tests/success/tab_sum.c b/plugin/tests/success/tab_sum.c new file mode 100644 index 0000000..2d8bc06 --- /dev/null +++ b/plugin/tests/success/tab_sum.c @@ -0,0 +1,15 @@ + +#define SIZE 5 + +int sum (int tab[], int size) { + int i, res = 0; + + for (i = 0 ; i < size ; i++) res += tab[i]; + + return res; +} + +int main () { + int tab[5] = { 3, 18, -9, 23, 17 }; + return (sum(tab, SIZE)); +} diff --git a/wrapper/Makefile.in b/wrapper/Makefile.in new file mode 100644 index 0000000..5335fb1 --- /dev/null +++ b/wrapper/Makefile.in @@ -0,0 +1,17 @@ +RES = frama-c_lustre + +all: + ocamlbuild main.native + cp main.native $(RES) + +install: + mkdir -p @prefix@/bin + cp $(RES) @prefix@/bin + +clean: + rm -rf _build *~ main.native + +distclean: clean + rm -rf $(RES) + +.PHONY = install clean distclean diff --git a/wrapper/README b/wrapper/README new file mode 100644 index 0000000..80ca695 --- /dev/null +++ b/wrapper/README @@ -0,0 +1,49 @@ +Presentation +-------------- + +This is a wrapper of the Frama-C plug-in Cost for Lustre that makes the +synthesis of the results of the CerCo compiler on Lustre files. + + Requirements +-------------- + + - Frama-C Nitrogen + - Ocaml >= 3.12 + - Cost plug-in + - CerCo + - Lustre compiler + - Jessie plug-in and simplify (for verification only) + + Compilation +------------- + + You can compile the wrapper using the following command: + + % make + + (assuming that you are located at the root of the source tree) + + Installation +-------------- + + You can install the wrapper using the following command: + + % make install + + You may need administrative rights. + + Usage +------- + + You can run the wrapper for Lustre on a node "node" of a Lustre file + "file.lus" using the following command: + + % frama-c_lustre file.lus node + + The result will be in file "file-annotated.c" in the same directory if the + name is fresh. Otherwise an integer suffix will be added to the base name of + the output file. + + For a complete description of the options, use the command: + + % frama-c_lustre -help diff --git a/wrapper/_tags b/wrapper/_tags new file mode 100644 index 0000000..5a45340 --- /dev/null +++ b/wrapper/_tags @@ -0,0 +1 @@ +<*>: use_str diff --git a/wrapper/error.ml b/wrapper/error.ml new file mode 100644 index 0000000..aef1266 --- /dev/null +++ b/wrapper/error.ml @@ -0,0 +1,38 @@ +let exit_flag = ref true + +let exit_if_error () = exit_flag := true + +let resume_if_error () = exit_flag := false + +exception Error of Position.t list * string + +let print_error positions msg = + Printf.sprintf "%s%s" + (String.concat "\n" + (List.map (fun p -> Position.string_of_pos p ^": ") positions)) + msg + +let error_alert positions msg = + if !exit_flag then ( + output_string stderr (print_error positions msg); + exit 1 + ) + else raise (Error (positions, msg)) + +let global_error kind msg = + error_alert [] (Printf.sprintf "Global Error (%s):\n %s\n" kind msg) + +let error kind pos msg = + error_alert [pos] (Printf.sprintf "Error (%s):\n %s\n" kind msg) + +let error2 kind pos1 pos2 msg = + error_alert [pos1; pos2] (Printf.sprintf "Error (%s):\n %s\n" kind msg) + +let warning kind msg = + let mem_flag = !exit_flag in + exit_flag := false; + (try + error_alert [] (Printf.sprintf "Warning (%s):\n %s\n" kind msg) + with Error (positions, msg) -> + output_string stderr (print_error positions msg)); + exit_flag := mem_flag diff --git a/wrapper/error.mli b/wrapper/error.mli new file mode 100644 index 0000000..98b86c1 --- /dev/null +++ b/wrapper/error.mli @@ -0,0 +1,29 @@ +(** This module provides a uniform way of reporting (located) error message. *) + +(** [exit_if_error ()] forces the program to stop if an error is encountered. + (This is the default behavior.) *) +val exit_if_error: unit -> unit + +(** [resume_if_error ()] makes the program throw the exception {!Error} + if an error is encountered. *) +val resume_if_error: unit -> unit + +exception Error of Position.t list * string + +(** [print_error positions msg] formats an error message. *) +val print_error : Position.t list -> string -> string + +(** [error k p msg] prints [msg] with [k] as a message prefix and stops + the program. *) +val error : string -> Position.t -> string -> 'a + +(** [error2 k p1 p2 msg] prints two positions instead of one. *) +val error2 : string -> Position.t -> Position.t -> string -> 'a + +(** [global_error k msg] prints [msg] with [k] as a message prefix and stops + the program. *) +val global_error : string -> string -> 'a + +(** [warning k msg] prints [msg] with [k] as a message prefix, but do + not stop the program. *) +val warning : string -> string -> unit diff --git a/wrapper/main.ml b/wrapper/main.ml new file mode 100644 index 0000000..10bb72a --- /dev/null +++ b/wrapper/main.ml @@ -0,0 +1,304 @@ + + +let error_prefix = "Main" +let error = Error.global_error error_prefix + + +let log_file = Filename.temp_file "log" "" + + +let print_verbose i s = + if Options.get_verbose_level () >= i then Printf.printf "%s%!" s +let print_verbose1 = print_verbose 1 +let print_verbose2 = print_verbose 2 + + +let exec cmd error_callback error_msg success_callback success_msg = + print_verbose2 (" -> executing command \"" ^ cmd ^ "\"...\n") ; + let res = Sys.command cmd in + if res <> 0 then (error_callback () ; error error_msg) + else + (print_verbose1 (success_msg ^ "\n") ; + success_callback ()) + + +let has_extension filename = + try ignore (Filename.chop_extension filename) ; true + with Invalid_argument ("Filename.chop_extension") -> false + +let lustre_compilation filename node = + print_verbose1 + ("Compiling node " ^ node ^ " of Lustre file " ^ filename ^ "...\n") ; + let filename_quote = Filename.quote filename in + let base = + if has_extension filename then Filename.chop_extension filename + else filename in + let base = + Misc.fresh_base base + [".c" ; "-annotated.c" ; ".s" ; ".hex" ; ".cerco" ; ".cost_results" ; + ".jessie_results" ; "-annotated_test.c" ; "-annotated_test.s" ; + "-annotated_test.hex" ; "-annotated_test.results"] in + let res_file = base ^ ".c" in + let res_file_quote = Filename.quote res_file in + let cmd = + "lus2c " ^ filename_quote ^ " " ^ node ^ " -o " ^ res_file_quote ^ " >> " ^ + log_file in + let error_callback () = () in + let error_msg = + "Failed to compile node " ^ node ^ " of Lustre file " ^ filename ^ "." in + let success_callback () = res_file in + let success_msg = "Done. Result is in file " ^ res_file ^ "." in + exec cmd error_callback error_msg success_callback success_msg + + +let extract_inputs_booleans filename = + print_verbose1 + ("Extracting boolean inputs from file " ^ filename ^ "...\n") ; + try + let ic = open_in filename in + let rec inputs_booleans b = + try + let str_inputs = Str.regexp " *//INPUTS *" in + (* let str_registers = Str.regexp " *//REGISTERS *" in *) + let is_input_start s = + Str.string_match str_inputs s 0 + (* || Str.string_match str_registers s 0 *) in + let str_outputs = Str.regexp " *//OUTPUTS *" in + let str_acc = Str.regexp ".*}.*" in + let is_input_end s = + Str.string_match str_outputs s 0 || + Str.string_match str_acc s 0 in + let str_boolean = Str.regexp " _boolean .*;" in + let str_input = Str.regexp " [^ ]* .*;" in + let extract_input s = + let i = String.index_from s 3 ' ' in + String.sub s (i+1) (String.length s - (i+2)) in + let s = input_line ic in + let (added_input, added_boolean) = + let extract cond = if b && cond then [extract_input s] else [] in + (extract (Str.string_match str_input s 0), + extract (Str.string_match str_boolean s 0)) in + let next_b = (b || (is_input_start s)) && (not (is_input_end s)) in + let (inputs, booleans) = inputs_booleans next_b in + (added_input @ inputs, added_boolean @ booleans) + with End_of_file -> close_in ic ; ([], []) in + let res = inputs_booleans false in + print_verbose1 "Done.\n" ; + res + with Sys_error _ -> + error ("Could not extract boolean inputs from file " ^ filename ^ ".") + + +let framac_option () = + "-cost-lustre " ^ + (if Options.test_requested () then "-cost-lustre-test " else "") ^ + (if Options.verify_requested () then "-cost-lustre-verify " else "") + +let cost_plugin filename = + print_verbose1 ("Running Cost plug-in on file " ^ filename ^ "...\n") ; + let filename_quote = Filename.quote filename in + let base = + if has_extension filename then Filename.chop_extension filename + else filename in + let annotated_file = base ^ "-annotated.c" in + let results_file = base ^ ".cost_results" in + let hex_file = base ^ ".hex" in + let cerco_file = base ^ ".cerco" in + let option = framac_option () in + let cmd = "frama-c -cost " ^ option ^ filename_quote ^ " >> " ^ + log_file in + let error_callback () = () in + let error_msg = "Failed to run Cost plug-in on file " ^ filename ^ "." in + let success_callback () = (annotated_file, results_file, cerco_file) in + let success_msg = + "Done. Annotations are in file " ^ annotated_file ^ + ", object code is in file " ^ hex_file ^ + ", cost results are in file " ^ results_file ^ + (if Options.test_requested () then + ", CerCo information is in file " ^ cerco_file + else "") ^ + "." in + exec cmd error_callback error_msg success_callback success_msg + + +let print_step_result filename = + print_verbose1 ("Reading the cost results in file " ^ filename ^ "...\n") ; + let ic = open_in filename in + let rec aux () = + try + let s = input_line ic in + if String.contains s ' ' then + let i = String.index s ' ' in + let fun_name = String.sub s 0 i in + let cost = String.sub s (i+1) ((String.length s) - (i+1)) in + let suffix = "_step" in + let l = String.length fun_name in + let l' = String.length suffix in + if l > l' && String.sub s (l - l') l' = suffix then + (print_verbose1 "Done.\n" ; + Printf.printf + "WCET of %s: %s (not verified).\n%!" + fun_name cost ; + (fun_name, cost)) + else aux () + else error ("Bad format of result file " ^ filename ^ ".") + with End_of_file -> + error "No step function found or its cost could not be computed." in + aux () + + +let prover () = + if Options.gui_requested () then "" + else "-jessie-atp " ^ (Options.get_prover ()) ^ " " + +let jessie filename = + print_verbose1 ("Running Frama-C/Jessie on file " ^ filename ^ "...\n") ; + let filename_quote = Filename.quote filename in + let base = + if has_extension filename then Filename.chop_extension filename + else filename in + let res_file = base ^ ".jessie_results" in + let timeout = string_of_int (Options.get_timeout ()) in + let cmd = + "TIMEOUT=" ^ timeout ^ " frama-c -jessie -jessie-behavior default " ^ + "-jessie-why-opt=\"-fast-wp\" " ^ (prover ()) ^ + filename_quote ^ " >> " ^ res_file in + let error_callback () = () in + let error_msg = "Failed to run Frama-C/Jessie on file " ^ filename ^ "." in + let success_callback () = res_file in + let success_msg = "Done. Results are in file " ^ res_file ^ "." in + exec cmd error_callback error_msg success_callback success_msg + +let string_starts_with prefix s = + let l = String.length prefix in + (l <= String.length s) && (String.sub s 0 l = prefix) + +let read_jessie_results filename = + if not (Options.gui_requested ()) then + begin + print_verbose1 + ("Reading Frama-C/Jessie results in file " ^ filename ^ "...\n" ) ; + let print_failed () = Printf.printf "Failed to prove the result.\n%!" in + try + let ic = open_in filename in + let rec aux () = + let s = input_line ic in + if string_starts_with "valid" s then + let regexp = Str.regexp (".*100%.*") in + if Str.string_match regexp s 0 then + (print_verbose1 "Done.\n" ; + Printf.printf "WCET is proven correct.\n%!") + else print_failed () + else aux () in + aux () + with Sys_error _ | End_of_file -> print_failed () + end + +let verification filename = + Printf.printf "Verifying the result (this may take some time)...\n%!" ; + let res_file = jessie filename in + read_jessie_results res_file + + +let cerco_test_info (inputs, booleans) step_fun step_cost cerco_file = + print_verbose1 + ("Adding step function information to CerCo file " ^ cerco_file ^ "...\n") ; + try + let ic = open_in cerco_file in + let rec contents () = + try let s = input_line ic in s ^ "\n" ^ (contents ()) + with End_of_file -> close_in ic ; "" in + let contents = step_fun ^ "\n" ^ step_cost ^ "\n" ^ contents () ^ "\n" in + let f contents s = contents ^ s ^ "\n" in + let contents = (List.fold_left f contents inputs) ^ "\n" in + let contents = List.fold_left f contents booleans in + let oc = open_out cerco_file in + output_string oc contents ; + close_out oc ; + print_verbose1 "Done.\n" ; + cerco_file + with Sys_error _ -> + error ("Could not add step function information to CerCo file " ^ + cerco_file ^ ".") + +let cerco_test_file filename cerco_test_info = + print_verbose1 ("Adding a main to file " ^ filename ^ "...\n") ; + let filename_quote = Filename.quote filename in + let base = + if has_extension filename then Filename.chop_extension filename + else filename in + let res_base = base ^ "_test" in + let res_c = res_base ^ ".c" in + let cmd = + "acc -o " ^ res_base ^ " -lustre-test " ^ cerco_test_info ^ + " -lustre-test-cases " ^ (string_of_int (Options.get_test_cases ())) ^ + " -lustre-test-cycles " ^ (string_of_int (Options.get_test_cycles ())) ^ + " -lustre-test-min-int " ^ (string_of_int (Options.get_test_min_int ())) ^ + " -lustre-test-max-int " ^ (string_of_int (Options.get_test_max_int ())) ^ + " " ^ filename_quote ^ " >> " ^ log_file in + let error_callback () = () in + let error_msg = "Failed to add a main to file " ^ filename ^ "." in + let success_callback () = res_c in + let success_msg = "Done. Result is in files " ^ res_c ^ "." in + exec cmd error_callback error_msg success_callback success_msg + +let test_exec filename = + print_verbose1 ("Simulating the generated code in file " ^ filename ^ + "...\n") ; + let filename_quote = Filename.quote filename in + let base = + if has_extension filename then Filename.chop_extension filename + else filename in + let res_file = base ^ ".results" in + let cmd = "acc -l Clight -i " ^ filename_quote ^ " > " ^ res_file in + let error_callback () = () in + let error_msg = "Failed to run acc on file " ^ filename ^ "." in + let success_callback () = res_file in + let success_msg = "Done. Results are in file " ^ res_file ^ "." in + exec cmd error_callback error_msg success_callback success_msg + +let read_test_results filename = + print_verbose1 + ("Reading simulation results in file " ^ filename ^ "...\n" ) ; + try + let ic = open_in filename in + Misc.repeat 2 (fun () -> ignore (input_line ic)) () ; + let wcet = int_of_string (input_line ic) in + let min = int_of_string (input_line ic) in + let max = int_of_string (input_line ic) in + let average = int_of_string (input_line ic) in + let wcet_correct = max <= wcet in + print_verbose1 "Done.\n" ; + Printf.printf "Estimated WCET: %d\nMinimum: %d\nMaximum: %d\nAverage: %d\nEstimated WCET is %scorrect for these executions.\n%!" + wcet min max average (if wcet_correct then "" else "in") + with Sys_error _ | End_of_file | Failure "int_of_string" -> + error "Failed to test the result." + +let test filename inputs_booleans step_fun step_cost cerco_file = + Printf.printf "Testing the result (this may take some time)...\n%!" ; + let cerco_test_info = + cerco_test_info inputs_booleans step_fun step_cost cerco_file in + let cerco_test_file = cerco_test_file filename cerco_test_info in + let test_results = test_exec cerco_test_file in + read_test_results test_results + + +let _ = + let args = OptionsParsing.results () in + if List.length args < 2 then error OptionsParsing.usage_msg + else + begin + let lustre_file = List.nth args 0 in + let node = List.nth args 1 in + print_verbose1 + ("*** Processing node " ^ node ^ " of Lustre file " ^ lustre_file ^ + ". ***\n") ; + let c_file = lustre_compilation lustre_file node in + let inputs_booleans = extract_inputs_booleans c_file in + let (c_annotated_file, cost_results_file, cerco_file) = + cost_plugin c_file in + let (step_fun, step_cost) = print_step_result cost_results_file in + if Options.verify_requested () then verification c_annotated_file ; + if Options.test_requested () then + test c_annotated_file inputs_booleans step_fun step_cost cerco_file ; + end diff --git a/wrapper/misc.ml b/wrapper/misc.ml new file mode 100644 index 0000000..3d34cd9 --- /dev/null +++ b/wrapper/misc.ml @@ -0,0 +1,153 @@ +module LexingExt = struct + + open Lexing + + let new_line lexbuf = + lexbuf.lex_curr_p <- { + lexbuf.lex_curr_p with + pos_bol = 0; + pos_lnum = lexbuf.lex_curr_p.pos_lnum + 1 + } + +end + +module ListExt = struct + + let inv_assoc l = List.map (fun (x, y) -> (y, x)) l + + exception EmptyList + + let last l = try List.hd (List.rev l) with _ -> raise EmptyList + + let cut_last l = + let rec aux l = function + | [] -> raise EmptyList + | [ x ] -> (x, List.rev l) + | x :: xs -> aux (x :: l) xs + in + aux [] l + + let multi_set_of_list l = + let h = Hashtbl.create 13 in + let incr_occ x = + let o = try Hashtbl.find h x with Not_found -> 0 in + Hashtbl.replace h x (o + 1) + in + List.iter incr_occ l; + Hashtbl.fold (fun k v accu -> (k, v) :: accu) h [] + + let hashtbl_of_assoc l = + let h = Hashtbl.create 13 in + List.iter (fun (k, v) -> Hashtbl.add h k v) l; + h + + exception Conflict + let assoc_union l1 l2 = + let h1 = hashtbl_of_assoc l1 in + l1 + @ List.filter + (fun (k, v1) -> + try + let v2 = Hashtbl.find h1 k in + if v1 <> v2 then raise Conflict; + false + with _ -> true) l2 + + let assoc_diff l1 l2 = + let h1 = hashtbl_of_assoc l1 in + let h2 = hashtbl_of_assoc l2 in + let diff h1 h2 f = + Hashtbl.fold + (fun k v1 accu -> + let v2 = + try Some (Hashtbl.find h2 k) + with Not_found -> None + in + if Some v1 <> v2 then + if f then + (k, (Some v1, v2)) :: accu + else + (k, (v2, Some v1)) :: accu + else + accu) + h1 [] + in + let d1 = diff h1 h2 true in + let d2 = diff h2 h1 false in + try assoc_union d1 d2 + with Conflict -> assert false + + let transitive_forall2 p l = + let rec aux = function + | [] -> None + | [x] -> None + | x1 :: ((x2 :: _) as xs) -> + if not (p x1 x2) then Some (x1, x2) else aux xs + in + aux l + +end + +module ArgExt = struct + + let extra_doc s = "", Arg.Unit ignore, s + +end + +module SysExt = struct + + let safe_remove name = + try Sys.remove name with Sys_error _ -> () + + let rec alternative name = + if not (Sys.file_exists name) then + name + else + let dirname = Filename.dirname name in + let filename = Filename.basename name in + let r = Str.regexp "\\([0-9]+\\)-\\(.*\\)" in + let filename = + if Str.string_match r filename 0 then + let i = int_of_string (Str.matched_group 1 filename) in + Printf.sprintf "%02d-%s" (i + 1) (Str.matched_group 2 filename) + else + "01-" ^ filename + in + alternative (Filename.concat dirname filename) + +end + + +let fresh_file prefix suffix = + let string_of_complement = function + | None -> "" + | Some i -> string_of_int i in + let next_complement = function + | None -> Some 0 + | Some i -> Some (i+1) in + let rec aux complement = + let filename = prefix ^ (string_of_complement complement) ^ suffix in + if not (Sys.file_exists filename) then filename + else aux (next_complement complement) in + aux None + +let exists_exts base exts = + let f res ext = res || (Sys.file_exists (base ^ ext)) in + List.fold_left f false exts + +let fresh_base base exts = + let string_of_complement = function + | None -> "" + | Some i -> string_of_int i in + let next_complement = function + | None -> Some 0 + | Some i -> Some (i+1) in + let rec aux complement = + let new_base = base ^ (string_of_complement complement) in + if not (exists_exts new_base exts) then new_base + else aux (next_complement complement) in + aux None + +let rec repeat n f a = + if n = 0 then a + else repeat (n-1) f (f a) diff --git a/wrapper/misc.mli b/wrapper/misc.mli new file mode 100644 index 0000000..2c05009 --- /dev/null +++ b/wrapper/misc.mli @@ -0,0 +1,73 @@ +(** This module extends the standard library of Objective Caml. *) + +module LexingExt : sig + + (** [new_line lexbuf] update lexbuf to increment its line + counter. *) + val new_line : Lexing.lexbuf -> unit + +end + +module ListExt : sig + + (** [inv_assoc l] inverses a bijective associative list [l]. *) + val inv_assoc : ('a * 'b) list -> ('b * 'a) list + + exception EmptyList + + (** [last l] returns the last element of a list. + Raise [EmptyList] if there is no such thing in [l]. *) + val last : 'a list -> 'a + + (** [cut_last l] returns the last element of a list [l] and the + elements that come before it in [l]. + Raise [EmptyList] if there is no such thing in [l]. *) + val cut_last : 'a list -> 'a * 'a list + + (** [multi_set_of_list l] returns an associative list that + relates every element of [l] to its frequency in [l]. *) + val multi_set_of_list : 'a list -> ('a * int) list + + (** [hashtbl_of_assoc l] converts an associative list into + an hash table. *) + val hashtbl_of_assoc : ('a * 'b) list -> ('a, 'b) Hashtbl.t + + (** [assoc_diff l1 l2] returns the difference between two + associative lists. *) + val assoc_diff : ('a * 'b) list -> ('a * 'b) list + -> ('a * ('b option * 'b option)) list + + (** [transitive_forall2 p l] checks that the binary predicate [p] is + true between each successive elements of [l]. If this is false, + the function returns the first pair of elements that falsify [p]. *) + val transitive_forall2 : ('a -> 'a -> bool) -> 'a list -> ('a * 'a) option + +end + +module ArgExt : sig + + (** [extra_doc s] adds an extra line of documentation for an + Arg.spec row. *) + val extra_doc : string -> (Arg.key * Arg.spec * Arg.doc) + +end + +module SysExt : sig + + (** [safe_remove filename] deletes a file named [filename], + but do not crash if a system error happens. (For instance, + if the file does not exist.) *) + val safe_remove : string -> unit + + (** [alternative filename] finds an alternative name different + from [filename] that is not already used. *) + val alternative : string -> string + +end + + +val fresh_file : string -> string -> string + +val fresh_base : string -> string list -> string + +val repeat : int -> ('a -> 'a) -> 'a -> 'a diff --git a/wrapper/options.ml b/wrapper/options.ml new file mode 100644 index 0000000..7debbc0 --- /dev/null +++ b/wrapper/options.ml @@ -0,0 +1,87 @@ +open Misc.ArgExt + +let timeout = ref 0 +let set_timeout i = timeout := i +let get_timeout () = !timeout + +let prover = ref "simplify" +let set_prover s = prover := s +let get_prover () = !prover + +let gui_flag = ref false +let request_gui = (:=) gui_flag +let gui_requested () = !gui_flag + +let verbose_level = ref 0 +let set_verbose_level i = verbose_level := i +let get_verbose_level () = !verbose_level + +let verify_flag = ref false +let request_verify = (:=) verify_flag +let verify_requested () = !verify_flag + +let test_flag = ref false +let request_test = (:=) test_flag +let test_requested () = !test_flag + +let test_cases = ref 10 +let set_test_cases i = test_cases := i +let get_test_cases () = !test_cases + +let test_cycles = ref 10 +let set_test_cycles i = test_cycles := i +let get_test_cycles () = !test_cycles + +let test_min_int = ref (-1000) +let set_test_min_int i = test_min_int := i +let get_test_min_int () = !test_min_int + +let test_max_int = ref 1000 +let set_test_max_int i = test_max_int := i +let get_test_max_int () = !test_max_int + +let options = OptionsParsing.register [ + + "-v", Arg.Int set_verbose_level, + " Verbosity, from 0 (lowest) to 2 (highest)."; + extra_doc " [default is 0]"; + + "-verify", Arg.Set verify_flag, + " Verify the results with Frama-C/Jessie."; + + "-timeout", Arg.Int set_timeout, + " Timeout in seconds for verification. 0 means no timeout."; + extra_doc " [default is 0]"; + + "-prover", Arg.String set_prover, + " Select a prover for verification through why."; + extra_doc " Needs the -verify option."; + extra_doc " [default is simplify]"; + + "-gui", Arg.Set gui_flag, + " Do not select a prover: run a graphical user interface instead."; + extra_doc " Needs the -verify option."; + + "-test", Arg.Set test_flag, + " Test the results."; + + "-test-cases", Arg.Int set_test_cases, + " Number of test cases."; + extra_doc " Needs the -test option."; + extra_doc " [default is 10]"; + + "-test-cycles", Arg.Int set_test_cycles, + " Number of cycles for each test case."; + extra_doc " Needs the -test option."; + extra_doc " [default is 10]"; + + "-test-min-int", Arg.Int set_test_min_int, + " Random int minimum value."; + extra_doc " Needs the -test option."; + extra_doc " [default is -1000]"; + + "-test-max-int", Arg.Int set_test_max_int, + " Random int maximum value."; + extra_doc " Needs the -test option."; + extra_doc " [default is 1000]"; +] diff --git a/wrapper/options.mli b/wrapper/options.mli new file mode 100644 index 0000000..3973700 --- /dev/null +++ b/wrapper/options.mli @@ -0,0 +1,41 @@ +(** This module defines the wrapper general options. *) + +(** {2 Timeout} *) +val set_timeout : int -> unit +val get_timeout : unit -> int + +(** {2 Timeout} *) +val set_prover : string -> unit +val get_prover : unit -> string + +(** {2 Timeout} *) +val request_gui : bool -> unit +val gui_requested : unit -> bool + +(** {2 Verbosity} *) +val set_verbose_level : int -> unit +val get_verbose_level : unit -> int + +(** {2 Verification request} *) +val request_verify : bool -> unit +val verify_requested : unit -> bool + +(** {2 Test request} *) +val request_test : bool -> unit +val test_requested : unit -> bool + +(** {2 Test cases number} *) +val set_test_cases : int -> unit +val get_test_cases : unit -> int + +(** {2 Test cycles number} *) +val set_test_cycles : int -> unit +val get_test_cycles : unit -> int + +(** {2 Random int minimum value} *) +val set_test_min_int : int -> unit +val get_test_min_int : unit -> int + +(** {2 Random int maximum value} *) +val set_test_max_int : int -> unit +val get_test_max_int : unit -> int diff --git a/wrapper/optionsParsing.ml b/wrapper/optionsParsing.ml new file mode 100644 index 0000000..467c9b3 --- /dev/null +++ b/wrapper/optionsParsing.ml @@ -0,0 +1,16 @@ +let options = ref [] + +let register o = + options := o @ !options + +let usage_msg = + "Usage: " + ^ (Filename.basename Sys.executable_name) + ^ " [options] file.lus node" + +let results () = + let extra_arguments = ref [] in + Arg.parse (Arg.align !options) + (fun s -> extra_arguments := s :: !extra_arguments) + usage_msg; + List.rev !extra_arguments diff --git a/wrapper/position.ml b/wrapper/position.ml new file mode 100644 index 0000000..228466e --- /dev/null +++ b/wrapper/position.ml @@ -0,0 +1,134 @@ +open Lexing + +type t = + { + start_p : Lexing.position; + end_p : Lexing.position + } + +type position = t + +type 'a located = + { + value : 'a; + position : t; + } + +let value { value = v } = + v + +let position { position = p } = + p + +let destruct p = + (p.value, p.position) + +let with_pos p v = + { + value = v; + position = p; + } + +let with_poss p1 p2 v = + with_pos { start_p = p1; end_p = p2 } v + +let map f v = + { + value = f v.value; + position = v.position; + } + +let iter f { value = v } = + f v + +let mapd f v = + let w1, w2 = f v.value in + let pos = v.position in + ({ value = w1; position = pos }, { value = w2; position = pos }) + +let dummy = + { + start_p = Lexing.dummy_pos; + end_p = Lexing.dummy_pos + } + +let unknown_pos v = + { + value = v; + position = dummy + } + +let start_of_position p = p.start_p + +let end_of_position p = p.end_p + +let filename_of_position p = + p.start_p.Lexing.pos_fname + +let line p = + p.pos_lnum + +let column p = + p.pos_cnum - p.pos_bol + +let characters p1 p2 = + (column p1, p2.pos_cnum - p1.pos_bol) (* intentionally [p1.pos_bol] *) + +let join x1 x2 = + { + start_p = if x1 = dummy then x2.start_p else x1.start_p; + end_p = if x2 = dummy then x1.end_p else x2.end_p + } + +let lex_join x1 x2 = + { + start_p = x1; + end_p = x2 + } + +let join_located l1 l2 f = + { + value = f l1.value l2.value; + position = join l1.position l2.position; + } + +let string_of_lex_pos p = + let c = p.pos_cnum - p.pos_bol in + (string_of_int p.pos_lnum)^":"^(string_of_int c) + +let string_of_pos p = + let filename = filename_of_position p in + let l = line p.start_p in + let c1, c2 = characters p.start_p p.end_p in + if filename = "" then + Printf.sprintf "Line %d, characters %d-%d" l c1 c2 + else + Printf.sprintf "File \"%s\", line %d, characters %d-%d" filename l c1 c2 + +let pos_or_undef = function + | None -> dummy + | Some x -> x + +let cpos lexbuf = + { + start_p = Lexing.lexeme_start_p lexbuf; + end_p = Lexing.lexeme_end_p lexbuf; + } + +let with_cpos lexbuf v = + with_pos (cpos lexbuf) v + +let string_of_cpos lexbuf = + string_of_pos (cpos lexbuf) + +let joinf f t1 t2 = + join (f t1) (f t2) + +let ljoinf f = + List.fold_left (fun p t -> join p (f t)) dummy + +let join_located_list ls f = + { + value = f (List.map (fun l -> l.value) ls); + position = ljoinf (fun x -> x.position) ls + } diff --git a/wrapper/position.mli b/wrapper/position.mli new file mode 100644 index 0000000..ddb18d2 --- /dev/null +++ b/wrapper/position.mli @@ -0,0 +1,106 @@ +(** Extension of standard library's positions. *) + +(** {2 Extended lexing positions} *) + +(** Abstract type for pairs of positions in the lexing stream. *) +type t +type position = t + +(** Decoration of a value with a position. *) +type 'a located = + { + value : 'a; + position : t; + } + +(** [value dv] returns the raw value that underlies the + decorated value [dv]. *) +val value: 'a located -> 'a + +(** [position dv] returns the position that decorates the + decorated value [dv]. *) +val position: 'a located -> t + +(** [destruct dv] returns the couple of position and value + of a decorated value [dv]. *) +val destruct: 'a located -> 'a * t + +(** [with_pos p v] decorates [v] with a position [p]. *) +val with_pos : t -> 'a -> 'a located + +(** [with_cpos p v] decorates [v] with a lexical position [p]. *) +val with_cpos: Lexing.lexbuf -> 'a -> 'a located + +(** [with_poss start stop v] decorates [v] with a position [(start, stop)]. *) +val with_poss : Lexing.position -> Lexing.position -> 'a -> 'a located + +(** [unknown_pos x] decorates [v] with an unknown position. *) +val unknown_pos : 'a -> 'a located + +(** This value is used when an object does not come from a particular + input location. *) +val dummy: t + +(** [map f v] extends the decoration from [v] to [f v]. *) +val map: ('a -> 'b) -> 'a located -> 'b located + +(** [iter f dv] applies [f] to the value inside [dv]. *) +val iter: ('a -> unit) -> 'a located -> unit + +(** [mapd f v] extends the decoration from [v] to both members of the pair + [f v]. *) +val mapd: ('a -> 'b1 * 'b2) -> 'a located -> 'b1 located * 'b2 located + +(** {2 Accessors} *) + +(** [column p] returns the number of characters from the + beginning of the line of the Lexing.position [p]. *) +val column : Lexing.position -> int + +(** [column p] returns the line number of to the Lexing.position [p]. *) +val line : Lexing.position -> int + +(** [characters p1 p2] returns the character interval + between [p1] and [p2] assuming they are located in the same + line. *) +val characters : Lexing.position -> Lexing.position -> int * int + +(** [start_of_position p] returns the beginning of a position [p]. *) +val start_of_position: t -> Lexing.position + +(** [end_of_position p] returns the end of a position [p]. *) +val end_of_position: t -> Lexing.position + +(** [filename_of_position p] returns the filename of a position [p]. *) +val filename_of_position: t -> string + +(** {2 Position handling} *) + +(** [join p1 p2] returns a position that starts where [p1] + starts and stops where [p2] stops. *) +val join : t -> t -> t + +(** [lex_join l1 l2] returns a position that starts at [l1] and stops + at [l2]. *) +val lex_join : Lexing.position -> Lexing.position -> t + +(** [string_of_lex_pos p] returns a string representation for + the lexing position [p]. *) +val string_of_lex_pos : Lexing.position -> string + +(** [string_of_pos p] returns the standard (Emacs-like) representation + of the position [p]. *) +val string_of_pos : t -> string + +(** [pos_or_undef po] is the identity function except if po = None, + in that case, it returns [undefined_position]. *) +val pos_or_undef : t option -> t + +(** {2 Interaction with the lexer runtime} *) + +(** [cpos lexbuf] returns the current position of the lexer. *) +val cpos : Lexing.lexbuf -> t + +(** [string_of_cpos p] returns a string representation of + the lexer's current position. *) +val string_of_cpos : Lexing.lexbuf -> string diff --git a/wrapper/tests/parity/Makefile b/wrapper/tests/parity/Makefile new file mode 100644 index 0000000..2fe09dc --- /dev/null +++ b/wrapper/tests/parity/Makefile @@ -0,0 +1,15 @@ + +gen : + @lustre parity.lus verif_parity -v + @ocmin verif_parity.oc -v + @poc verif_parity_min.oc + +genmin : + @lustre parity.lus verif_parity -v -demand + @poc verif_parity.oc + +verif : + @lesar parity.lus verif_parity -v + +clean : + /bin/rm -f *.ec *.oc *.c *.h *.bak diff --git a/wrapper/tests/parity/README b/wrapper/tests/parity/README new file mode 100644 index 0000000..f5b5e9a --- /dev/null +++ b/wrapper/tests/parity/README @@ -0,0 +1,37 @@ +Modified : Jan 9 1995 +Modified : Jul 1 1997 + + +A verification program illustrating the use of arrays and recursive nodes. +The goal is to compare a combinatorial operator "P", computing the parity bit +of a bit-string, to a sequential version "parity". + +The size of the bit-string is a constant of the program, here 8. + +The node XOR implements exclusive "or" + +The combinatorial parity-bit operator is recursive +- applied to a bit-string of size 1, it returns the value of its unique bit. +- applied to a bit-string of longer size n, it returns the exclusive "or" of + the last bit of the string and the result of P applied to the n-1 first bits. + +The sequential parity-bit operator proceeds by shifting its parameter b. At +any cycle + - the parity-bit is the exclusive "or" of its preceding value and the + leftmost bit of b. + - the array b is shifted to the left (and completed by "false" on the right) + +In order to know when the whole array has been processed, an auxiliary array +"todo" is used. All its elements but the rightmost are initialized to false. +It is shifted to the left at any cycle, until its only "true" element becomes +the leftmost. Then the variable "done" becomes true, and the parity-bit has +been computed. + +The verification program compares the result of the combinatorial operator +with the one of the sequential operator, when the computation of the last +one is terminated. + +The Makefile gives 3 ways for verification : + GenThenMin => generate full automaton then minimize + GenMin => generate minimal automaton + Verif => use the verification tool diff --git a/wrapper/tests/parity/parity.lus b/wrapper/tests/parity/parity.lus new file mode 100644 index 0000000..243bbb3 --- /dev/null +++ b/wrapper/tests/parity/parity.lus @@ -0,0 +1,35 @@ +const size=8; + +node XOR(a,b:bool) returns (Xor:bool); +let + Xor = if a then not b else b; +tel + +node P(const n: int; B: bool^n) returns (p:bool); +let + p = with n=1 then B[0] + else XOR(B[n-1] , P(n-1,B[0..n-2])); +tel + +node parity (input: bool^size) +returns (parity,done: bool); +var b, todo: bool^size; +let + b[0..(size-2)] = input[0..(size-2)] -> + pre(b[1..(size-1)]); + b[size-1] = input[size-1] -> false; + todo[0..(size-2)] = false^(size-1) -> + pre(todo[1..(size-1)]); + todo[size-1] = true -> false; + done = todo[0]; + parity = b[0] -> XOR(pre(parity) , b[0]); +tel + +node verif_parity (input: bool^size) +returns(ok: bool); +var comb, seq, done: bool; +let + ok = not done or (comb = seq); + comb = P(size,input) -> pre(comb); + (seq,done) = parity(input); +tel -- 2.39.2