From ad8d968c3eda073d339383e899eaa1bd447ce6e0 Mon Sep 17 00:00:00 2001
From: Fonenantsoa Maurica <maurica.fonenantsoa@gmail.com>
Date: Tue, 8 Jan 2019 18:54:43 +0100
Subject: [PATCH] Extend Interval, Typing and Translate: - Interval: -
Not_an_integer -> Is_a_real|Not_a_number. - infer -> infer_with_real
because Not_a_number has priority over Is_a_real - Ival.bottom when
Is_a_real because the interval is for integers - Typing: -
integer_ty -> number_ty=Cty|Gmpz|Libr|Nan - Other -> 'Other (Oreal|Onan)'
- Translate: Encode real constants into strings: - **NO**
conversion to float-point type - strnum_ty=StrZ|StrR|Not_a_strnum
for tracking the type of the string Add Libr: - Gmpz -> Gmp=Gmpz+Gmpq -
Libr=ref to Gmpq Add Gmpq builtins: - Custom mini-gmp -> libgmp because
mini-gmp has no support for Q - Add arithmetic over Q in e_acsl_gmp_api.h
Misc: - dec_to_frac: decimal expansion to fractional representation
because decimal expansion is interpreted as double by Gmpq Tests: - BTS
1307 has an assertion wrongly evaluated, fixed - Add tests/gmp/reals.c THE
MOST IMPORTANT TODO: - Completely hide the library for numbers (currently
Gmp) inside Libr: Typing, Env and Translate should only know Libr and
never directly call Gmp. This is crucial for extending E-ACSL in the
future (eg: Gmp has no support for elementary functions), and also
for using it as part of an abstract compiler (eg: with Fldlib) For
the time being, in Translate, we have something as ugly as: let
init_set = if Libr.is_t ty then Libr.init_set else
Gmp.init_set
---
src/plugins/e-acsl/Makefile.in | 40 +-
src/plugins/e-acsl/at_with_lscope.ml | 97 +-
src/plugins/e-acsl/contrib/libgmp/.gdbinit | 43 -
src/plugins/e-acsl/contrib/libgmp/README | 77 -
src/plugins/e-acsl/contrib/libgmp/mini-gmp.c | 4381 -----------------
src/plugins/e-acsl/contrib/libgmp/mini-gmp.h | 350 --
src/plugins/e-acsl/dup_functions.ml | 10 +-
src/plugins/e-acsl/env.ml | 181 +-
src/plugins/e-acsl/gmp.ml | 213 +
src/plugins/e-acsl/{gmpz.mli => gmp.mli} | 48 +-
src/plugins/e-acsl/gmpz.ml | 142 -
src/plugins/e-acsl/interval.ml | 230 +-
src/plugins/e-acsl/interval.mli | 14 +-
src/plugins/e-acsl/libr.ml | 163 +
src/plugins/e-acsl/libr.mli | 70 +
src/plugins/e-acsl/logic_functions.ml | 18 +-
src/plugins/e-acsl/logic_functions.mli | 2 +-
src/plugins/e-acsl/loops.ml | 26 +-
src/plugins/e-acsl/main.ml | 4 +-
src/plugins/e-acsl/misc.ml | 73 +
src/plugins/e-acsl/misc.mli | 15 +-
src/plugins/e-acsl/mmodel_translate.ml | 8 +-
src/plugins/e-acsl/scripts/e-acsl-gcc.sh | 2 +-
.../e-acsl/share/e-acsl/e_acsl_gmp_api.h | 86 +
src/plugins/e-acsl/tests/bts/bts1307.i | 5 +-
.../tests/bts/oracle/bts1307.res.oracle | 33 +-
.../e-acsl/tests/bts/oracle/gen_bts1307.c | 220 +-
.../e-acsl/tests/gmp/oracle/cast.0.res.oracle | 5 +-
.../e-acsl/tests/gmp/oracle/cast.1.res.oracle | 11 +-
.../e-acsl/tests/gmp/oracle/gen_cast.c | 4 +-
.../e-acsl/tests/gmp/oracle/gen_cast2.c | 33 +-
src/plugins/e-acsl/tests/gmp/oracle/gen_let.c | 17 +-
.../e-acsl/tests/gmp/oracle/gen_let2.c | 27 +-
.../e-acsl/tests/gmp/oracle/gen_reals.c | 355 ++
.../e-acsl/tests/gmp/oracle/gen_reals2.c | 355 ++
.../e-acsl/tests/gmp/oracle/let.0.res.oracle | 6 +
.../e-acsl/tests/gmp/oracle/let.1.res.oracle | 6 +
.../tests/gmp/oracle/reals.0.res.oracle | 84 +
.../tests/gmp/oracle/reals.1.res.oracle | 84 +
src/plugins/e-acsl/tests/gmp/reals.c | 38 +
src/plugins/e-acsl/tests/gmp/reals1.c.notest | 16 +
src/plugins/e-acsl/translate.ml | 354 +-
src/plugins/e-acsl/typing.ml | 221 +-
src/plugins/e-acsl/typing.mli | 64 +-
44 files changed, 2465 insertions(+), 5766 deletions(-)
delete mode 100644 src/plugins/e-acsl/contrib/libgmp/.gdbinit
delete mode 100644 src/plugins/e-acsl/contrib/libgmp/README
delete mode 100644 src/plugins/e-acsl/contrib/libgmp/mini-gmp.c
delete mode 100644 src/plugins/e-acsl/contrib/libgmp/mini-gmp.h
create mode 100644 src/plugins/e-acsl/gmp.ml
rename src/plugins/e-acsl/{gmpz.mli => gmp.mli} (62%)
delete mode 100644 src/plugins/e-acsl/gmpz.ml
create mode 100644 src/plugins/e-acsl/libr.ml
create mode 100644 src/plugins/e-acsl/libr.mli
create mode 100644 src/plugins/e-acsl/tests/gmp/oracle/gen_reals.c
create mode 100644 src/plugins/e-acsl/tests/gmp/oracle/gen_reals2.c
create mode 100644 src/plugins/e-acsl/tests/gmp/oracle/reals.0.res.oracle
create mode 100644 src/plugins/e-acsl/tests/gmp/oracle/reals.1.res.oracle
create mode 100644 src/plugins/e-acsl/tests/gmp/reals.c
create mode 100644 src/plugins/e-acsl/tests/gmp/reals1.c.notest
diff --git a/src/plugins/e-acsl/Makefile.in b/src/plugins/e-acsl/Makefile.in
index fc9b5349f30..43c869e1d62 100644
--- a/src/plugins/e-acsl/Makefile.in
+++ b/src/plugins/e-acsl/Makefile.in
@@ -64,13 +64,14 @@ PLUGIN_CMO:= local_config \
builtins \
functions \
misc \
- gmpz \
+ gmp \
literal_strings \
mmodel_analysis \
exit_points \
label \
lscope \
env \
+ libr \
keep_status \
dup_functions \
interval \
@@ -213,34 +214,10 @@ $(EACSL_DLMALLOC_LIB): $(EACSL_DLMALLOC_SRC)
echo 'RANLIB $@'
ranlib $@
-############
-# GMP #
-############
-
-EACSL_GMP_REL_DIR:=contrib/libgmp
-EACSL_GMP_DIR := $(EACSL_PLUGIN_DIR)/$(EACSL_GMP_REL_DIR)
-EACSL_GMP_LIBNAME = libeacsl-gmp.a
-EACSL_GMP_LIB = $(EACSL_LIBDIR)/$(EACSL_GMP_LIBNAME)
-EACSL_GMP_OBJ = mini-gmp.o
-EACSL_GMP_SRC = $(EACSL_GMP_DIR)/mini-gmp.c
-EACSL_GMP_FLAGS = \
- -Dmalloc=__e_acsl_private_malloc \
- -Drealloc=__e_acsl_private_realloc \
- -Dfree=__e_acsl_private_free
-
-$(EACSL_GMP_LIB): $(EACSL_GMP_SRC)
- $(MKDIR) $(EACSL_LIBDIR)
- echo 'CC $< '
- $(CC) $< $(EACSL_GMP_FLAGS) -c -O2 -g3 -o$(EACSL_GMP_OBJ)
- echo 'AR $@'
- $(AR) crus $(EACSL_GMP_LIB) $(EACSL_GMP_OBJ)
- echo 'RANLIB $@'
- ranlib $(EACSL_GMP_LIB)
-
-all:: $(EACSL_DLMALLOC_LIB) $(EACSL_GMP_LIB)
+all:: $(EACSL_DLMALLOC_LIB)
clean::
- $(RM) $(EACSL_DLMALLOC_LIB) $(EACSL_GMP_LIB)
+ $(RM) $(EACSL_DLMALLOC_LIB)
############
# Cleaning #
@@ -261,8 +238,6 @@ e-acsl-distclean:: clean
EXPORT = e-acsl-$(EACSL_VERSION)
EACSL_CONTRIB_FILES = \
- $(EACSL_GMP_REL_DIR)/mini-gmp.c \
- $(EACSL_GMP_REL_DIR)/mini-gmp.h \
$(EACSL_DLMALLOC_REL_DIR)/dlmalloc.c
EACSL_MANUAL_FILES = doc/manuals/*.pdf
@@ -276,7 +251,7 @@ EACSL_DOC_FILES = \
EACSL_TEST_FILES = \
tests/test_config.in tests/print.ml
-# Test files without header management
+# Test files without header management
EACSL_DISTRIB_TESTS = \
$(foreach dir, $(addprefix tests/,$(PLUGIN_TESTS_DIRS)), \
$(dir)/*.[ich] \
@@ -401,7 +376,7 @@ EACSL_CEA_LGPL_BARE= *.ml *.mli Makefile.in configure.ac \
EACSL_CEA_LGPL=$(addprefix $(EACSL_PLUGIN_DIR)/, $(EACSL_CEA_LGPL_BARE)) \
$(EACSL_CEA_SHARE)
-# valid values: open-source, close-source
+# valid values: open-source, close-source
EACSL_HEADERS?=open-source
headers::
@echo "Applying $(EACSL_HEADERS) headers..."
@@ -414,9 +389,6 @@ headers::
headache -c $(EACSL_PLUGIN_DIR)/license/headache_config.txt \
-h $(EACSL_PLUGIN_DIR)/headers/$(EACSL_HEADERS)/MODIFIED_DLMALLOC \
$(EACSL_PLUGIN_DIR)/contrib/libdlmalloc/dlmalloc.c
- headache -c $(EACSL_PLUGIN_DIR)/license/headache_config.txt \
- -h $(EACSL_PLUGIN_DIR)/headers/$(EACSL_HEADERS)/MODIFIED_LIB_GMP \
- $(EACSL_PLUGIN_DIR)/contrib/libgmp/mini-gmp.[ch]
endif
diff --git a/src/plugins/e-acsl/at_with_lscope.ml b/src/plugins/e-acsl/at_with_lscope.ml
index d1b5cc2162f..759e9473bf3 100644
--- a/src/plugins/e-acsl/at_with_lscope.ml
+++ b/src/plugins/e-acsl/at_with_lscope.ml
@@ -229,55 +229,56 @@ let to_exp ~loc kf env pot label =
| Misc.PoT_pred _ ->
Cil.intType
| Misc.PoT_term t ->
- begin match Typing.get_integer_ty t with
- | Typing.C_type _ | Typing.Other ->
+ begin match Typing.get_number_ty t with
+ | Typing.C_type _ | Typing.Nan ->
Typing.get_typ t
- | Typing.Gmp ->
+ | Typing.Libr ->
+ Error.not_yet "\\at on purely logic variables and over real type"
+ | Typing.Gmpz ->
Error.not_yet "\\at on purely logic variables and over gmp type"
end
in
let ty_ptr = TPtr(ty, []) in
- let vi_at, e_at, env =
- Env.new_var
- ~loc
- ~name:"at"
- ~scope:Env.Function
- env
- None
- ty_ptr
- (fun vi e ->
- (* Handle [malloc] and [free] stmts *)
- let lty_sizeof = Ctype Cil.(theMachine.typeOfSizeOf) in
- let t_sizeof = Logic_const.term ~loc (TSizeOf ty) lty_sizeof in
- let t_size = size_from_sizes_and_shifts ~loc sizes_and_shifts in
- let t_size =
- Logic_const.term ~loc (TBinOp(Mult, t_sizeof, t_size)) lty_sizeof
- in
- Typing.type_term ~use_gmp_opt:false t_size;
- let malloc_stmt = match Typing.get_integer_ty t_size with
- | Typing.C_type IInt ->
- let e_size, _ = term_to_exp kf env t_size in
- let e_size = Cil.constFold false e_size in
- let malloc_stmt =
- Misc.mk_call ~loc ~result:(Cil.var vi) "malloc" [e_size]
- in
- malloc_stmt
- | Typing.C_type _ | Typing.Gmp ->
- Error.not_yet
- "\\at on purely logic variables that needs to allocate \
- too much memory (bigger than int_max bytes)"
- | Typing.Other ->
- Options.fatal
- "quantification over non-integer type is not part of E-ACSL"
- in
- let free_stmt = Misc.mk_call ~loc "free" [e] in
- (* The list of stmts returned by the current closure are inserted
- LOCALLY to the block where the new var is FIRST used, whatever scope
- is indicated to [Env.new_var]. Thus we need to add [malloc] and
- [free] through dedicated functions. *)
- Malloc.add kf malloc_stmt;
- Free.add kf free_stmt;
- [])
+ let vi_at, e_at, env = Env.new_var
+ ~loc
+ ~name:"at"
+ ~scope:Env.Function
+ env
+ None
+ ty_ptr
+ (fun vi e ->
+ (* Handle [malloc] and [free] stmts *)
+ let lty_sizeof = Ctype Cil.(theMachine.typeOfSizeOf) in
+ let t_sizeof = Logic_const.term ~loc (TSizeOf ty) lty_sizeof in
+ let t_size = size_from_sizes_and_shifts ~loc sizes_and_shifts in
+ let t_size =
+ Logic_const.term ~loc (TBinOp(Mult, t_sizeof, t_size)) lty_sizeof
+ in
+ Typing.type_term ~use_gmp_opt:false t_size;
+ let malloc_stmt = match Typing.get_number_ty t_size with
+ | Typing.C_type IInt ->
+ let e_size, _ = term_to_exp kf env t_size in
+ let e_size = Cil.constFold false e_size in
+ let malloc_stmt =
+ Misc.mk_call ~loc ~result:(Cil.var vi) "malloc" [e_size]
+ in
+ malloc_stmt
+ | Typing.C_type _ | Typing.Gmpz ->
+ Error.not_yet
+ "\\at on purely logic variables that needs to allocate \
+ too much memory (bigger than int_max bytes)"
+ | Typing.Libr | Typing.Nan ->
+ Options.fatal
+ "quantification over non-integer type is not part of E-ACSL"
+ in
+ let free_stmt = Misc.mk_call ~loc "free" [e] in
+ (* The list of stmts returned by the current closure are inserted
+ LOCALLY to the block where the new var is FIRST used, whatever scope
+ is indicated to [Env.new_var].
+ Thus we need to add [malloc] and [free] through dedicated functions. *)
+ Malloc.add kf malloc_stmt;
+ Free.add kf free_stmt;
+ [])
in
(* Index *)
let t_index = index_from_sizes_and_shifts ~loc sizes_and_shifts in
@@ -301,8 +302,8 @@ let to_exp ~loc kf env pot label =
variable declarations. *)
[ Cil.mkStmt ~valid_sid:true (Block block) ], env
| Misc.PoT_term t ->
- begin match Typing.get_integer_ty t with
- | Typing.C_type _ | Typing.Other ->
+ begin match Typing.get_number_ty t with
+ | Typing.C_type _ | Typing.Nan ->
let env = Env.push env in
let lval, env = lval_at_index ~loc kf env (e_at, vi_at, t_index) in
let e, env = term_to_exp kf env t in
@@ -316,7 +317,9 @@ let to_exp ~loc kf env pot label =
(* We CANNOT return [block.bstmts] because it does NOT contain
variable declarations. *)
[ Cil.mkStmt ~valid_sid:true (Block block) ], env
- | Typing.Gmp ->
+ | Typing.Libr ->
+ Error.not_yet "\\at on purely logic variables and over real type"
+ | Typing.Gmpz ->
Error.not_yet "\\at on purely logic variables and over gmp type"
end
in
diff --git a/src/plugins/e-acsl/contrib/libgmp/.gdbinit b/src/plugins/e-acsl/contrib/libgmp/.gdbinit
deleted file mode 100644
index 473d74f5904..00000000000
--- a/src/plugins/e-acsl/contrib/libgmp/.gdbinit
+++ /dev/null
@@ -1,43 +0,0 @@
-# Copyright 1999 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of either:
-#
-# * the GNU Lesser General Public License as published by the Free
-# Software Foundation; either version 3 of the License, or (at your
-# option) any later version.
-#
-# or
-#
-# * the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any
-# later version.
-#
-# or both in parallel, as here.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-# for more details.
-#
-# You should have received copies of the GNU General Public License and the
-# GNU Lesser General Public License along with the GNU MP Library. If not,
-# see https://www.gnu.org/licenses/.
-
-
-define pz
-set __gmpz_dump ($)
-end
-
-define pq
-set __gmpz_dump ($->_mp_num)
-echo /
-set __gmpz_dump ($->_mp_den)
-end
-
-define pf
-set __gmpf_dump ($)
-end
-
diff --git a/src/plugins/e-acsl/contrib/libgmp/README b/src/plugins/e-acsl/contrib/libgmp/README
deleted file mode 100644
index f291489ea3e..00000000000
--- a/src/plugins/e-acsl/contrib/libgmp/README
+++ /dev/null
@@ -1,77 +0,0 @@
-Copyright 2011-2013 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of either:
-
- * the GNU Lesser General Public License as published by the Free
- Software Foundation; either version 3 of the License, or (at your
- option) any later version.
-
-or
-
- * the GNU General Public License as published by the Free Software
- Foundation; either version 2 of the License, or (at your option) any
- later version.
-
-or both in parallel, as here.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received copies of the GNU General Public License and the
-GNU Lesser General Public License along with the GNU MP Library. If not,
-see https://www.gnu.org/licenses/.
-
-
-This is "mini-gmp", a small implementation of a subset of GMP's mpn
-and mpz interfaces.
-
-It is intended for applications which need arithmetic on numbers
-larger than a machine word, but which don't need to handle very large
-numbers very efficiently. Those applications can include a copy of
-mini-gmp to get a GMP-compatible interface with small footprint. One
-can also arrange for optional linking with the real GMP library, using
-mini-gmp as a fallback when for some reason GMP is not available, or
-not desired as a dependency.
-
-The supported GMP subset is declared in mini-gmp.h. The implemented
-functions are fully compatible with the corresponding GMP functions,
-as specified in the GMP manual, with a few exceptions:
-
- mpz_set_str, mpz_init_set_str, mpz_get_str, mpz_out_str and
- mpz_sizeinbase support only |base| <= 36;
- mpz_export and mpz_import support only NAILS = 0.
-
- The REALLOC_FUNC and FREE_FUNC registered with
- mp_set_memory_functions does not get the correct size of the
- allocated block in the corresponding argument. mini-gmp always
- passes zero for these rarely used arguments.
-
-The implementation is a single file, mini-gmp.c.
-
-The performance target for mini-gmp is to be at most 10 times slower
-than the real GMP library, for numbers of size up to a few hundred
-bits. No asymptotically fast algorithms are included in mini-gmp, so
-it will be many orders of magnitude slower than GMP for very large
-numbers.
-
-You should never "install" mini-gmp. Applications can either just
-#include mini-gmp.c (but then, beware that it defines several macros
-and functions outside of the advertised interface). Or compile
-mini-gmp.c as a separate compilation unit, and use the declarations in
-mini-gmp.h.
-
-The tests subdirectory contains a testsuite. To use it, you need GMP
-and GNU make. Just run make check in the tests directory. If the
-hard-coded compiler settings are not right, you have to either edit the
-Makefile or pass overriding values on the make command line (e.g.,
-make CC=cc check). Testing is not (yet) as thorough as for the real
-GMP.
-
-The current version was put together by Niels Möller
-<nisse@lysator.liu.se>, with a fair amount of copy-and-paste from the
-GMP sources.
diff --git a/src/plugins/e-acsl/contrib/libgmp/mini-gmp.c b/src/plugins/e-acsl/contrib/libgmp/mini-gmp.c
deleted file mode 100644
index 5764a9fcb9d..00000000000
--- a/src/plugins/e-acsl/contrib/libgmp/mini-gmp.c
+++ /dev/null
@@ -1,4381 +0,0 @@
-/********************************************************************************/
-/* */
-/* mini-gmp, a minimalistic implementation of a GNU GMP subset. */
-/* */
-/* Contributed to the GNU project by Niels Möller */
-/* */
-/* Copyright 1991-1997, 1999-2015 Free Software Foundation, Inc. */
-/* */
-/* This file is part of the GNU MP Library. */
-/* */
-/* The GNU MP Library is free software; you can redistribute it and/or modify */
-/* it under the terms of either: */
-/* */
-/* * the GNU Lesser General Public License as published by the Free */
-/* Software Foundation; either version 3 of the License, or (at your */
-/* option) any later version. */
-/* */
-/* or */
-/* */
-/* * the GNU General Public License as published by the Free Software */
-/* Foundation; either version 2 of the License, or (at your option) any */
-/* later version. */
-/* */
-/* or both in parallel, as here. */
-/* */
-/* The GNU MP Library is distributed in the hope that it will be useful, but */
-/* WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY */
-/* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License */
-/* for more details. */
-/* */
-/* You should have received copies of the GNU General Public License and the */
-/* GNU Lesser General Public License along with the GNU MP Library. If not, */
-/* see https://www.gnu.org/licenses/. */
-/* */
-/* File modified by CEA (Commissariat à l'énergie atomique et aux */
-/* énergies alternatives). */
-/* */
-/********************************************************************************/
-
-/* NOTE: All functions in this file which are not declared in
- mini-gmp.h are internal, and are not intended to be compatible
- neither with GMP nor with future versions of mini-gmp. */
-
-/* Much of the material copied from GMP files, including: gmp-impl.h,
- longlong.h, mpn/generic/add_n.c, mpn/generic/addmul_1.c,
- mpn/generic/lshift.c, mpn/generic/mul_1.c,
- mpn/generic/mul_basecase.c, mpn/generic/rshift.c,
- mpn/generic/sbpi1_div_qr.c, mpn/generic/sub_n.c,
- mpn/generic/submul_1.c. */
-
-#include <assert.h>
-#include <ctype.h>
-#include <limits.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include "mini-gmp.h"
-
-
-/* Macros */
-#define GMP_LIMB_BITS (sizeof(mp_limb_t) * CHAR_BIT)
-
-#define GMP_LIMB_MAX (~ (mp_limb_t) 0)
-#define GMP_LIMB_HIGHBIT ((mp_limb_t) 1 << (GMP_LIMB_BITS - 1))
-
-#define GMP_HLIMB_BIT ((mp_limb_t) 1 << (GMP_LIMB_BITS / 2))
-#define GMP_LLIMB_MASK (GMP_HLIMB_BIT - 1)
-
-#define GMP_ULONG_BITS (sizeof(unsigned long) * CHAR_BIT)
-#define GMP_ULONG_HIGHBIT ((unsigned long) 1 << (GMP_ULONG_BITS - 1))
-
-#define GMP_ABS(x) ((x) >= 0 ? (x) : -(x))
-#define GMP_NEG_CAST(T,x) (-((T)((x) + 1) - 1))
-
-#define GMP_MIN(a, b) ((a) < (b) ? (a) : (b))
-#define GMP_MAX(a, b) ((a) > (b) ? (a) : (b))
-
-#define gmp_assert_nocarry(x) do { \
- mp_limb_t __cy = x; \
- assert (__cy == 0); \
- } while (0)
-
-#define gmp_clz(count, x) do { \
- mp_limb_t __clz_x = (x); \
- unsigned __clz_c; \
- for (__clz_c = 0; \
- (__clz_x & ((mp_limb_t) 0xff << (GMP_LIMB_BITS - 8))) == 0; \
- __clz_c += 8) \
- __clz_x <<= 8; \
- for (; (__clz_x & GMP_LIMB_HIGHBIT) == 0; __clz_c++) \
- __clz_x <<= 1; \
- (count) = __clz_c; \
- } while (0)
-
-#define gmp_ctz(count, x) do { \
- mp_limb_t __ctz_x = (x); \
- unsigned __ctz_c = 0; \
- gmp_clz (__ctz_c, __ctz_x & - __ctz_x); \
- (count) = GMP_LIMB_BITS - 1 - __ctz_c; \
- } while (0)
-
-#define gmp_add_ssaaaa(sh, sl, ah, al, bh, bl) \
- do { \
- mp_limb_t __x; \
- __x = (al) + (bl); \
- (sh) = (ah) + (bh) + (__x < (al)); \
- (sl) = __x; \
- } while (0)
-
-#define gmp_sub_ddmmss(sh, sl, ah, al, bh, bl) \
- do { \
- mp_limb_t __x; \
- __x = (al) - (bl); \
- (sh) = (ah) - (bh) - ((al) < (bl)); \
- (sl) = __x; \
- } while (0)
-
-#define gmp_umul_ppmm(w1, w0, u, v) \
- do { \
- mp_limb_t __x0, __x1, __x2, __x3; \
- unsigned __ul, __vl, __uh, __vh; \
- mp_limb_t __u = (u), __v = (v); \
- \
- __ul = __u & GMP_LLIMB_MASK; \
- __uh = __u >> (GMP_LIMB_BITS / 2); \
- __vl = __v & GMP_LLIMB_MASK; \
- __vh = __v >> (GMP_LIMB_BITS / 2); \
- \
- __x0 = (mp_limb_t) __ul * __vl; \
- __x1 = (mp_limb_t) __ul * __vh; \
- __x2 = (mp_limb_t) __uh * __vl; \
- __x3 = (mp_limb_t) __uh * __vh; \
- \
- __x1 += __x0 >> (GMP_LIMB_BITS / 2);/* this can't give carry */ \
- __x1 += __x2; /* but this indeed can */ \
- if (__x1 < __x2) /* did we get it? */ \
- __x3 += GMP_HLIMB_BIT; /* yes, add it in the proper pos. */ \
- \
- (w1) = __x3 + (__x1 >> (GMP_LIMB_BITS / 2)); \
- (w0) = (__x1 << (GMP_LIMB_BITS / 2)) + (__x0 & GMP_LLIMB_MASK); \
- } while (0)
-
-#define gmp_udiv_qrnnd_preinv(q, r, nh, nl, d, di) \
- do { \
- mp_limb_t _qh, _ql, _r, _mask; \
- gmp_umul_ppmm (_qh, _ql, (nh), (di)); \
- gmp_add_ssaaaa (_qh, _ql, _qh, _ql, (nh) + 1, (nl)); \
- _r = (nl) - _qh * (d); \
- _mask = -(mp_limb_t) (_r > _ql); /* both > and >= are OK */ \
- _qh += _mask; \
- _r += _mask & (d); \
- if (_r >= (d)) \
- { \
- _r -= (d); \
- _qh++; \
- } \
- \
- (r) = _r; \
- (q) = _qh; \
- } while (0)
-
-#define gmp_udiv_qr_3by2(q, r1, r0, n2, n1, n0, d1, d0, dinv) \
- do { \
- mp_limb_t _q0, _t1, _t0, _mask; \
- gmp_umul_ppmm ((q), _q0, (n2), (dinv)); \
- gmp_add_ssaaaa ((q), _q0, (q), _q0, (n2), (n1)); \
- \
- /* Compute the two most significant limbs of n - q'd */ \
- (r1) = (n1) - (d1) * (q); \
- gmp_sub_ddmmss ((r1), (r0), (r1), (n0), (d1), (d0)); \
- gmp_umul_ppmm (_t1, _t0, (d0), (q)); \
- gmp_sub_ddmmss ((r1), (r0), (r1), (r0), _t1, _t0); \
- (q)++; \
- \
- /* Conditionally adjust q and the remainders */ \
- _mask = - (mp_limb_t) ((r1) >= _q0); \
- (q) += _mask; \
- gmp_add_ssaaaa ((r1), (r0), (r1), (r0), _mask & (d1), _mask & (d0)); \
- if ((r1) >= (d1)) \
- { \
- if ((r1) > (d1) || (r0) >= (d0)) \
- { \
- (q)++; \
- gmp_sub_ddmmss ((r1), (r0), (r1), (r0), (d1), (d0)); \
- } \
- } \
- } while (0)
-
-/* Swap macros. */
-#define MP_LIMB_T_SWAP(x, y) \
- do { \
- mp_limb_t __mp_limb_t_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mp_limb_t_swap__tmp; \
- } while (0)
-#define MP_SIZE_T_SWAP(x, y) \
- do { \
- mp_size_t __mp_size_t_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mp_size_t_swap__tmp; \
- } while (0)
-#define MP_BITCNT_T_SWAP(x,y) \
- do { \
- mp_bitcnt_t __mp_bitcnt_t_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mp_bitcnt_t_swap__tmp; \
- } while (0)
-#define MP_PTR_SWAP(x, y) \
- do { \
- mp_ptr __mp_ptr_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mp_ptr_swap__tmp; \
- } while (0)
-#define MP_SRCPTR_SWAP(x, y) \
- do { \
- mp_srcptr __mp_srcptr_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mp_srcptr_swap__tmp; \
- } while (0)
-
-#define MPN_PTR_SWAP(xp,xs, yp,ys) \
- do { \
- MP_PTR_SWAP (xp, yp); \
- MP_SIZE_T_SWAP (xs, ys); \
- } while(0)
-#define MPN_SRCPTR_SWAP(xp,xs, yp,ys) \
- do { \
- MP_SRCPTR_SWAP (xp, yp); \
- MP_SIZE_T_SWAP (xs, ys); \
- } while(0)
-
-#define MPZ_PTR_SWAP(x, y) \
- do { \
- mpz_ptr __mpz_ptr_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mpz_ptr_swap__tmp; \
- } while (0)
-#define MPZ_SRCPTR_SWAP(x, y) \
- do { \
- mpz_srcptr __mpz_srcptr_swap__tmp = (x); \
- (x) = (y); \
- (y) = __mpz_srcptr_swap__tmp; \
- } while (0)
-
-static const int mp_bits_per_limb = GMP_LIMB_BITS;
-
-
-/* Memory allocation and other helper functions. */
-static void
-gmp_die (const char *msg)
-{
- fprintf (stderr, "%s\n", msg);
- abort();
-}
-
-static void *
-gmp_default_alloc (size_t size)
-{
- void *p;
-
- assert (size > 0);
-
- p = (void*)malloc(size);
- if (!p)
- gmp_die("gmp_default_alloc: Virtual memory exhausted.");
-
- return p;
-}
-
-static void *
-gmp_default_realloc (void *old, size_t old_size, size_t new_size)
-{
- void * p;
-
- p = realloc (old, new_size);
-
- if (!p)
- gmp_die("gmp_default_realloc: Virtual memory exhausted.");
-
- return p;
-}
-
-static void
-gmp_default_free (void *p, size_t size)
-{
- free (p);
-}
-
-static void * (*gmp_allocate_func) (size_t) = gmp_default_alloc;
-static void * (*gmp_reallocate_func) (void *, size_t, size_t) = gmp_default_realloc;
-static void (*gmp_free_func) (void *, size_t) = gmp_default_free;
-
-void
-mp_get_memory_functions (void *(**alloc_func) (size_t),
- void *(**realloc_func) (void *, size_t, size_t),
- void (**free_func) (void *, size_t))
-{
- if (alloc_func)
- *alloc_func = gmp_allocate_func;
-
- if (realloc_func)
- *realloc_func = gmp_reallocate_func;
-
- if (free_func)
- *free_func = gmp_free_func;
-}
-
-void
-mp_set_memory_functions (void *(*alloc_func) (size_t),
- void *(*realloc_func) (void *, size_t, size_t),
- void (*free_func) (void *, size_t))
-{
- if (!alloc_func)
- alloc_func = gmp_default_alloc;
- if (!realloc_func)
- realloc_func = gmp_default_realloc;
- if (!free_func)
- free_func = gmp_default_free;
-
- gmp_allocate_func = alloc_func;
- gmp_reallocate_func = realloc_func;
- gmp_free_func = free_func;
-}
-
-#define gmp_xalloc(size) ((*gmp_allocate_func)((size)))
-#define gmp_free(p) ((*gmp_free_func) ((p), 0))
-
-static mp_ptr
-gmp_xalloc_limbs (mp_size_t size)
-{
- return (mp_ptr) gmp_xalloc (size * sizeof (mp_limb_t));
-}
-
-static mp_ptr
-gmp_xrealloc_limbs (mp_ptr old, mp_size_t size)
-{
- assert (size > 0);
- return (mp_ptr) (*gmp_reallocate_func) (old, 0, size * sizeof (mp_limb_t));
-}
-
-
-/* MPN interface */
-
-void
-mpn_copyi (mp_ptr d, mp_srcptr s, mp_size_t n)
-{
- mp_size_t i;
- for (i = 0; i < n; i++)
- d[i] = s[i];
-}
-
-void
-mpn_copyd (mp_ptr d, mp_srcptr s, mp_size_t n)
-{
- while (--n >= 0)
- d[n] = s[n];
-}
-
-int
-mpn_cmp (mp_srcptr ap, mp_srcptr bp, mp_size_t n)
-{
- while (--n >= 0)
- {
- if (ap[n] != bp[n])
- return ap[n] > bp[n] ? 1 : -1;
- }
- return 0;
-}
-
-static int
-mpn_cmp4 (mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn)
-{
- if (an != bn)
- return an < bn ? -1 : 1;
- else
- return mpn_cmp (ap, bp, an);
-}
-
-static mp_size_t
-mpn_normalized_size (mp_srcptr xp, mp_size_t n)
-{
- while (n > 0 && xp[n-1] == 0)
- --n;
- return n;
-}
-
-int
-mpn_zero_p(mp_srcptr rp, mp_size_t n)
-{
- return mpn_normalized_size (rp, n) == 0;
-}
-
-void
-mpn_zero (mp_ptr rp, mp_size_t n)
-{
- while (--n >= 0)
- rp[n] = 0;
-}
-
-mp_limb_t
-mpn_add_1 (mp_ptr rp, mp_srcptr ap, mp_size_t n, mp_limb_t b)
-{
- mp_size_t i;
-
- assert (n > 0);
- i = 0;
- do
- {
- mp_limb_t r = ap[i] + b;
- /* Carry out */
- b = (r < b);
- rp[i] = r;
- }
- while (++i < n);
-
- return b;
-}
-
-mp_limb_t
-mpn_add_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n)
-{
- mp_size_t i;
- mp_limb_t cy;
-
- for (i = 0, cy = 0; i < n; i++)
- {
- mp_limb_t a, b, r;
- a = ap[i]; b = bp[i];
- r = a + cy;
- cy = (r < cy);
- r += b;
- cy += (r < b);
- rp[i] = r;
- }
- return cy;
-}
-
-mp_limb_t
-mpn_add (mp_ptr rp, mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn)
-{
- mp_limb_t cy;
-
- assert (an >= bn);
-
- cy = mpn_add_n (rp, ap, bp, bn);
- if (an > bn)
- cy = mpn_add_1 (rp + bn, ap + bn, an - bn, cy);
- return cy;
-}
-
-mp_limb_t
-mpn_sub_1 (mp_ptr rp, mp_srcptr ap, mp_size_t n, mp_limb_t b)
-{
- mp_size_t i;
-
- assert (n > 0);
-
- i = 0;
- do
- {
- mp_limb_t a = ap[i];
- /* Carry out */
- mp_limb_t cy = a < b;;
- rp[i] = a - b;
- b = cy;
- }
- while (++i < n);
-
- return b;
-}
-
-mp_limb_t
-mpn_sub_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n)
-{
- mp_size_t i;
- mp_limb_t cy;
-
- for (i = 0, cy = 0; i < n; i++)
- {
- mp_limb_t a, b;
- a = ap[i]; b = bp[i];
- b += cy;
- cy = (b < cy);
- cy += (a < b);
- rp[i] = a - b;
- }
- return cy;
-}
-
-mp_limb_t
-mpn_sub (mp_ptr rp, mp_srcptr ap, mp_size_t an, mp_srcptr bp, mp_size_t bn)
-{
- mp_limb_t cy;
-
- assert (an >= bn);
-
- cy = mpn_sub_n (rp, ap, bp, bn);
- if (an > bn)
- cy = mpn_sub_1 (rp + bn, ap + bn, an - bn, cy);
- return cy;
-}
-
-mp_limb_t
-mpn_mul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl)
-{
- mp_limb_t ul, cl, hpl, lpl;
-
- assert (n >= 1);
-
- cl = 0;
- do
- {
- ul = *up++;
- gmp_umul_ppmm (hpl, lpl, ul, vl);
-
- lpl += cl;
- cl = (lpl < cl) + hpl;
-
- *rp++ = lpl;
- }
- while (--n != 0);
-
- return cl;
-}
-
-mp_limb_t
-mpn_addmul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl)
-{
- mp_limb_t ul, cl, hpl, lpl, rl;
-
- assert (n >= 1);
-
- cl = 0;
- do
- {
- ul = *up++;
- gmp_umul_ppmm (hpl, lpl, ul, vl);
-
- lpl += cl;
- cl = (lpl < cl) + hpl;
-
- rl = *rp;
- lpl = rl + lpl;
- cl += lpl < rl;
- *rp++ = lpl;
- }
- while (--n != 0);
-
- return cl;
-}
-
-mp_limb_t
-mpn_submul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t vl)
-{
- mp_limb_t ul, cl, hpl, lpl, rl;
-
- assert (n >= 1);
-
- cl = 0;
- do
- {
- ul = *up++;
- gmp_umul_ppmm (hpl, lpl, ul, vl);
-
- lpl += cl;
- cl = (lpl < cl) + hpl;
-
- rl = *rp;
- lpl = rl - lpl;
- cl += lpl > rl;
- *rp++ = lpl;
- }
- while (--n != 0);
-
- return cl;
-}
-
-mp_limb_t
-mpn_mul (mp_ptr rp, mp_srcptr up, mp_size_t un, mp_srcptr vp, mp_size_t vn)
-{
- assert (un >= vn);
- assert (vn >= 1);
-
- /* We first multiply by the low order limb. This result can be
- stored, not added, to rp. We also avoid a loop for zeroing this
- way. */
-
- rp[un] = mpn_mul_1 (rp, up, un, vp[0]);
-
- /* Now accumulate the product of up[] and the next higher limb from
- vp[]. */
-
- while (--vn >= 1)
- {
- rp += 1, vp += 1;
- rp[un] = mpn_addmul_1 (rp, up, un, vp[0]);
- }
- return rp[un];
-}
-
-void
-mpn_mul_n (mp_ptr rp, mp_srcptr ap, mp_srcptr bp, mp_size_t n)
-{
- mpn_mul (rp, ap, n, bp, n);
-}
-
-void
-mpn_sqr (mp_ptr rp, mp_srcptr ap, mp_size_t n)
-{
- mpn_mul (rp, ap, n, ap, n);
-}
-
-mp_limb_t
-mpn_lshift (mp_ptr rp, mp_srcptr up, mp_size_t n, unsigned int cnt)
-{
- mp_limb_t high_limb, low_limb;
- unsigned int tnc;
- mp_limb_t retval;
-
- assert (n >= 1);
- assert (cnt >= 1);
- assert (cnt < GMP_LIMB_BITS);
-
- up += n;
- rp += n;
-
- tnc = GMP_LIMB_BITS - cnt;
- low_limb = *--up;
- retval = low_limb >> tnc;
- high_limb = (low_limb << cnt);
-
- while (--n != 0)
- {
- low_limb = *--up;
- *--rp = high_limb | (low_limb >> tnc);
- high_limb = (low_limb << cnt);
- }
- *--rp = high_limb;
-
- return retval;
-}
-
-mp_limb_t
-mpn_rshift (mp_ptr rp, mp_srcptr up, mp_size_t n, unsigned int cnt)
-{
- mp_limb_t high_limb, low_limb;
- unsigned int tnc;
- mp_limb_t retval;
-
- assert (n >= 1);
- assert (cnt >= 1);
- assert (cnt < GMP_LIMB_BITS);
-
- tnc = GMP_LIMB_BITS - cnt;
- high_limb = *up++;
- retval = (high_limb << tnc);
- low_limb = high_limb >> cnt;
-
- while (--n != 0)
- {
- high_limb = *up++;
- *rp++ = low_limb | (high_limb << tnc);
- low_limb = high_limb >> cnt;
- }
- *rp = low_limb;
-
- return retval;
-}
-
-static mp_bitcnt_t
-mpn_common_scan (mp_limb_t limb, mp_size_t i, mp_srcptr up, mp_size_t un,
- mp_limb_t ux)
-{
- unsigned cnt;
-
- assert (ux == 0 || ux == GMP_LIMB_MAX);
- assert (0 <= i && i <= un );
-
- while (limb == 0)
- {
- i++;
- if (i == un)
- return (ux == 0 ? ~(mp_bitcnt_t) 0 : un * GMP_LIMB_BITS);
- limb = ux ^ up[i];
- }
- gmp_ctz (cnt, limb);
- return (mp_bitcnt_t) i * GMP_LIMB_BITS + cnt;
-}
-
-mp_bitcnt_t
-mpn_scan1 (mp_srcptr ptr, mp_bitcnt_t bit)
-{
- mp_size_t i;
- i = bit / GMP_LIMB_BITS;
-
- return mpn_common_scan ( ptr[i] & (GMP_LIMB_MAX << (bit % GMP_LIMB_BITS)),
- i, ptr, i, 0);
-}
-
-mp_bitcnt_t
-mpn_scan0 (mp_srcptr ptr, mp_bitcnt_t bit)
-{
- mp_size_t i;
- i = bit / GMP_LIMB_BITS;
-
- return mpn_common_scan (~ptr[i] & (GMP_LIMB_MAX << (bit % GMP_LIMB_BITS)),
- i, ptr, i, GMP_LIMB_MAX);
-}
-
-
-/* MPN division interface. */
-mp_limb_t
-mpn_invert_3by2 (mp_limb_t u1, mp_limb_t u0)
-{
- mp_limb_t r, p, m;
- unsigned ul, uh;
- unsigned ql, qh;
-
- /* First, do a 2/1 inverse. */
- /* The inverse m is defined as floor( (B^2 - 1 - u1)/u1 ), so that 0 <
- * B^2 - (B + m) u1 <= u1 */
- assert (u1 >= GMP_LIMB_HIGHBIT);
-
- ul = u1 & GMP_LLIMB_MASK;
- uh = u1 >> (GMP_LIMB_BITS / 2);
-
- qh = ~u1 / uh;
- r = ((~u1 - (mp_limb_t) qh * uh) << (GMP_LIMB_BITS / 2)) | GMP_LLIMB_MASK;
-
- p = (mp_limb_t) qh * ul;
- /* Adjustment steps taken from udiv_qrnnd_c */
- if (r < p)
- {
- qh--;
- r += u1;
- if (r >= u1) /* i.e. we didn't get carry when adding to r */
- if (r < p)
- {
- qh--;
- r += u1;
- }
- }
- r -= p;
-
- /* Do a 3/2 division (with half limb size) */
- p = (r >> (GMP_LIMB_BITS / 2)) * qh + r;
- ql = (p >> (GMP_LIMB_BITS / 2)) + 1;
-
- /* By the 3/2 method, we don't need the high half limb. */
- r = (r << (GMP_LIMB_BITS / 2)) + GMP_LLIMB_MASK - ql * u1;
-
- if (r >= (p << (GMP_LIMB_BITS / 2)))
- {
- ql--;
- r += u1;
- }
- m = ((mp_limb_t) qh << (GMP_LIMB_BITS / 2)) + ql;
- if (r >= u1)
- {
- m++;
- r -= u1;
- }
-
- if (u0 > 0)
- {
- mp_limb_t th, tl;
- r = ~r;
- r += u0;
- if (r < u0)
- {
- m--;
- if (r >= u1)
- {
- m--;
- r -= u1;
- }
- r -= u1;
- }
- gmp_umul_ppmm (th, tl, u0, m);
- r += th;
- if (r < th)
- {
- m--;
- m -= ((r > u1) | ((r == u1) & (tl > u0)));
- }
- }
-
- return m;
-}
-
-struct gmp_div_inverse
-{
- /* Normalization shift count. */
- unsigned shift;
- /* Normalized divisor (d0 unused for mpn_div_qr_1) */
- mp_limb_t d1, d0;
- /* Inverse, for 2/1 or 3/2. */
- mp_limb_t di;
-};
-
-static void
-mpn_div_qr_1_invert (struct gmp_div_inverse *inv, mp_limb_t d)
-{
- unsigned shift;
-
- assert (d > 0);
- gmp_clz (shift, d);
- inv->shift = shift;
- inv->d1 = d << shift;
- inv->di = mpn_invert_limb (inv->d1);
-}
-
-static void
-mpn_div_qr_2_invert (struct gmp_div_inverse *inv,
- mp_limb_t d1, mp_limb_t d0)
-{
- unsigned shift;
-
- assert (d1 > 0);
- gmp_clz (shift, d1);
- inv->shift = shift;
- if (shift > 0)
- {
- d1 = (d1 << shift) | (d0 >> (GMP_LIMB_BITS - shift));
- d0 <<= shift;
- }
- inv->d1 = d1;
- inv->d0 = d0;
- inv->di = mpn_invert_3by2 (d1, d0);
-}
-
-static void
-mpn_div_qr_invert (struct gmp_div_inverse *inv,
- mp_srcptr dp, mp_size_t dn)
-{
- assert (dn > 0);
-
- if (dn == 1)
- mpn_div_qr_1_invert (inv, dp[0]);
- else if (dn == 2)
- mpn_div_qr_2_invert (inv, dp[1], dp[0]);
- else
- {
- unsigned shift;
- mp_limb_t d1, d0;
-
- d1 = dp[dn-1];
- d0 = dp[dn-2];
- assert (d1 > 0);
- gmp_clz (shift, d1);
- inv->shift = shift;
- if (shift > 0)
- {
- d1 = (d1 << shift) | (d0 >> (GMP_LIMB_BITS - shift));
- d0 = (d0 << shift) | (dp[dn-3] >> (GMP_LIMB_BITS - shift));
- }
- inv->d1 = d1;
- inv->d0 = d0;
- inv->di = mpn_invert_3by2 (d1, d0);
- }
-}
-
-/* Not matching current public gmp interface, rather corresponding to
- the sbpi1_div_* functions. */
-static mp_limb_t
-mpn_div_qr_1_preinv (mp_ptr qp, mp_srcptr np, mp_size_t nn,
- const struct gmp_div_inverse *inv)
-{
- mp_limb_t d, di;
- mp_limb_t r;
- mp_ptr tp = NULL;
-
- if (inv->shift > 0)
- {
- tp = gmp_xalloc_limbs (nn);
- r = mpn_lshift (tp, np, nn, inv->shift);
- np = tp;
- }
- else
- r = 0;
-
- d = inv->d1;
- di = inv->di;
- while (--nn >= 0)
- {
- mp_limb_t q;
-
- gmp_udiv_qrnnd_preinv (q, r, r, np[nn], d, di);
- if (qp)
- qp[nn] = q;
- }
- if (inv->shift > 0)
- gmp_free (tp);
-
- return r >> inv->shift;
-}
-
-static mp_limb_t
-mpn_div_qr_1 (mp_ptr qp, mp_srcptr np, mp_size_t nn, mp_limb_t d)
-{
- assert (d > 0);
-
- /* Special case for powers of two. */
- if ((d & (d-1)) == 0)
- {
- mp_limb_t r = np[0] & (d-1);
- if (qp)
- {
- if (d <= 1)
- mpn_copyi (qp, np, nn);
- else
- {
- unsigned shift;
- gmp_ctz (shift, d);
- mpn_rshift (qp, np, nn, shift);
- }
- }
- return r;
- }
- else
- {
- struct gmp_div_inverse inv;
- mpn_div_qr_1_invert (&inv, d);
- return mpn_div_qr_1_preinv (qp, np, nn, &inv);
- }
-}
-
-static void
-mpn_div_qr_2_preinv (mp_ptr qp, mp_ptr rp, mp_srcptr np, mp_size_t nn,
- const struct gmp_div_inverse *inv)
-{
- unsigned shift;
- mp_size_t i;
- mp_limb_t d1, d0, di, r1, r0;
- mp_ptr tp;
-
- assert (nn >= 2);
- shift = inv->shift;
- d1 = inv->d1;
- d0 = inv->d0;
- di = inv->di;
-
- if (shift > 0)
- {
- tp = gmp_xalloc_limbs (nn);
- r1 = mpn_lshift (tp, np, nn, shift);
- np = tp;
- }
- else
- r1 = 0;
-
- r0 = np[nn - 1];
-
- i = nn - 2;
- do
- {
- mp_limb_t n0, q;
- n0 = np[i];
- gmp_udiv_qr_3by2 (q, r1, r0, r1, r0, n0, d1, d0, di);
-
- if (qp)
- qp[i] = q;
- }
- while (--i >= 0);
-
- if (shift > 0)
- {
- assert ((r0 << (GMP_LIMB_BITS - shift)) == 0);
- r0 = (r0 >> shift) | (r1 << (GMP_LIMB_BITS - shift));
- r1 >>= shift;
-
- gmp_free (tp);
- }
-
- rp[1] = r1;
- rp[0] = r0;
-}
-
-#if 0
-static void
-mpn_div_qr_2 (mp_ptr qp, mp_ptr rp, mp_srcptr np, mp_size_t nn,
- mp_limb_t d1, mp_limb_t d0)
-{
- struct gmp_div_inverse inv;
- assert (nn >= 2);
-
- mpn_div_qr_2_invert (&inv, d1, d0);
- mpn_div_qr_2_preinv (qp, rp, np, nn, &inv);
-}
-#endif
-
-static void
-mpn_div_qr_pi1 (mp_ptr qp,
- mp_ptr np, mp_size_t nn, mp_limb_t n1,
- mp_srcptr dp, mp_size_t dn,
- mp_limb_t dinv)
-{
- mp_size_t i;
-
- mp_limb_t d1, d0;
- mp_limb_t cy, cy1;
- mp_limb_t q;
-
- assert (dn > 2);
- assert (nn >= dn);
-
- d1 = dp[dn - 1];
- d0 = dp[dn - 2];
-
- assert ((d1 & GMP_LIMB_HIGHBIT) != 0);
- /* Iteration variable is the index of the q limb.
- *
- * We divide <n1, np[dn-1+i], np[dn-2+i], np[dn-3+i],..., np[i]>
- * by <d1, d0, dp[dn-3], ..., dp[0] >
- */
-
- i = nn - dn;
- do
- {
- mp_limb_t n0 = np[dn-1+i];
-
- if (n1 == d1 && n0 == d0)
- {
- q = GMP_LIMB_MAX;
- mpn_submul_1 (np+i, dp, dn, q);
- n1 = np[dn-1+i]; /* update n1, last loop's value will now be invalid */
- }
- else
- {
- gmp_udiv_qr_3by2 (q, n1, n0, n1, n0, np[dn-2+i], d1, d0, dinv);
-
- cy = mpn_submul_1 (np + i, dp, dn-2, q);
-
- cy1 = n0 < cy;
- n0 = n0 - cy;
- cy = n1 < cy1;
- n1 = n1 - cy1;
- np[dn-2+i] = n0;
-
- if (cy != 0)
- {
- n1 += d1 + mpn_add_n (np + i, np + i, dp, dn - 1);
- q--;
- }
- }
-
- if (qp)
- qp[i] = q;
- }
- while (--i >= 0);
-
- np[dn - 1] = n1;
-}
-
-static void
-mpn_div_qr_preinv (mp_ptr qp, mp_ptr np, mp_size_t nn,
- mp_srcptr dp, mp_size_t dn,
- const struct gmp_div_inverse *inv)
-{
- assert (dn > 0);
- assert (nn >= dn);
-
- if (dn == 1)
- np[0] = mpn_div_qr_1_preinv (qp, np, nn, inv);
- else if (dn == 2)
- mpn_div_qr_2_preinv (qp, np, np, nn, inv);
- else
- {
- mp_limb_t nh;
- unsigned shift;
-
- assert (inv->d1 == dp[dn-1]);
- assert (inv->d0 == dp[dn-2]);
- assert ((inv->d1 & GMP_LIMB_HIGHBIT) != 0);
-
- shift = inv->shift;
- if (shift > 0)
- nh = mpn_lshift (np, np, nn, shift);
- else
- nh = 0;
-
- mpn_div_qr_pi1 (qp, np, nn, nh, dp, dn, inv->di);
-
- if (shift > 0)
- gmp_assert_nocarry (mpn_rshift (np, np, dn, shift));
- }
-}
-
-static void
-mpn_div_qr (mp_ptr qp, mp_ptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn)
-{
- struct gmp_div_inverse inv;
- mp_ptr tp = NULL;
-
- assert (dn > 0);
- assert (nn >= dn);
-
- mpn_div_qr_invert (&inv, dp, dn);
- if (dn > 2 && inv.shift > 0)
- {
- tp = gmp_xalloc_limbs (dn);
- gmp_assert_nocarry (mpn_lshift (tp, dp, dn, inv.shift));
- dp = tp;
- }
- mpn_div_qr_preinv (qp, np, nn, dp, dn, &inv);
- if (tp)
- gmp_free (tp);
-}
-
-
-/* MPN base conversion. */
-static unsigned
-mpn_base_power_of_two_p (unsigned b)
-{
- switch (b)
- {
- case 2: return 1;
- case 4: return 2;
- case 8: return 3;
- case 16: return 4;
- case 32: return 5;
- case 64: return 6;
- case 128: return 7;
- case 256: return 8;
- default: return 0;
- }
-}
-
-struct mpn_base_info
-{
- /* bb is the largest power of the base which fits in one limb, and
- exp is the corresponding exponent. */
- unsigned exp;
- mp_limb_t bb;
-};
-
-static void
-mpn_get_base_info (struct mpn_base_info *info, mp_limb_t b)
-{
- mp_limb_t m;
- mp_limb_t p;
- unsigned exp;
-
- m = GMP_LIMB_MAX / b;
- for (exp = 1, p = b; p <= m; exp++)
- p *= b;
-
- info->exp = exp;
- info->bb = p;
-}
-
-static mp_bitcnt_t
-mpn_limb_size_in_base_2 (mp_limb_t u)
-{
- unsigned shift;
-
- assert (u > 0);
- gmp_clz (shift, u);
- return GMP_LIMB_BITS - shift;
-}
-
-static size_t
-mpn_get_str_bits (unsigned char *sp, unsigned bits, mp_srcptr up, mp_size_t un)
-{
- unsigned char mask;
- size_t sn, j;
- mp_size_t i;
- int shift;
-
- sn = ((un - 1) * GMP_LIMB_BITS + mpn_limb_size_in_base_2 (up[un-1])
- + bits - 1) / bits;
-
- mask = (1U << bits) - 1;
-
- for (i = 0, j = sn, shift = 0; j-- > 0;)
- {
- unsigned char digit = up[i] >> shift;
-
- shift += bits;
-
- if (shift >= GMP_LIMB_BITS && ++i < un)
- {
- shift -= GMP_LIMB_BITS;
- digit |= up[i] << (bits - shift);
- }
- sp[j] = digit & mask;
- }
- return sn;
-}
-
-/* We generate digits from the least significant end, and reverse at
- the end. */
-static size_t
-mpn_limb_get_str (unsigned char *sp, mp_limb_t w,
- const struct gmp_div_inverse *binv)
-{
- mp_size_t i;
- for (i = 0; w > 0; i++)
- {
- mp_limb_t h, l, r;
-
- h = w >> (GMP_LIMB_BITS - binv->shift);
- l = w << binv->shift;
-
- gmp_udiv_qrnnd_preinv (w, r, h, l, binv->d1, binv->di);
- assert ( (r << (GMP_LIMB_BITS - binv->shift)) == 0);
- r >>= binv->shift;
-
- sp[i] = r;
- }
- return i;
-}
-
-static size_t
-mpn_get_str_other (unsigned char *sp,
- int base, const struct mpn_base_info *info,
- mp_ptr up, mp_size_t un)
-{
- struct gmp_div_inverse binv;
- size_t sn;
- size_t i;
-
- mpn_div_qr_1_invert (&binv, base);
-
- sn = 0;
-
- if (un > 1)
- {
- struct gmp_div_inverse bbinv;
- mpn_div_qr_1_invert (&bbinv, info->bb);
-
- do
- {
- mp_limb_t w;
- size_t done;
- w = mpn_div_qr_1_preinv (up, up, un, &bbinv);
- un -= (up[un-1] == 0);
- done = mpn_limb_get_str (sp + sn, w, &binv);
-
- for (sn += done; done < info->exp; done++)
- sp[sn++] = 0;
- }
- while (un > 1);
- }
- sn += mpn_limb_get_str (sp + sn, up[0], &binv);
-
- /* Reverse order */
- for (i = 0; 2*i + 1 < sn; i++)
- {
- unsigned char t = sp[i];
- sp[i] = sp[sn - i - 1];
- sp[sn - i - 1] = t;
- }
-
- return sn;
-}
-
-size_t
-mpn_get_str (unsigned char *sp, int base, mp_ptr up, mp_size_t un)
-{
- unsigned bits;
-
- assert (un > 0);
- assert (up[un-1] > 0);
-
- bits = mpn_base_power_of_two_p (base);
- if (bits)
- return mpn_get_str_bits (sp, bits, up, un);
- else
- {
- struct mpn_base_info info;
-
- mpn_get_base_info (&info, base);
- return mpn_get_str_other (sp, base, &info, up, un);
- }
-}
-
-static mp_size_t
-mpn_set_str_bits (mp_ptr rp, const unsigned char *sp, size_t sn,
- unsigned bits)
-{
- mp_size_t rn;
- size_t j;
- unsigned shift;
-
- for (j = sn, rn = 0, shift = 0; j-- > 0; )
- {
- if (shift == 0)
- {
- rp[rn++] = sp[j];
- shift += bits;
- }
- else
- {
- rp[rn-1] |= (mp_limb_t) sp[j] << shift;
- shift += bits;
- if (shift >= GMP_LIMB_BITS)
- {
- shift -= GMP_LIMB_BITS;
- if (shift > 0)
- rp[rn++] = (mp_limb_t) sp[j] >> (bits - shift);
- }
- }
- }
- rn = mpn_normalized_size (rp, rn);
- return rn;
-}
-
-static mp_size_t
-mpn_set_str_other (mp_ptr rp, const unsigned char *sp, size_t sn,
- mp_limb_t b, const struct mpn_base_info *info)
-{
- mp_size_t rn;
- mp_limb_t w;
- unsigned k;
- size_t j;
-
- k = 1 + (sn - 1) % info->exp;
-
- j = 0;
- w = sp[j++];
- while (--k != 0)
- w = w * b + sp[j++];
-
- rp[0] = w;
-
- for (rn = (w > 0); j < sn;)
- {
- mp_limb_t cy;
-
- w = sp[j++];
- for (k = 1; k < info->exp; k++)
- w = w * b + sp[j++];
-
- cy = mpn_mul_1 (rp, rp, rn, info->bb);
- cy += mpn_add_1 (rp, rp, rn, w);
- if (cy > 0)
- rp[rn++] = cy;
- }
- assert (j == sn);
-
- return rn;
-}
-
-mp_size_t
-mpn_set_str (mp_ptr rp, const unsigned char *sp, size_t sn, int base)
-{
- unsigned bits;
-
- if (sn == 0)
- return 0;
-
- bits = mpn_base_power_of_two_p (base);
- if (bits)
- return mpn_set_str_bits (rp, sp, sn, bits);
- else
- {
- struct mpn_base_info info;
-
- mpn_get_base_info (&info, base);
- return mpn_set_str_other (rp, sp, sn, base, &info);
- }
-}
-
-
-/* MPZ interface */
-void
-mpz_init (mpz_t r)
-{
- r->_mp_alloc = 1;
- r->_mp_size = 0;
- r->_mp_d = gmp_xalloc_limbs (1);
-}
-
-/* The utility of this function is a bit limited, since many functions
- assigns the result variable using mpz_swap. */
-void
-mpz_init2 (mpz_t r, mp_bitcnt_t bits)
-{
- mp_size_t rn;
-
- bits -= (bits != 0); /* Round down, except if 0 */
- rn = 1 + bits / GMP_LIMB_BITS;
-
- r->_mp_alloc = rn;
- r->_mp_size = 0;
- r->_mp_d = gmp_xalloc_limbs (rn);
-}
-
-void
-mpz_clear (mpz_t r)
-{
- gmp_free (r->_mp_d);
-}
-
-static mp_ptr
-mpz_realloc (mpz_t r, mp_size_t size)
-{
- size = GMP_MAX (size, 1);
-
- r->_mp_d = gmp_xrealloc_limbs (r->_mp_d, size);
- r->_mp_alloc = size;
-
- if (GMP_ABS (r->_mp_size) > size)
- r->_mp_size = 0;
-
- return r->_mp_d;
-}
-
-/* Realloc for an mpz_t WHAT if it has less than NEEDED limbs. */
-#define MPZ_REALLOC(z,n) ((n) > (z)->_mp_alloc \
- ? mpz_realloc(z,n) \
- : (z)->_mp_d)
-
-/* MPZ assignment and basic conversions. */
-void
-mpz_set_si (mpz_t r, signed long int x)
-{
- if (x >= 0)
- mpz_set_ui (r, x);
- else /* (x < 0) */
- {
- r->_mp_size = -1;
- r->_mp_d[0] = GMP_NEG_CAST (unsigned long int, x);
- }
-}
-
-void
-mpz_set_ui (mpz_t r, unsigned long int x)
-{
- if (x > 0)
- {
- r->_mp_size = 1;
- r->_mp_d[0] = x;
- }
- else
- r->_mp_size = 0;
-}
-
-void
-mpz_set (mpz_t r, const mpz_t x)
-{
- /* Allow the NOP r == x */
- if (r != x)
- {
- mp_size_t n;
- mp_ptr rp;
-
- n = GMP_ABS (x->_mp_size);
- rp = MPZ_REALLOC (r, n);
-
- mpn_copyi (rp, x->_mp_d, n);
- r->_mp_size = x->_mp_size;
- }
-}
-
-void
-mpz_init_set_si (mpz_t r, signed long int x)
-{
- mpz_init (r);
- mpz_set_si (r, x);
-}
-
-void
-mpz_init_set_ui (mpz_t r, unsigned long int x)
-{
- mpz_init (r);
- mpz_set_ui (r, x);
-}
-
-void
-mpz_init_set (mpz_t r, const mpz_t x)
-{
- mpz_init (r);
- mpz_set (r, x);
-}
-
-int
-mpz_fits_slong_p (const mpz_t u)
-{
- mp_size_t us = u->_mp_size;
-
- if (us == 1)
- return u->_mp_d[0] < GMP_LIMB_HIGHBIT;
- else if (us == -1)
- return u->_mp_d[0] <= GMP_LIMB_HIGHBIT;
- else
- return (us == 0);
-}
-
-int
-mpz_fits_ulong_p (const mpz_t u)
-{
- mp_size_t us = u->_mp_size;
-
- return (us == (us > 0));
-}
-
-long int
-mpz_get_si (const mpz_t u)
-{
- mp_size_t us = u->_mp_size;
-
- if (us > 0)
- return (long) (u->_mp_d[0] & ~GMP_LIMB_HIGHBIT);
- else if (us < 0)
- return (long) (- u->_mp_d[0] | GMP_LIMB_HIGHBIT);
- else
- return 0;
-}
-
-unsigned long int
-mpz_get_ui (const mpz_t u)
-{
- return u->_mp_size == 0 ? 0 : u->_mp_d[0];
-}
-
-size_t
-mpz_size (const mpz_t u)
-{
- return GMP_ABS (u->_mp_size);
-}
-
-mp_limb_t
-mpz_getlimbn (const mpz_t u, mp_size_t n)
-{
- if (n >= 0 && n < GMP_ABS (u->_mp_size))
- return u->_mp_d[n];
- else
- return 0;
-}
-
-void
-mpz_realloc2 (mpz_t x, mp_bitcnt_t n)
-{
- mpz_realloc (x, 1 + (n - (n != 0)) / GMP_LIMB_BITS);
-}
-
-mp_srcptr
-mpz_limbs_read (mpz_srcptr x)
-{
- return x->_mp_d;;
-}
-
-mp_ptr
-mpz_limbs_modify (mpz_t x, mp_size_t n)
-{
- assert (n > 0);
- return MPZ_REALLOC (x, n);
-}
-
-mp_ptr
-mpz_limbs_write (mpz_t x, mp_size_t n)
-{
- return mpz_limbs_modify (x, n);
-}
-
-void
-mpz_limbs_finish (mpz_t x, mp_size_t xs)
-{
- mp_size_t xn;
- xn = mpn_normalized_size (x->_mp_d, GMP_ABS (xs));
- x->_mp_size = xs < 0 ? -xn : xn;
-}
-
-mpz_srcptr
-mpz_roinit_n (mpz_t x, mp_srcptr xp, mp_size_t xs)
-{
- x->_mp_alloc = 0;
- x->_mp_d = (mp_ptr) xp;
- mpz_limbs_finish (x, xs);
- return x;
-}
-
-
-/* Conversions and comparison to double. */
-void
-mpz_set_d (mpz_t r, double x)
-{
- int sign;
- mp_ptr rp;
- mp_size_t rn, i;
- double B;
- double Bi;
- mp_limb_t f;
-
- /* x != x is true when x is a NaN, and x == x * 0.5 is true when x is
- zero or infinity. */
- if (x != x || x == x * 0.5)
- {
- r->_mp_size = 0;
- return;
- }
-
- sign = x < 0.0 ;
- if (sign)
- x = - x;
-
- if (x < 1.0)
- {
- r->_mp_size = 0;
- return;
- }
- B = 2.0 * (double) GMP_LIMB_HIGHBIT;
- Bi = 1.0 / B;
- for (rn = 1; x >= B; rn++)
- x *= Bi;
-
- rp = MPZ_REALLOC (r, rn);
-
- f = (mp_limb_t) x;
- x -= f;
- assert (x < 1.0);
- i = rn-1;
- rp[i] = f;
- while (--i >= 0)
- {
- x = B * x;
- f = (mp_limb_t) x;
- x -= f;
- assert (x < 1.0);
- rp[i] = f;
- }
-
- r->_mp_size = sign ? - rn : rn;
-}
-
-void
-mpz_init_set_d (mpz_t r, double x)
-{
- mpz_init (r);
- mpz_set_d (r, x);
-}
-
-double
-mpz_get_d (const mpz_t u)
-{
- mp_size_t un;
- double x;
- double B = 2.0 * (double) GMP_LIMB_HIGHBIT;
-
- un = GMP_ABS (u->_mp_size);
-
- if (un == 0)
- return 0.0;
-
- x = u->_mp_d[--un];
- while (un > 0)
- x = B*x + u->_mp_d[--un];
-
- if (u->_mp_size < 0)
- x = -x;
-
- return x;
-}
-
-int
-mpz_cmpabs_d (const mpz_t x, double d)
-{
- mp_size_t xn;
- double B, Bi;
- mp_size_t i;
-
- xn = x->_mp_size;
- d = GMP_ABS (d);
-
- if (xn != 0)
- {
- xn = GMP_ABS (xn);
-
- B = 2.0 * (double) GMP_LIMB_HIGHBIT;
- Bi = 1.0 / B;
-
- /* Scale d so it can be compared with the top limb. */
- for (i = 1; i < xn; i++)
- d *= Bi;
-
- if (d >= B)
- return -1;
-
- /* Compare floor(d) to top limb, subtract and cancel when equal. */
- for (i = xn; i-- > 0;)
- {
- mp_limb_t f, xl;
-
- f = (mp_limb_t) d;
- xl = x->_mp_d[i];
- if (xl > f)
- return 1;
- else if (xl < f)
- return -1;
- d = B * (d - f);
- }
- }
- return - (d > 0.0);
-}
-
-int
-mpz_cmp_d (const mpz_t x, double d)
-{
- if (x->_mp_size < 0)
- {
- if (d >= 0.0)
- return -1;
- else
- return -mpz_cmpabs_d (x, d);
- }
- else
- {
- if (d < 0.0)
- return 1;
- else
- return mpz_cmpabs_d (x, d);
- }
-}
-
-
-/* MPZ comparisons and the like. */
-int
-mpz_sgn (const mpz_t u)
-{
- mp_size_t usize = u->_mp_size;
-
- return (usize > 0) - (usize < 0);
-}
-
-int
-mpz_cmp_si (const mpz_t u, long v)
-{
- mp_size_t usize = u->_mp_size;
-
- if (usize < -1)
- return -1;
- else if (v >= 0)
- return mpz_cmp_ui (u, v);
- else if (usize >= 0)
- return 1;
- else /* usize == -1 */
- {
- mp_limb_t ul = u->_mp_d[0];
- if ((mp_limb_t)GMP_NEG_CAST (unsigned long int, v) < ul)
- return -1;
- else
- return (mp_limb_t)GMP_NEG_CAST (unsigned long int, v) > ul;
- }
-}
-
-int
-mpz_cmp_ui (const mpz_t u, unsigned long v)
-{
- mp_size_t usize = u->_mp_size;
-
- if (usize > 1)
- return 1;
- else if (usize < 0)
- return -1;
- else
- {
- mp_limb_t ul = (usize > 0) ? u->_mp_d[0] : 0;
- return (ul > v) - (ul < v);
- }
-}
-
-int
-mpz_cmp (const mpz_t a, const mpz_t b)
-{
- mp_size_t asize = a->_mp_size;
- mp_size_t bsize = b->_mp_size;
-
- if (asize != bsize)
- return (asize < bsize) ? -1 : 1;
- else if (asize >= 0)
- return mpn_cmp (a->_mp_d, b->_mp_d, asize);
- else
- return mpn_cmp (b->_mp_d, a->_mp_d, -asize);
-}
-
-int
-mpz_cmpabs_ui (const mpz_t u, unsigned long v)
-{
- mp_size_t un = GMP_ABS (u->_mp_size);
- mp_limb_t ul;
-
- if (un > 1)
- return 1;
-
- ul = (un == 1) ? u->_mp_d[0] : 0;
-
- return (ul > v) - (ul < v);
-}
-
-int
-mpz_cmpabs (const mpz_t u, const mpz_t v)
-{
- return mpn_cmp4 (u->_mp_d, GMP_ABS (u->_mp_size),
- v->_mp_d, GMP_ABS (v->_mp_size));
-}
-
-void
-mpz_abs (mpz_t r, const mpz_t u)
-{
- mpz_set (r, u);
- r->_mp_size = GMP_ABS (r->_mp_size);
-}
-
-void
-mpz_neg (mpz_t r, const mpz_t u)
-{
- mpz_set (r, u);
- r->_mp_size = -r->_mp_size;
-}
-
-void
-mpz_swap (mpz_t u, mpz_t v)
-{
- MP_SIZE_T_SWAP (u->_mp_size, v->_mp_size);
- MP_SIZE_T_SWAP (u->_mp_alloc, v->_mp_alloc);
- MP_PTR_SWAP (u->_mp_d, v->_mp_d);
-}
-
-
-/* MPZ addition and subtraction */
-
-/* Adds to the absolute value. Returns new size, but doesn't store it. */
-static mp_size_t
-mpz_abs_add_ui (mpz_t r, const mpz_t a, unsigned long b)
-{
- mp_size_t an;
- mp_ptr rp;
- mp_limb_t cy;
-
- an = GMP_ABS (a->_mp_size);
- if (an == 0)
- {
- r->_mp_d[0] = b;
- return b > 0;
- }
-
- rp = MPZ_REALLOC (r, an + 1);
-
- cy = mpn_add_1 (rp, a->_mp_d, an, b);
- rp[an] = cy;
- an += cy;
-
- return an;
-}
-
-/* Subtract from the absolute value. Returns new size, (or -1 on underflow),
- but doesn't store it. */
-static mp_size_t
-mpz_abs_sub_ui (mpz_t r, const mpz_t a, unsigned long b)
-{
- mp_size_t an = GMP_ABS (a->_mp_size);
- mp_ptr rp = MPZ_REALLOC (r, an);
-
- if (an == 0)
- {
- rp[0] = b;
- return -(b > 0);
- }
- else if (an == 1 && a->_mp_d[0] < b)
- {
- rp[0] = b - a->_mp_d[0];
- return -1;
- }
- else
- {
- gmp_assert_nocarry (mpn_sub_1 (rp, a->_mp_d, an, b));
- return mpn_normalized_size (rp, an);
- }
-}
-
-void
-mpz_add_ui (mpz_t r, const mpz_t a, unsigned long b)
-{
- if (a->_mp_size >= 0)
- r->_mp_size = mpz_abs_add_ui (r, a, b);
- else
- r->_mp_size = -mpz_abs_sub_ui (r, a, b);
-}
-
-void
-mpz_sub_ui (mpz_t r, const mpz_t a, unsigned long b)
-{
- if (a->_mp_size < 0)
- r->_mp_size = -mpz_abs_add_ui (r, a, b);
- else
- r->_mp_size = mpz_abs_sub_ui (r, a, b);
-}
-
-void
-mpz_ui_sub (mpz_t r, unsigned long a, const mpz_t b)
-{
- if (b->_mp_size < 0)
- r->_mp_size = mpz_abs_add_ui (r, b, a);
- else
- r->_mp_size = -mpz_abs_sub_ui (r, b, a);
-}
-
-static mp_size_t
-mpz_abs_add (mpz_t r, const mpz_t a, const mpz_t b)
-{
- mp_size_t an = GMP_ABS (a->_mp_size);
- mp_size_t bn = GMP_ABS (b->_mp_size);
- mp_ptr rp;
- mp_limb_t cy;
-
- if (an < bn)
- {
- MPZ_SRCPTR_SWAP (a, b);
- MP_SIZE_T_SWAP (an, bn);
- }
-
- rp = MPZ_REALLOC (r, an + 1);
- cy = mpn_add (rp, a->_mp_d, an, b->_mp_d, bn);
-
- rp[an] = cy;
-
- return an + cy;
-}
-
-static mp_size_t
-mpz_abs_sub (mpz_t r, const mpz_t a, const mpz_t b)
-{
- mp_size_t an = GMP_ABS (a->_mp_size);
- mp_size_t bn = GMP_ABS (b->_mp_size);
- int cmp;
- mp_ptr rp;
-
- cmp = mpn_cmp4 (a->_mp_d, an, b->_mp_d, bn);
- if (cmp > 0)
- {
- rp = MPZ_REALLOC (r, an);
- gmp_assert_nocarry (mpn_sub (rp, a->_mp_d, an, b->_mp_d, bn));
- return mpn_normalized_size (rp, an);
- }
- else if (cmp < 0)
- {
- rp = MPZ_REALLOC (r, bn);
- gmp_assert_nocarry (mpn_sub (rp, b->_mp_d, bn, a->_mp_d, an));
- return -mpn_normalized_size (rp, bn);
- }
- else
- return 0;
-}
-
-void
-mpz_add (mpz_t r, const mpz_t a, const mpz_t b)
-{
- mp_size_t rn;
-
- if ( (a->_mp_size ^ b->_mp_size) >= 0)
- rn = mpz_abs_add (r, a, b);
- else
- rn = mpz_abs_sub (r, a, b);
-
- r->_mp_size = a->_mp_size >= 0 ? rn : - rn;
-}
-
-void
-mpz_sub (mpz_t r, const mpz_t a, const mpz_t b)
-{
- mp_size_t rn;
-
- if ( (a->_mp_size ^ b->_mp_size) >= 0)
- rn = mpz_abs_sub (r, a, b);
- else
- rn = mpz_abs_add (r, a, b);
-
- r->_mp_size = a->_mp_size >= 0 ? rn : - rn;
-}
-
-
-/* MPZ multiplication */
-void
-mpz_mul_si (mpz_t r, const mpz_t u, long int v)
-{
- if (v < 0)
- {
- mpz_mul_ui (r, u, GMP_NEG_CAST (unsigned long int, v));
- mpz_neg (r, r);
- }
- else
- mpz_mul_ui (r, u, (unsigned long int) v);
-}
-
-void
-mpz_mul_ui (mpz_t r, const mpz_t u, unsigned long int v)
-{
- mp_size_t un, us;
- mp_ptr tp;
- mp_limb_t cy;
-
- us = u->_mp_size;
-
- if (us == 0 || v == 0)
- {
- r->_mp_size = 0;
- return;
- }
-
- un = GMP_ABS (us);
-
- tp = MPZ_REALLOC (r, un + 1);
- cy = mpn_mul_1 (tp, u->_mp_d, un, v);
- tp[un] = cy;
-
- un += (cy > 0);
- r->_mp_size = (us < 0) ? - un : un;
-}
-
-void
-mpz_mul (mpz_t r, const mpz_t u, const mpz_t v)
-{
- int sign;
- mp_size_t un, vn, rn;
- mpz_t t;
- mp_ptr tp;
-
- un = u->_mp_size;
- vn = v->_mp_size;
-
- if (un == 0 || vn == 0)
- {
- r->_mp_size = 0;
- return;
- }
-
- sign = (un ^ vn) < 0;
-
- un = GMP_ABS (un);
- vn = GMP_ABS (vn);
-
- mpz_init2 (t, (un + vn) * GMP_LIMB_BITS);
-
- tp = t->_mp_d;
- if (un >= vn)
- mpn_mul (tp, u->_mp_d, un, v->_mp_d, vn);
- else
- mpn_mul (tp, v->_mp_d, vn, u->_mp_d, un);
-
- rn = un + vn;
- rn -= tp[rn-1] == 0;
-
- t->_mp_size = sign ? - rn : rn;
- mpz_swap (r, t);
- mpz_clear (t);
-}
-
-void
-mpz_mul_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bits)
-{
- mp_size_t un, rn;
- mp_size_t limbs;
- unsigned shift;
- mp_ptr rp;
-
- un = GMP_ABS (u->_mp_size);
- if (un == 0)
- {
- r->_mp_size = 0;
- return;
- }
-
- limbs = bits / GMP_LIMB_BITS;
- shift = bits % GMP_LIMB_BITS;
-
- rn = un + limbs + (shift > 0);
- rp = MPZ_REALLOC (r, rn);
- if (shift > 0)
- {
- mp_limb_t cy = mpn_lshift (rp + limbs, u->_mp_d, un, shift);
- rp[rn-1] = cy;
- rn -= (cy == 0);
- }
- else
- mpn_copyd (rp + limbs, u->_mp_d, un);
-
- mpn_zero (rp, limbs);
-
- r->_mp_size = (u->_mp_size < 0) ? - rn : rn;
-}
-
-void
-mpz_addmul_ui (mpz_t r, const mpz_t u, unsigned long int v)
-{
- mpz_t t;
- mpz_init (t);
- mpz_mul_ui (t, u, v);
- mpz_add (r, r, t);
- mpz_clear (t);
-}
-
-void
-mpz_submul_ui (mpz_t r, const mpz_t u, unsigned long int v)
-{
- mpz_t t;
- mpz_init (t);
- mpz_mul_ui (t, u, v);
- mpz_sub (r, r, t);
- mpz_clear (t);
-}
-
-void
-mpz_addmul (mpz_t r, const mpz_t u, const mpz_t v)
-{
- mpz_t t;
- mpz_init (t);
- mpz_mul (t, u, v);
- mpz_add (r, r, t);
- mpz_clear (t);
-}
-
-void
-mpz_submul (mpz_t r, const mpz_t u, const mpz_t v)
-{
- mpz_t t;
- mpz_init (t);
- mpz_mul (t, u, v);
- mpz_sub (r, r, t);
- mpz_clear (t);
-}
-
-
-/* MPZ division */
-enum mpz_div_round_mode { GMP_DIV_FLOOR, GMP_DIV_CEIL, GMP_DIV_TRUNC };
-
-/* Allows q or r to be zero. Returns 1 iff remainder is non-zero. */
-static int
-mpz_div_qr (mpz_t q, mpz_t r,
- const mpz_t n, const mpz_t d, enum mpz_div_round_mode mode)
-{
- mp_size_t ns, ds, nn, dn, qs;
- ns = n->_mp_size;
- ds = d->_mp_size;
-
- if (ds == 0)
- gmp_die("mpz_div_qr: Divide by zero.");
-
- if (ns == 0)
- {
- if (q)
- q->_mp_size = 0;
- if (r)
- r->_mp_size = 0;
- return 0;
- }
-
- nn = GMP_ABS (ns);
- dn = GMP_ABS (ds);
-
- qs = ds ^ ns;
-
- if (nn < dn)
- {
- if (mode == GMP_DIV_CEIL && qs >= 0)
- {
- /* q = 1, r = n - d */
- if (r)
- mpz_sub (r, n, d);
- if (q)
- mpz_set_ui (q, 1);
- }
- else if (mode == GMP_DIV_FLOOR && qs < 0)
- {
- /* q = -1, r = n + d */
- if (r)
- mpz_add (r, n, d);
- if (q)
- mpz_set_si (q, -1);
- }
- else
- {
- /* q = 0, r = d */
- if (r)
- mpz_set (r, n);
- if (q)
- q->_mp_size = 0;
- }
- return 1;
- }
- else
- {
- mp_ptr np, qp;
- mp_size_t qn, rn;
- mpz_t tq, tr;
-
- mpz_init_set (tr, n);
- np = tr->_mp_d;
-
- qn = nn - dn + 1;
-
- if (q)
- {
- mpz_init2 (tq, qn * GMP_LIMB_BITS);
- qp = tq->_mp_d;
- }
- else
- qp = NULL;
-
- mpn_div_qr (qp, np, nn, d->_mp_d, dn);
-
- if (qp)
- {
- qn -= (qp[qn-1] == 0);
-
- tq->_mp_size = qs < 0 ? -qn : qn;
- }
- rn = mpn_normalized_size (np, dn);
- tr->_mp_size = ns < 0 ? - rn : rn;
-
- if (mode == GMP_DIV_FLOOR && qs < 0 && rn != 0)
- {
- if (q)
- mpz_sub_ui (tq, tq, 1);
- if (r)
- mpz_add (tr, tr, d);
- }
- else if (mode == GMP_DIV_CEIL && qs >= 0 && rn != 0)
- {
- if (q)
- mpz_add_ui (tq, tq, 1);
- if (r)
- mpz_sub (tr, tr, d);
- }
-
- if (q)
- {
- mpz_swap (tq, q);
- mpz_clear (tq);
- }
- if (r)
- mpz_swap (tr, r);
-
- mpz_clear (tr);
-
- return rn != 0;
- }
-}
-
-void
-mpz_cdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (q, r, n, d, GMP_DIV_CEIL);
-}
-
-void
-mpz_fdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (q, r, n, d, GMP_DIV_FLOOR);
-}
-
-void
-mpz_tdiv_qr (mpz_t q, mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (q, r, n, d, GMP_DIV_TRUNC);
-}
-
-void
-mpz_cdiv_q (mpz_t q, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (q, NULL, n, d, GMP_DIV_CEIL);
-}
-
-void
-mpz_fdiv_q (mpz_t q, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (q, NULL, n, d, GMP_DIV_FLOOR);
-}
-
-void
-mpz_tdiv_q (mpz_t q, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (q, NULL, n, d, GMP_DIV_TRUNC);
-}
-
-void
-mpz_cdiv_r (mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (NULL, r, n, d, GMP_DIV_CEIL);
-}
-
-void
-mpz_fdiv_r (mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (NULL, r, n, d, GMP_DIV_FLOOR);
-}
-
-void
-mpz_tdiv_r (mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (NULL, r, n, d, GMP_DIV_TRUNC);
-}
-
-void
-mpz_mod (mpz_t r, const mpz_t n, const mpz_t d)
-{
- mpz_div_qr (NULL, r, n, d, d->_mp_size >= 0 ? GMP_DIV_FLOOR : GMP_DIV_CEIL);
-}
-
-static void
-mpz_div_q_2exp (mpz_t q, const mpz_t u, mp_bitcnt_t bit_index,
- enum mpz_div_round_mode mode)
-{
- mp_size_t un, qn;
- mp_size_t limb_cnt;
- mp_ptr qp;
- int adjust;
-
- un = u->_mp_size;
- if (un == 0)
- {
- q->_mp_size = 0;
- return;
- }
- limb_cnt = bit_index / GMP_LIMB_BITS;
- qn = GMP_ABS (un) - limb_cnt;
- bit_index %= GMP_LIMB_BITS;
-
- if (mode == ((un > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* un != 0 here. */
- /* Note: Below, the final indexing at limb_cnt is valid because at
- that point we have qn > 0. */
- adjust = (qn <= 0
- || !mpn_zero_p (u->_mp_d, limb_cnt)
- || (u->_mp_d[limb_cnt]
- & (((mp_limb_t) 1 << bit_index) - 1)));
- else
- adjust = 0;
-
- if (qn <= 0)
- qn = 0;
-
- else
- {
- qp = MPZ_REALLOC (q, qn);
-
- if (bit_index != 0)
- {
- mpn_rshift (qp, u->_mp_d + limb_cnt, qn, bit_index);
- qn -= qp[qn - 1] == 0;
- }
- else
- {
- mpn_copyi (qp, u->_mp_d + limb_cnt, qn);
- }
- }
-
- q->_mp_size = qn;
-
- if (adjust)
- mpz_add_ui (q, q, 1);
- if (un < 0)
- mpz_neg (q, q);
-}
-
-static void
-mpz_div_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t bit_index,
- enum mpz_div_round_mode mode)
-{
- mp_size_t us, un, rn;
- mp_ptr rp;
- mp_limb_t mask;
-
- us = u->_mp_size;
- if (us == 0 || bit_index == 0)
- {
- r->_mp_size = 0;
- return;
- }
- rn = (bit_index + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS;
- assert (rn > 0);
-
- rp = MPZ_REALLOC (r, rn);
- un = GMP_ABS (us);
-
- mask = GMP_LIMB_MAX >> (rn * GMP_LIMB_BITS - bit_index);
-
- if (rn > un)
- {
- /* Quotient (with truncation) is zero, and remainder is
- non-zero */
- if (mode == ((us > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* us != 0 here. */
- {
- /* Have to negate and sign extend. */
- mp_size_t i;
- mp_limb_t cy;
-
- for (cy = 1, i = 0; i < un; i++)
- {
- mp_limb_t s = ~u->_mp_d[i] + cy;
- cy = s < cy;
- rp[i] = s;
- }
- assert (cy == 0);
- for (; i < rn - 1; i++)
- rp[i] = GMP_LIMB_MAX;
-
- rp[rn-1] = mask;
- us = -us;
- }
- else
- {
- /* Just copy */
- if (r != u)
- mpn_copyi (rp, u->_mp_d, un);
-
- rn = un;
- }
- }
- else
- {
- if (r != u)
- mpn_copyi (rp, u->_mp_d, rn - 1);
-
- rp[rn-1] = u->_mp_d[rn-1] & mask;
-
- if (mode == ((us > 0) ? GMP_DIV_CEIL : GMP_DIV_FLOOR)) /* us != 0 here. */
- {
- /* If r != 0, compute 2^{bit_count} - r. */
- mp_size_t i;
-
- for (i = 0; i < rn && rp[i] == 0; i++)
- ;
- if (i < rn)
- {
- /* r > 0, need to flip sign. */
- rp[i] = ~rp[i] + 1;
- while (++i < rn)
- rp[i] = ~rp[i];
-
- rp[rn-1] &= mask;
-
- /* us is not used for anything else, so we can modify it
- here to indicate flipped sign. */
- us = -us;
- }
- }
- }
- rn = mpn_normalized_size (rp, rn);
- r->_mp_size = us < 0 ? -rn : rn;
-}
-
-void
-mpz_cdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt)
-{
- mpz_div_q_2exp (r, u, cnt, GMP_DIV_CEIL);
-}
-
-void
-mpz_fdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt)
-{
- mpz_div_q_2exp (r, u, cnt, GMP_DIV_FLOOR);
-}
-
-void
-mpz_tdiv_q_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt)
-{
- mpz_div_q_2exp (r, u, cnt, GMP_DIV_TRUNC);
-}
-
-void
-mpz_cdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt)
-{
- mpz_div_r_2exp (r, u, cnt, GMP_DIV_CEIL);
-}
-
-void
-mpz_fdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt)
-{
- mpz_div_r_2exp (r, u, cnt, GMP_DIV_FLOOR);
-}
-
-void
-mpz_tdiv_r_2exp (mpz_t r, const mpz_t u, mp_bitcnt_t cnt)
-{
- mpz_div_r_2exp (r, u, cnt, GMP_DIV_TRUNC);
-}
-
-void
-mpz_divexact (mpz_t q, const mpz_t n, const mpz_t d)
-{
- gmp_assert_nocarry (mpz_div_qr (q, NULL, n, d, GMP_DIV_TRUNC));
-}
-
-int
-mpz_divisible_p (const mpz_t n, const mpz_t d)
-{
- return mpz_div_qr (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0;
-}
-
-int
-mpz_congruent_p (const mpz_t a, const mpz_t b, const mpz_t m)
-{
- mpz_t t;
- int res;
-
- /* a == b (mod 0) iff a == b */
- if (mpz_sgn (m) == 0)
- return (mpz_cmp (a, b) == 0);
-
- mpz_init (t);
- mpz_sub (t, a, b);
- res = mpz_divisible_p (t, m);
- mpz_clear (t);
-
- return res;
-}
-
-static unsigned long
-mpz_div_qr_ui (mpz_t q, mpz_t r,
- const mpz_t n, unsigned long d, enum mpz_div_round_mode mode)
-{
- mp_size_t ns, qn;
- mp_ptr qp;
- mp_limb_t rl;
- mp_size_t rs;
-
- ns = n->_mp_size;
- if (ns == 0)
- {
- if (q)
- q->_mp_size = 0;
- if (r)
- r->_mp_size = 0;
- return 0;
- }
-
- qn = GMP_ABS (ns);
- if (q)
- qp = MPZ_REALLOC (q, qn);
- else
- qp = NULL;
-
- rl = mpn_div_qr_1 (qp, n->_mp_d, qn, d);
- assert (rl < d);
-
- rs = rl > 0;
- rs = (ns < 0) ? -rs : rs;
-
- if (rl > 0 && ( (mode == GMP_DIV_FLOOR && ns < 0)
- || (mode == GMP_DIV_CEIL && ns >= 0)))
- {
- if (q)
- gmp_assert_nocarry (mpn_add_1 (qp, qp, qn, 1));
- rl = d - rl;
- rs = -rs;
- }
-
- if (r)
- {
- r->_mp_d[0] = rl;
- r->_mp_size = rs;
- }
- if (q)
- {
- qn -= (qp[qn-1] == 0);
- assert (qn == 0 || qp[qn-1] > 0);
-
- q->_mp_size = (ns < 0) ? - qn : qn;
- }
-
- return rl;
-}
-
-unsigned long
-mpz_cdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (q, r, n, d, GMP_DIV_CEIL);
-}
-
-unsigned long
-mpz_fdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (q, r, n, d, GMP_DIV_FLOOR);
-}
-
-unsigned long
-mpz_tdiv_qr_ui (mpz_t q, mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (q, r, n, d, GMP_DIV_TRUNC);
-}
-
-unsigned long
-mpz_cdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_CEIL);
-}
-
-unsigned long
-mpz_fdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_FLOOR);
-}
-
-unsigned long
-mpz_tdiv_q_ui (mpz_t q, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC);
-}
-
-unsigned long
-mpz_cdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_CEIL);
-}
-unsigned long
-mpz_fdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR);
-}
-unsigned long
-mpz_tdiv_r_ui (mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_TRUNC);
-}
-
-unsigned long
-mpz_cdiv_ui (const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_CEIL);
-}
-
-unsigned long
-mpz_fdiv_ui (const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_FLOOR);
-}
-
-unsigned long
-mpz_tdiv_ui (const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC);
-}
-
-unsigned long
-mpz_mod_ui (mpz_t r, const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, r, n, d, GMP_DIV_FLOOR);
-}
-
-void
-mpz_divexact_ui (mpz_t q, const mpz_t n, unsigned long d)
-{
- gmp_assert_nocarry (mpz_div_qr_ui (q, NULL, n, d, GMP_DIV_TRUNC));
-}
-
-int
-mpz_divisible_ui_p (const mpz_t n, unsigned long d)
-{
- return mpz_div_qr_ui (NULL, NULL, n, d, GMP_DIV_TRUNC) == 0;
-}
-
-
-/* GCD */
-static mp_limb_t
-mpn_gcd_11 (mp_limb_t u, mp_limb_t v)
-{
- unsigned shift;
-
- assert ( (u | v) > 0);
-
- if (u == 0)
- return v;
- else if (v == 0)
- return u;
-
- gmp_ctz (shift, u | v);
-
- u >>= shift;
- v >>= shift;
-
- if ( (u & 1) == 0)
- MP_LIMB_T_SWAP (u, v);
-
- while ( (v & 1) == 0)
- v >>= 1;
-
- while (u != v)
- {
- if (u > v)
- {
- u -= v;
- do
- u >>= 1;
- while ( (u & 1) == 0);
- }
- else
- {
- v -= u;
- do
- v >>= 1;
- while ( (v & 1) == 0);
- }
- }
- return u << shift;
-}
-
-unsigned long
-mpz_gcd_ui (mpz_t g, const mpz_t u, unsigned long v)
-{
- mp_size_t un;
-
- if (v == 0)
- {
- if (g)
- mpz_abs (g, u);
- }
- else
- {
- un = GMP_ABS (u->_mp_size);
- if (un != 0)
- v = mpn_gcd_11 (mpn_div_qr_1 (NULL, u->_mp_d, un, v), v);
-
- if (g)
- mpz_set_ui (g, v);
- }
-
- return v;
-}
-
-static mp_bitcnt_t
-mpz_make_odd (mpz_t r)
-{
- mp_bitcnt_t shift;
-
- assert (r->_mp_size > 0);
- /* Count trailing zeros, equivalent to mpn_scan1, because we know that there is a 1 */
- shift = mpn_common_scan (r->_mp_d[0], 0, r->_mp_d, 0, 0);
- mpz_tdiv_q_2exp (r, r, shift);
-
- return shift;
-}
-
-void
-mpz_gcd (mpz_t g, const mpz_t u, const mpz_t v)
-{
- mpz_t tu, tv;
- mp_bitcnt_t uz, vz, gz;
-
- if (u->_mp_size == 0)
- {
- mpz_abs (g, v);
- return;
- }
- if (v->_mp_size == 0)
- {
- mpz_abs (g, u);
- return;
- }
-
- mpz_init (tu);
- mpz_init (tv);
-
- mpz_abs (tu, u);
- uz = mpz_make_odd (tu);
- mpz_abs (tv, v);
- vz = mpz_make_odd (tv);
- gz = GMP_MIN (uz, vz);
-
- if (tu->_mp_size < tv->_mp_size)
- mpz_swap (tu, tv);
-
- mpz_tdiv_r (tu, tu, tv);
- if (tu->_mp_size == 0)
- {
- mpz_swap (g, tv);
- }
- else
- for (;;)
- {
- int c;
-
- mpz_make_odd (tu);
- c = mpz_cmp (tu, tv);
- if (c == 0)
- {
- mpz_swap (g, tu);
- break;
- }
- if (c < 0)
- mpz_swap (tu, tv);
-
- if (tv->_mp_size == 1)
- {
- mp_limb_t vl = tv->_mp_d[0];
- mp_limb_t ul = mpz_tdiv_ui (tu, vl);
- mpz_set_ui (g, mpn_gcd_11 (ul, vl));
- break;
- }
- mpz_sub (tu, tu, tv);
- }
- mpz_clear (tu);
- mpz_clear (tv);
- mpz_mul_2exp (g, g, gz);
-}
-
-void
-mpz_gcdext (mpz_t g, mpz_t s, mpz_t t, const mpz_t u, const mpz_t v)
-{
- mpz_t tu, tv, s0, s1, t0, t1;
- mp_bitcnt_t uz, vz, gz;
- mp_bitcnt_t power;
-
- if (u->_mp_size == 0)
- {
- /* g = 0 u + sgn(v) v */
- signed long sign = mpz_sgn (v);
- mpz_abs (g, v);
- if (s)
- mpz_set_ui (s, 0);
- if (t)
- mpz_set_si (t, sign);
- return;
- }
-
- if (v->_mp_size == 0)
- {
- /* g = sgn(u) u + 0 v */
- signed long sign = mpz_sgn (u);
- mpz_abs (g, u);
- if (s)
- mpz_set_si (s, sign);
- if (t)
- mpz_set_ui (t, 0);
- return;
- }
-
- mpz_init (tu);
- mpz_init (tv);
- mpz_init (s0);
- mpz_init (s1);
- mpz_init (t0);
- mpz_init (t1);
-
- mpz_abs (tu, u);
- uz = mpz_make_odd (tu);
- mpz_abs (tv, v);
- vz = mpz_make_odd (tv);
- gz = GMP_MIN (uz, vz);
-
- uz -= gz;
- vz -= gz;
-
- /* Cofactors corresponding to odd gcd. gz handled later. */
- if (tu->_mp_size < tv->_mp_size)
- {
- mpz_swap (tu, tv);
- MPZ_SRCPTR_SWAP (u, v);
- MPZ_PTR_SWAP (s, t);
- MP_BITCNT_T_SWAP (uz, vz);
- }
-
- /* Maintain
- *
- * u = t0 tu + t1 tv
- * v = s0 tu + s1 tv
- *
- * where u and v denote the inputs with common factors of two
- * eliminated, and det (s0, t0; s1, t1) = 2^p. Then
- *
- * 2^p tu = s1 u - t1 v
- * 2^p tv = -s0 u + t0 v
- */
-
- /* After initial division, tu = q tv + tu', we have
- *
- * u = 2^uz (tu' + q tv)
- * v = 2^vz tv
- *
- * or
- *
- * t0 = 2^uz, t1 = 2^uz q
- * s0 = 0, s1 = 2^vz
- */
-
- mpz_setbit (t0, uz);
- mpz_tdiv_qr (t1, tu, tu, tv);
- mpz_mul_2exp (t1, t1, uz);
-
- mpz_setbit (s1, vz);
- power = uz + vz;
-
- if (tu->_mp_size > 0)
- {
- mp_bitcnt_t shift;
- shift = mpz_make_odd (tu);
- mpz_mul_2exp (t0, t0, shift);
- mpz_mul_2exp (s0, s0, shift);
- power += shift;
-
- for (;;)
- {
- int c;
- c = mpz_cmp (tu, tv);
- if (c == 0)
- break;
-
- if (c < 0)
- {
- /* tv = tv' + tu
- *
- * u = t0 tu + t1 (tv' + tu) = (t0 + t1) tu + t1 tv'
- * v = s0 tu + s1 (tv' + tu) = (s0 + s1) tu + s1 tv' */
-
- mpz_sub (tv, tv, tu);
- mpz_add (t0, t0, t1);
- mpz_add (s0, s0, s1);
-
- shift = mpz_make_odd (tv);
- mpz_mul_2exp (t1, t1, shift);
- mpz_mul_2exp (s1, s1, shift);
- }
- else
- {
- mpz_sub (tu, tu, tv);
- mpz_add (t1, t0, t1);
- mpz_add (s1, s0, s1);
-
- shift = mpz_make_odd (tu);
- mpz_mul_2exp (t0, t0, shift);
- mpz_mul_2exp (s0, s0, shift);
- }
- power += shift;
- }
- }
-
- /* Now tv = odd part of gcd, and -s0 and t0 are corresponding
- cofactors. */
-
- mpz_mul_2exp (tv, tv, gz);
- mpz_neg (s0, s0);
-
- /* 2^p g = s0 u + t0 v. Eliminate one factor of two at a time. To
- adjust cofactors, we need u / g and v / g */
-
- mpz_divexact (s1, v, tv);
- mpz_abs (s1, s1);
- mpz_divexact (t1, u, tv);
- mpz_abs (t1, t1);
-
- while (power-- > 0)
- {
- /* s0 u + t0 v = (s0 - v/g) u - (t0 + u/g) v */
- if (mpz_odd_p (s0) || mpz_odd_p (t0))
- {
- mpz_sub (s0, s0, s1);
- mpz_add (t0, t0, t1);
- }
- mpz_divexact_ui (s0, s0, 2);
- mpz_divexact_ui (t0, t0, 2);
- }
-
- /* Arrange so that |s| < |u| / 2g */
- mpz_add (s1, s0, s1);
- if (mpz_cmpabs (s0, s1) > 0)
- {
- mpz_swap (s0, s1);
- mpz_sub (t0, t0, t1);
- }
- if (u->_mp_size < 0)
- mpz_neg (s0, s0);
- if (v->_mp_size < 0)
- mpz_neg (t0, t0);
-
- mpz_swap (g, tv);
- if (s)
- mpz_swap (s, s0);
- if (t)
- mpz_swap (t, t0);
-
- mpz_clear (tu);
- mpz_clear (tv);
- mpz_clear (s0);
- mpz_clear (s1);
- mpz_clear (t0);
- mpz_clear (t1);
-}
-
-void
-mpz_lcm (mpz_t r, const mpz_t u, const mpz_t v)
-{
- mpz_t g;
-
- if (u->_mp_size == 0 || v->_mp_size == 0)
- {
- r->_mp_size = 0;
- return;
- }
-
- mpz_init (g);
-
- mpz_gcd (g, u, v);
- mpz_divexact (g, u, g);
- mpz_mul (r, g, v);
-
- mpz_clear (g);
- mpz_abs (r, r);
-}
-
-void
-mpz_lcm_ui (mpz_t r, const mpz_t u, unsigned long v)
-{
- if (v == 0 || u->_mp_size == 0)
- {
- r->_mp_size = 0;
- return;
- }
-
- v /= mpz_gcd_ui (NULL, u, v);
- mpz_mul_ui (r, u, v);
-
- mpz_abs (r, r);
-}
-
-int
-mpz_invert (mpz_t r, const mpz_t u, const mpz_t m)
-{
- mpz_t g, tr;
- int invertible;
-
- if (u->_mp_size == 0 || mpz_cmpabs_ui (m, 1) <= 0)
- return 0;
-
- mpz_init (g);
- mpz_init (tr);
-
- mpz_gcdext (g, tr, NULL, u, m);
- invertible = (mpz_cmp_ui (g, 1) == 0);
-
- if (invertible)
- {
- if (tr->_mp_size < 0)
- {
- if (m->_mp_size >= 0)
- mpz_add (tr, tr, m);
- else
- mpz_sub (tr, tr, m);
- }
- mpz_swap (r, tr);
- }
-
- mpz_clear (g);
- mpz_clear (tr);
- return invertible;
-}
-
-
-/* Higher level operations (sqrt, pow and root) */
-
-void
-mpz_pow_ui (mpz_t r, const mpz_t b, unsigned long e)
-{
- unsigned long bit;
- mpz_t tr;
- mpz_init_set_ui (tr, 1);
-
- bit = GMP_ULONG_HIGHBIT;
- do
- {
- mpz_mul (tr, tr, tr);
- if (e & bit)
- mpz_mul (tr, tr, b);
- bit >>= 1;
- }
- while (bit > 0);
-
- mpz_swap (r, tr);
- mpz_clear (tr);
-}
-
-void
-mpz_ui_pow_ui (mpz_t r, unsigned long blimb, unsigned long e)
-{
- mpz_t b;
- mpz_pow_ui (r, mpz_roinit_n (b, &blimb, 1), e);
-}
-
-void
-mpz_powm (mpz_t r, const mpz_t b, const mpz_t e, const mpz_t m)
-{
- mpz_t tr;
- mpz_t base;
- mp_size_t en, mn;
- mp_srcptr mp;
- struct gmp_div_inverse minv;
- unsigned shift;
- mp_ptr tp = NULL;
-
- en = GMP_ABS (e->_mp_size);
- mn = GMP_ABS (m->_mp_size);
- if (mn == 0)
- gmp_die ("mpz_powm: Zero modulo.");
-
- if (en == 0)
- {
- mpz_set_ui (r, 1);
- return;
- }
-
- mp = m->_mp_d;
- mpn_div_qr_invert (&minv, mp, mn);
- shift = minv.shift;
-
- if (shift > 0)
- {
- /* To avoid shifts, we do all our reductions, except the final
- one, using a *normalized* m. */
- minv.shift = 0;
-
- tp = gmp_xalloc_limbs (mn);
- gmp_assert_nocarry (mpn_lshift (tp, mp, mn, shift));
- mp = tp;
- }
-
- mpz_init (base);
-
- if (e->_mp_size < 0)
- {
- if (!mpz_invert (base, b, m))
- gmp_die ("mpz_powm: Negative exponent and non-invertible base.");
- }
- else
- {
- mp_size_t bn;
- mpz_abs (base, b);
-
- bn = base->_mp_size;
- if (bn >= mn)
- {
- mpn_div_qr_preinv (NULL, base->_mp_d, base->_mp_size, mp, mn, &minv);
- bn = mn;
- }
-
- /* We have reduced the absolute value. Now take care of the
- sign. Note that we get zero represented non-canonically as
- m. */
- if (b->_mp_size < 0)
- {
- mp_ptr bp = MPZ_REALLOC (base, mn);
- gmp_assert_nocarry (mpn_sub (bp, mp, mn, bp, bn));
- bn = mn;
- }
- base->_mp_size = mpn_normalized_size (base->_mp_d, bn);
- }
- mpz_init_set_ui (tr, 1);
-
- while (--en >= 0)
- {
- mp_limb_t w = e->_mp_d[en];
- mp_limb_t bit;
-
- bit = GMP_LIMB_HIGHBIT;
- do
- {
- mpz_mul (tr, tr, tr);
- if (w & bit)
- mpz_mul (tr, tr, base);
- if (tr->_mp_size > mn)
- {
- mpn_div_qr_preinv (NULL, tr->_mp_d, tr->_mp_size, mp, mn, &minv);
- tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn);
- }
- bit >>= 1;
- }
- while (bit > 0);
- }
-
- /* Final reduction */
- if (tr->_mp_size >= mn)
- {
- minv.shift = shift;
- mpn_div_qr_preinv (NULL, tr->_mp_d, tr->_mp_size, mp, mn, &minv);
- tr->_mp_size = mpn_normalized_size (tr->_mp_d, mn);
- }
- if (tp)
- gmp_free (tp);
-
- mpz_swap (r, tr);
- mpz_clear (tr);
- mpz_clear (base);
-}
-
-void
-mpz_powm_ui (mpz_t r, const mpz_t b, unsigned long elimb, const mpz_t m)
-{
- mpz_t e;
- mpz_powm (r, b, mpz_roinit_n (e, &elimb, 1), m);
-}
-
-/* x=trunc(y^(1/z)), r=y-x^z */
-void
-mpz_rootrem (mpz_t x, mpz_t r, const mpz_t y, unsigned long z)
-{
- int sgn;
- mpz_t t, u;
-
- sgn = y->_mp_size < 0;
- if ((~z & sgn) != 0)
- gmp_die ("mpz_rootrem: Negative argument, with even root.");
- if (z == 0)
- gmp_die ("mpz_rootrem: Zeroth root.");
-
- if (mpz_cmpabs_ui (y, 1) <= 0) {
- if (x)
- mpz_set (x, y);
- if (r)
- r->_mp_size = 0;
- return;
- }
-
- mpz_init (u);
- {
- mp_bitcnt_t tb;
- tb = mpz_sizeinbase (y, 2) / z + 1;
- mpz_init2 (t, tb + 1);
- mpz_setbit (t, tb);
- }
-
- if (z == 2) /* simplify sqrt loop: z-1 == 1 */
- do {
- mpz_swap (u, t); /* u = x */
- mpz_tdiv_q (t, y, u); /* t = y/x */
- mpz_add (t, t, u); /* t = y/x + x */
- mpz_tdiv_q_2exp (t, t, 1); /* x'= (y/x + x)/2 */
- } while (mpz_cmpabs (t, u) < 0); /* |x'| < |x| */
- else /* z != 2 */ {
- mpz_t v;
-
- mpz_init (v);
- if (sgn)
- mpz_neg (t, t);
-
- do {
- mpz_swap (u, t); /* u = x */
- mpz_pow_ui (t, u, z - 1); /* t = x^(z-1) */
- mpz_tdiv_q (t, y, t); /* t = y/x^(z-1) */
- mpz_mul_ui (v, u, z - 1); /* v = x*(z-1) */
- mpz_add (t, t, v); /* t = y/x^(z-1) + x*(z-1) */
- mpz_tdiv_q_ui (t, t, z); /* x'=(y/x^(z-1) + x*(z-1))/z */
- } while (mpz_cmpabs (t, u) < 0); /* |x'| < |x| */
-
- mpz_clear (v);
- }
-
- if (r) {
- mpz_pow_ui (t, u, z);
- mpz_sub (r, y, t);
- }
- if (x)
- mpz_swap (x, u);
- mpz_clear (u);
- mpz_clear (t);
-}
-
-int
-mpz_root (mpz_t x, const mpz_t y, unsigned long z)
-{
- int res;
- mpz_t r;
-
- mpz_init (r);
- mpz_rootrem (x, r, y, z);
- res = r->_mp_size == 0;
- mpz_clear (r);
-
- return res;
-}
-
-/* Compute s = floor(sqrt(u)) and r = u - s^2. Allows r == NULL */
-void
-mpz_sqrtrem (mpz_t s, mpz_t r, const mpz_t u)
-{
- mpz_rootrem (s, r, u, 2);
-}
-
-void
-mpz_sqrt (mpz_t s, const mpz_t u)
-{
- mpz_rootrem (s, NULL, u, 2);
-}
-
-int
-mpz_perfect_square_p (const mpz_t u)
-{
- if (u->_mp_size <= 0)
- return (u->_mp_size == 0);
- else
- return mpz_root (NULL, u, 2);
-}
-
-int
-mpn_perfect_square_p (mp_srcptr p, mp_size_t n)
-{
- mpz_t t;
-
- assert (n > 0);
- assert (p [n-1] != 0);
- return mpz_root (NULL, mpz_roinit_n (t, p, n), 2);
-}
-
-mp_size_t
-mpn_sqrtrem (mp_ptr sp, mp_ptr rp, mp_srcptr p, mp_size_t n)
-{
- mpz_t s, r, u;
- mp_size_t res;
-
- assert (n > 0);
- assert (p [n-1] != 0);
-
- mpz_init (r);
- mpz_init (s);
- mpz_rootrem (s, r, mpz_roinit_n (u, p, n), 2);
-
- assert (s->_mp_size == (n+1)/2);
- mpn_copyd (sp, s->_mp_d, s->_mp_size);
- mpz_clear (s);
- res = r->_mp_size;
- if (rp)
- mpn_copyd (rp, r->_mp_d, res);
- mpz_clear (r);
- return res;
-}
-
-/* Combinatorics */
-
-void
-mpz_fac_ui (mpz_t x, unsigned long n)
-{
- mpz_set_ui (x, n + (n == 0));
- while (n > 2)
- mpz_mul_ui (x, x, --n);
-}
-
-void
-mpz_bin_uiui (mpz_t r, unsigned long n, unsigned long k)
-{
- mpz_t t;
-
- mpz_set_ui (r, k <= n);
-
- if (k > (n >> 1))
- k = (k <= n) ? n - k : 0;
-
- mpz_init (t);
- mpz_fac_ui (t, k);
-
- for (; k > 0; k--)
- mpz_mul_ui (r, r, n--);
-
- mpz_divexact (r, r, t);
- mpz_clear (t);
-}
-
-
-/* Primality testing */
-static int
-gmp_millerrabin (const mpz_t n, const mpz_t nm1, mpz_t y,
- const mpz_t q, mp_bitcnt_t k)
-{
- assert (k > 0);
-
- /* Caller must initialize y to the base. */
- mpz_powm (y, y, q, n);
-
- if (mpz_cmp_ui (y, 1) == 0 || mpz_cmp (y, nm1) == 0)
- return 1;
-
- while (--k > 0)
- {
- mpz_powm_ui (y, y, 2, n);
- if (mpz_cmp (y, nm1) == 0)
- return 1;
- /* y == 1 means that the previous y was a non-trivial square root
- of 1 (mod n). y == 0 means that n is a power of the base.
- In either case, n is not prime. */
- if (mpz_cmp_ui (y, 1) <= 0)
- return 0;
- }
- return 0;
-}
-
-/* This product is 0xc0cfd797, and fits in 32 bits. */
-#define GMP_PRIME_PRODUCT \
- (3UL*5UL*7UL*11UL*13UL*17UL*19UL*23UL*29UL)
-
-/* Bit (p+1)/2 is set, for each odd prime <= 61 */
-#define GMP_PRIME_MASK 0xc96996dcUL
-
-int
-mpz_probab_prime_p (const mpz_t n, int reps)
-{
- mpz_t nm1;
- mpz_t q;
- mpz_t y;
- mp_bitcnt_t k;
- int is_prime;
- int j;
-
- /* Note that we use the absolute value of n only, for compatibility
- with the real GMP. */
- if (mpz_even_p (n))
- return (mpz_cmpabs_ui (n, 2) == 0) ? 2 : 0;
-
- /* Above test excludes n == 0 */
- assert (n->_mp_size != 0);
-
- if (mpz_cmpabs_ui (n, 64) < 0)
- return (GMP_PRIME_MASK >> (n->_mp_d[0] >> 1)) & 2;
-
- if (mpz_gcd_ui (NULL, n, GMP_PRIME_PRODUCT) != 1)
- return 0;
-
- /* All prime factors are >= 31. */
- if (mpz_cmpabs_ui (n, 31*31) < 0)
- return 2;
-
- /* Use Miller-Rabin, with a deterministic sequence of bases, a[j] =
- j^2 + j + 41 using Euler's polynomial. We potentially stop early,
- if a[j] >= n - 1. Since n >= 31*31, this can happen only if reps >
- 30 (a[30] == 971 > 31*31 == 961). */
-
- mpz_init (nm1);
- mpz_init (q);
- mpz_init (y);
-
- /* Find q and k, where q is odd and n = 1 + 2**k * q. */
- nm1->_mp_size = mpz_abs_sub_ui (nm1, n, 1);
- k = mpz_scan1 (nm1, 0);
- mpz_tdiv_q_2exp (q, nm1, k);
-
- for (j = 0, is_prime = 1; is_prime & (j < reps); j++)
- {
- mpz_set_ui (y, (unsigned long) j*j+j+41);
- if (mpz_cmp (y, nm1) >= 0)
- {
- /* Don't try any further bases. This "early" break does not affect
- the result for any reasonable reps value (<=5000 was tested) */
- assert (j >= 30);
- break;
- }
- is_prime = gmp_millerrabin (n, nm1, y, q, k);
- }
- mpz_clear (nm1);
- mpz_clear (q);
- mpz_clear (y);
-
- return is_prime;
-}
-
-
-/* Logical operations and bit manipulation. */
-
-/* Numbers are treated as if represented in two's complement (and
- infinitely sign extended). For a negative values we get the two's
- complement from -x = ~x + 1, where ~ is bitwise complement.
- Negation transforms
-
- xxxx10...0
-
- into
-
- yyyy10...0
-
- where yyyy is the bitwise complement of xxxx. So least significant
- bits, up to and including the first one bit, are unchanged, and
- the more significant bits are all complemented.
-
- To change a bit from zero to one in a negative number, subtract the
- corresponding power of two from the absolute value. This can never
- underflow. To change a bit from one to zero, add the corresponding
- power of two, and this might overflow. E.g., if x = -001111, the
- two's complement is 110001. Clearing the least significant bit, we
- get two's complement 110000, and -010000. */
-
-int
-mpz_tstbit (const mpz_t d, mp_bitcnt_t bit_index)
-{
- mp_size_t limb_index;
- unsigned shift;
- mp_size_t ds;
- mp_size_t dn;
- mp_limb_t w;
- int bit;
-
- ds = d->_mp_size;
- dn = GMP_ABS (ds);
- limb_index = bit_index / GMP_LIMB_BITS;
- if (limb_index >= dn)
- return ds < 0;
-
- shift = bit_index % GMP_LIMB_BITS;
- w = d->_mp_d[limb_index];
- bit = (w >> shift) & 1;
-
- if (ds < 0)
- {
- /* d < 0. Check if any of the bits below is set: If so, our bit
- must be complemented. */
- if (shift > 0 && (w << (GMP_LIMB_BITS - shift)) > 0)
- return bit ^ 1;
- while (--limb_index >= 0)
- if (d->_mp_d[limb_index] > 0)
- return bit ^ 1;
- }
- return bit;
-}
-
-static void
-mpz_abs_add_bit (mpz_t d, mp_bitcnt_t bit_index)
-{
- mp_size_t dn, limb_index;
- mp_limb_t bit;
- mp_ptr dp;
-
- dn = GMP_ABS (d->_mp_size);
-
- limb_index = bit_index / GMP_LIMB_BITS;
- bit = (mp_limb_t) 1 << (bit_index % GMP_LIMB_BITS);
-
- if (limb_index >= dn)
- {
- mp_size_t i;
- /* The bit should be set outside of the end of the number.
- We have to increase the size of the number. */
- dp = MPZ_REALLOC (d, limb_index + 1);
-
- dp[limb_index] = bit;
- for (i = dn; i < limb_index; i++)
- dp[i] = 0;
- dn = limb_index + 1;
- }
- else
- {
- mp_limb_t cy;
-
- dp = d->_mp_d;
-
- cy = mpn_add_1 (dp + limb_index, dp + limb_index, dn - limb_index, bit);
- if (cy > 0)
- {
- dp = MPZ_REALLOC (d, dn + 1);
- dp[dn++] = cy;
- }
- }
-
- d->_mp_size = (d->_mp_size < 0) ? - dn : dn;
-}
-
-static void
-mpz_abs_sub_bit (mpz_t d, mp_bitcnt_t bit_index)
-{
- mp_size_t dn, limb_index;
- mp_ptr dp;
- mp_limb_t bit;
-
- dn = GMP_ABS (d->_mp_size);
- dp = d->_mp_d;
-
- limb_index = bit_index / GMP_LIMB_BITS;
- bit = (mp_limb_t) 1 << (bit_index % GMP_LIMB_BITS);
-
- assert (limb_index < dn);
-
- gmp_assert_nocarry (mpn_sub_1 (dp + limb_index, dp + limb_index,
- dn - limb_index, bit));
- dn = mpn_normalized_size (dp, dn);
- d->_mp_size = (d->_mp_size < 0) ? - dn : dn;
-}
-
-void
-mpz_setbit (mpz_t d, mp_bitcnt_t bit_index)
-{
- if (!mpz_tstbit (d, bit_index))
- {
- if (d->_mp_size >= 0)
- mpz_abs_add_bit (d, bit_index);
- else
- mpz_abs_sub_bit (d, bit_index);
- }
-}
-
-void
-mpz_clrbit (mpz_t d, mp_bitcnt_t bit_index)
-{
- if (mpz_tstbit (d, bit_index))
- {
- if (d->_mp_size >= 0)
- mpz_abs_sub_bit (d, bit_index);
- else
- mpz_abs_add_bit (d, bit_index);
- }
-}
-
-void
-mpz_combit (mpz_t d, mp_bitcnt_t bit_index)
-{
- if (mpz_tstbit (d, bit_index) ^ (d->_mp_size < 0))
- mpz_abs_sub_bit (d, bit_index);
- else
- mpz_abs_add_bit (d, bit_index);
-}
-
-void
-mpz_com (mpz_t r, const mpz_t u)
-{
- mpz_neg (r, u);
- mpz_sub_ui (r, r, 1);
-}
-
-void
-mpz_and (mpz_t r, const mpz_t u, const mpz_t v)
-{
- mp_size_t un, vn, rn, i;
- mp_ptr up, vp, rp;
-
- mp_limb_t ux, vx, rx;
- mp_limb_t uc, vc, rc;
- mp_limb_t ul, vl, rl;
-
- un = GMP_ABS (u->_mp_size);
- vn = GMP_ABS (v->_mp_size);
- if (un < vn)
- {
- MPZ_SRCPTR_SWAP (u, v);
- MP_SIZE_T_SWAP (un, vn);
- }
- if (vn == 0)
- {
- r->_mp_size = 0;
- return;
- }
-
- uc = u->_mp_size < 0;
- vc = v->_mp_size < 0;
- rc = uc & vc;
-
- ux = -uc;
- vx = -vc;
- rx = -rc;
-
- /* If the smaller input is positive, higher limbs don't matter. */
- rn = vx ? un : vn;
-
- rp = MPZ_REALLOC (r, rn + rc);
-
- up = u->_mp_d;
- vp = v->_mp_d;
-
- i = 0;
- do
- {
- ul = (up[i] ^ ux) + uc;
- uc = ul < uc;
-
- vl = (vp[i] ^ vx) + vc;
- vc = vl < vc;
-
- rl = ( (ul & vl) ^ rx) + rc;
- rc = rl < rc;
- rp[i] = rl;
- }
- while (++i < vn);
- assert (vc == 0);
-
- for (; i < rn; i++)
- {
- ul = (up[i] ^ ux) + uc;
- uc = ul < uc;
-
- rl = ( (ul & vx) ^ rx) + rc;
- rc = rl < rc;
- rp[i] = rl;
- }
- if (rc)
- rp[rn++] = rc;
- else
- rn = mpn_normalized_size (rp, rn);
-
- r->_mp_size = rx ? -rn : rn;
-}
-
-void
-mpz_ior (mpz_t r, const mpz_t u, const mpz_t v)
-{
- mp_size_t un, vn, rn, i;
- mp_ptr up, vp, rp;
-
- mp_limb_t ux, vx, rx;
- mp_limb_t uc, vc, rc;
- mp_limb_t ul, vl, rl;
-
- un = GMP_ABS (u->_mp_size);
- vn = GMP_ABS (v->_mp_size);
- if (un < vn)
- {
- MPZ_SRCPTR_SWAP (u, v);
- MP_SIZE_T_SWAP (un, vn);
- }
- if (vn == 0)
- {
- mpz_set (r, u);
- return;
- }
-
- uc = u->_mp_size < 0;
- vc = v->_mp_size < 0;
- rc = uc | vc;
-
- ux = -uc;
- vx = -vc;
- rx = -rc;
-
- /* If the smaller input is negative, by sign extension higher limbs
- don't matter. */
- rn = vx ? vn : un;
-
- rp = MPZ_REALLOC (r, rn + rc);
-
- up = u->_mp_d;
- vp = v->_mp_d;
-
- i = 0;
- do
- {
- ul = (up[i] ^ ux) + uc;
- uc = ul < uc;
-
- vl = (vp[i] ^ vx) + vc;
- vc = vl < vc;
-
- rl = ( (ul | vl) ^ rx) + rc;
- rc = rl < rc;
- rp[i] = rl;
- }
- while (++i < vn);
- assert (vc == 0);
-
- for (; i < rn; i++)
- {
- ul = (up[i] ^ ux) + uc;
- uc = ul < uc;
-
- rl = ( (ul | vx) ^ rx) + rc;
- rc = rl < rc;
- rp[i] = rl;
- }
- if (rc)
- rp[rn++] = rc;
- else
- rn = mpn_normalized_size (rp, rn);
-
- r->_mp_size = rx ? -rn : rn;
-}
-
-void
-mpz_xor (mpz_t r, const mpz_t u, const mpz_t v)
-{
- mp_size_t un, vn, i;
- mp_ptr up, vp, rp;
-
- mp_limb_t ux, vx, rx;
- mp_limb_t uc, vc, rc;
- mp_limb_t ul, vl, rl;
-
- un = GMP_ABS (u->_mp_size);
- vn = GMP_ABS (v->_mp_size);
- if (un < vn)
- {
- MPZ_SRCPTR_SWAP (u, v);
- MP_SIZE_T_SWAP (un, vn);
- }
- if (vn == 0)
- {
- mpz_set (r, u);
- return;
- }
-
- uc = u->_mp_size < 0;
- vc = v->_mp_size < 0;
- rc = uc ^ vc;
-
- ux = -uc;
- vx = -vc;
- rx = -rc;
-
- rp = MPZ_REALLOC (r, un + rc);
-
- up = u->_mp_d;
- vp = v->_mp_d;
-
- i = 0;
- do
- {
- ul = (up[i] ^ ux) + uc;
- uc = ul < uc;
-
- vl = (vp[i] ^ vx) + vc;
- vc = vl < vc;
-
- rl = (ul ^ vl ^ rx) + rc;
- rc = rl < rc;
- rp[i] = rl;
- }
- while (++i < vn);
- assert (vc == 0);
-
- for (; i < un; i++)
- {
- ul = (up[i] ^ ux) + uc;
- uc = ul < uc;
-
- rl = (ul ^ ux) + rc;
- rc = rl < rc;
- rp[i] = rl;
- }
- if (rc)
- rp[un++] = rc;
- else
- un = mpn_normalized_size (rp, un);
-
- r->_mp_size = rx ? -un : un;
-}
-
-static unsigned
-gmp_popcount_limb (mp_limb_t x)
-{
- unsigned c;
-
- /* Do 16 bits at a time, to avoid limb-sized constants. */
- for (c = 0; x > 0; x >>= 16)
- {
- unsigned w = ((x >> 1) & 0x5555) + (x & 0x5555);
- w = ((w >> 2) & 0x3333) + (w & 0x3333);
- w = ((w >> 4) & 0x0f0f) + (w & 0x0f0f);
- w = (w >> 8) + (w & 0x00ff);
- c += w;
- }
- return c;
-}
-
-mp_bitcnt_t
-mpn_popcount (mp_srcptr p, mp_size_t n)
-{
- mp_size_t i;
- mp_bitcnt_t c;
-
- for (c = 0, i = 0; i < n; i++)
- c += gmp_popcount_limb (p[i]);
-
- return c;
-}
-
-mp_bitcnt_t
-mpz_popcount (const mpz_t u)
-{
- mp_size_t un;
-
- un = u->_mp_size;
-
- if (un < 0)
- return ~(mp_bitcnt_t) 0;
-
- return mpn_popcount (u->_mp_d, un);
-}
-
-mp_bitcnt_t
-mpz_hamdist (const mpz_t u, const mpz_t v)
-{
- mp_size_t un, vn, i;
- mp_limb_t uc, vc, ul, vl, comp;
- mp_srcptr up, vp;
- mp_bitcnt_t c;
-
- un = u->_mp_size;
- vn = v->_mp_size;
-
- if ( (un ^ vn) < 0)
- return ~(mp_bitcnt_t) 0;
-
- comp = - (uc = vc = (un < 0));
- if (uc)
- {
- assert (vn < 0);
- un = -un;
- vn = -vn;
- }
-
- up = u->_mp_d;
- vp = v->_mp_d;
-
- if (un < vn)
- MPN_SRCPTR_SWAP (up, un, vp, vn);
-
- for (i = 0, c = 0; i < vn; i++)
- {
- ul = (up[i] ^ comp) + uc;
- uc = ul < uc;
-
- vl = (vp[i] ^ comp) + vc;
- vc = vl < vc;
-
- c += gmp_popcount_limb (ul ^ vl);
- }
- assert (vc == 0);
-
- for (; i < un; i++)
- {
- ul = (up[i] ^ comp) + uc;
- uc = ul < uc;
-
- c += gmp_popcount_limb (ul ^ comp);
- }
-
- return c;
-}
-
-mp_bitcnt_t
-mpz_scan1 (const mpz_t u, mp_bitcnt_t starting_bit)
-{
- mp_ptr up;
- mp_size_t us, un, i;
- mp_limb_t limb, ux;
-
- us = u->_mp_size;
- un = GMP_ABS (us);
- i = starting_bit / GMP_LIMB_BITS;
-
- /* Past the end there's no 1 bits for u>=0, or an immediate 1 bit
- for u<0. Notice this test picks up any u==0 too. */
- if (i >= un)
- return (us >= 0 ? ~(mp_bitcnt_t) 0 : starting_bit);
-
- up = u->_mp_d;
- ux = 0;
- limb = up[i];
-
- if (starting_bit != 0)
- {
- if (us < 0)
- {
- ux = mpn_zero_p (up, i);
- limb = ~ limb + ux;
- ux = - (mp_limb_t) (limb >= ux);
- }
-
- /* Mask to 0 all bits before starting_bit, thus ignoring them. */
- limb &= (GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS));
- }
-
- return mpn_common_scan (limb, i, up, un, ux);
-}
-
-mp_bitcnt_t
-mpz_scan0 (const mpz_t u, mp_bitcnt_t starting_bit)
-{
- mp_ptr up;
- mp_size_t us, un, i;
- mp_limb_t limb, ux;
-
- us = u->_mp_size;
- ux = - (mp_limb_t) (us >= 0);
- un = GMP_ABS (us);
- i = starting_bit / GMP_LIMB_BITS;
-
- /* When past end, there's an immediate 0 bit for u>=0, or no 0 bits for
- u<0. Notice this test picks up all cases of u==0 too. */
- if (i >= un)
- return (ux ? starting_bit : ~(mp_bitcnt_t) 0);
-
- up = u->_mp_d;
- limb = up[i] ^ ux;
-
- if (ux == 0)
- limb -= mpn_zero_p (up, i); /* limb = ~(~limb + zero_p) */
-
- /* Mask all bits before starting_bit, thus ignoring them. */
- limb &= (GMP_LIMB_MAX << (starting_bit % GMP_LIMB_BITS));
-
- return mpn_common_scan (limb, i, up, un, ux);
-}
-
-
-/* MPZ base conversion. */
-
-size_t
-mpz_sizeinbase (const mpz_t u, int base)
-{
- mp_size_t un;
- mp_srcptr up;
- mp_ptr tp;
- mp_bitcnt_t bits;
- struct gmp_div_inverse bi;
- size_t ndigits;
-
- assert (base >= 2);
- assert (base <= 36);
-
- un = GMP_ABS (u->_mp_size);
- if (un == 0)
- return 1;
-
- up = u->_mp_d;
-
- bits = (un - 1) * GMP_LIMB_BITS + mpn_limb_size_in_base_2 (up[un-1]);
- switch (base)
- {
- case 2:
- return bits;
- case 4:
- return (bits + 1) / 2;
- case 8:
- return (bits + 2) / 3;
- case 16:
- return (bits + 3) / 4;
- case 32:
- return (bits + 4) / 5;
- /* FIXME: Do something more clever for the common case of base
- 10. */
- }
-
- tp = gmp_xalloc_limbs (un);
- mpn_copyi (tp, up, un);
- mpn_div_qr_1_invert (&bi, base);
-
- ndigits = 0;
- do
- {
- ndigits++;
- mpn_div_qr_1_preinv (tp, tp, un, &bi);
- un -= (tp[un-1] == 0);
- }
- while (un > 0);
-
- gmp_free (tp);
- return ndigits;
-}
-
-char *
-mpz_get_str (char *sp, int base, const mpz_t u)
-{
- unsigned bits;
- const char *digits;
- mp_size_t un;
- size_t i, sn;
-
- if (base >= 0)
- {
- digits = "0123456789abcdefghijklmnopqrstuvwxyz";
- }
- else
- {
- base = -base;
- digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
- }
- if (base <= 1)
- base = 10;
- if (base > 36)
- return NULL;
-
- sn = 1 + mpz_sizeinbase (u, base);
- if (!sp)
- sp = (char *) gmp_xalloc (1 + sn);
-
- un = GMP_ABS (u->_mp_size);
-
- if (un == 0)
- {
- sp[0] = '0';
- sp[1] = '\0';
- return sp;
- }
-
- i = 0;
-
- if (u->_mp_size < 0)
- sp[i++] = '-';
-
- bits = mpn_base_power_of_two_p (base);
-
- if (bits)
- /* Not modified in this case. */
- sn = i + mpn_get_str_bits ((unsigned char *) sp + i, bits, u->_mp_d, un);
- else
- {
- struct mpn_base_info info;
- mp_ptr tp;
-
- mpn_get_base_info (&info, base);
- tp = gmp_xalloc_limbs (un);
- mpn_copyi (tp, u->_mp_d, un);
-
- sn = i + mpn_get_str_other ((unsigned char *) sp + i, base, &info, tp, un);
- gmp_free (tp);
- }
-
- for (; i < sn; i++)
- sp[i] = digits[(unsigned char) sp[i]];
-
- sp[sn] = '\0';
- return sp;
-}
-
-int
-mpz_set_str (mpz_t r, const char *sp, int base)
-{
- unsigned bits;
- mp_size_t rn, alloc;
- mp_ptr rp;
- size_t sn;
- int sign;
- unsigned char *dp;
-
- assert (base == 0 || (base >= 2 && base <= 36));
-
- while (isspace( (unsigned char) *sp))
- sp++;
-
- sign = (*sp == '-');
- sp += sign;
-
- if (base == 0)
- {
- if (*sp == '0')
- {
- sp++;
- if (*sp == 'x' || *sp == 'X')
- {
- base = 16;
- sp++;
- }
- else if (*sp == 'b' || *sp == 'B')
- {
- base = 2;
- sp++;
- }
- else
- base = 8;
- }
- else
- base = 10;
- }
-
- sn = strlen (sp);
- dp = (unsigned char *) gmp_xalloc (sn + (sn == 0));
-
- for (sn = 0; *sp; sp++)
- {
- unsigned digit;
-
- if (isspace ((unsigned char) *sp))
- continue;
- if (*sp >= '0' && *sp <= '9')
- digit = *sp - '0';
- else if (*sp >= 'a' && *sp <= 'z')
- digit = *sp - 'a' + 10;
- else if (*sp >= 'A' && *sp <= 'Z')
- digit = *sp - 'A' + 10;
- else
- digit = base; /* fail */
-
- if (digit >= base)
- {
- gmp_free (dp);
- r->_mp_size = 0;
- return -1;
- }
-
- dp[sn++] = digit;
- }
-
- bits = mpn_base_power_of_two_p (base);
-
- if (bits > 0)
- {
- alloc = (sn * bits + GMP_LIMB_BITS - 1) / GMP_LIMB_BITS;
- rp = MPZ_REALLOC (r, alloc);
- rn = mpn_set_str_bits (rp, dp, sn, bits);
- }
- else
- {
- struct mpn_base_info info;
- mpn_get_base_info (&info, base);
- alloc = (sn + info.exp - 1) / info.exp;
- rp = MPZ_REALLOC (r, alloc);
- rn = mpn_set_str_other (rp, dp, sn, base, &info);
- }
- assert (rn <= alloc);
- gmp_free (dp);
-
- r->_mp_size = sign ? - rn : rn;
-
- return 0;
-}
-
-int
-mpz_init_set_str (mpz_t r, const char *sp, int base)
-{
- mpz_init (r);
- return mpz_set_str (r, sp, base);
-}
-
-size_t
-mpz_out_str (FILE *stream, int base, const mpz_t x)
-{
- char *str;
- size_t len;
-
- str = mpz_get_str (NULL, base, x);
- len = strlen (str);
- len = fwrite (str, 1, len, stream);
- gmp_free (str);
- return len;
-}
-
-
-static int
-gmp_detect_endian (void)
-{
- static const int i = 2;
- const unsigned char *p = (const unsigned char *) &i;
- return 1 - *p;
-}
-
-/* Import and export. Does not support nails. */
-void
-mpz_import (mpz_t r, size_t count, int order, size_t size, int endian,
- size_t nails, const void *src)
-{
- const unsigned char *p;
- ptrdiff_t word_step;
- mp_ptr rp;
- mp_size_t rn;
-
- /* The current (partial) limb. */
- mp_limb_t limb;
- /* The number of bytes already copied to this limb (starting from
- the low end). */
- size_t bytes;
- /* The index where the limb should be stored, when completed. */
- mp_size_t i;
-
- if (nails != 0)
- gmp_die ("mpz_import: Nails not supported.");
-
- assert (order == 1 || order == -1);
- assert (endian >= -1 && endian <= 1);
-
- if (endian == 0)
- endian = gmp_detect_endian ();
-
- p = (unsigned char *) src;
-
- word_step = (order != endian) ? 2 * size : 0;
-
- /* Process bytes from the least significant end, so point p at the
- least significant word. */
- if (order == 1)
- {
- p += size * (count - 1);
- word_step = - word_step;
- }
-
- /* And at least significant byte of that word. */
- if (endian == 1)
- p += (size - 1);
-
- rn = (size * count + sizeof(mp_limb_t) - 1) / sizeof(mp_limb_t);
- rp = MPZ_REALLOC (r, rn);
-
- for (limb = 0, bytes = 0, i = 0; count > 0; count--, p += word_step)
- {
- size_t j;
- for (j = 0; j < size; j++, p -= (ptrdiff_t) endian)
- {
- limb |= (mp_limb_t) *p << (bytes++ * CHAR_BIT);
- if (bytes == sizeof(mp_limb_t))
- {
- rp[i++] = limb;
- bytes = 0;
- limb = 0;
- }
- }
- }
- assert (i + (bytes > 0) == rn);
- if (limb != 0)
- rp[i++] = limb;
- else
- i = mpn_normalized_size (rp, i);
-
- r->_mp_size = i;
-}
-
-void *
-mpz_export (void *r, size_t *countp, int order, size_t size, int endian,
- size_t nails, const mpz_t u)
-{
- size_t count;
- mp_size_t un;
-
- if (nails != 0)
- gmp_die ("mpz_import: Nails not supported.");
-
- assert (order == 1 || order == -1);
- assert (endian >= -1 && endian <= 1);
- assert (size > 0 || u->_mp_size == 0);
-
- un = u->_mp_size;
- count = 0;
- if (un != 0)
- {
- size_t k;
- unsigned char *p;
- ptrdiff_t word_step;
- /* The current (partial) limb. */
- mp_limb_t limb;
- /* The number of bytes left to to in this limb. */
- size_t bytes;
- /* The index where the limb was read. */
- mp_size_t i;
-
- un = GMP_ABS (un);
-
- /* Count bytes in top limb. */
- limb = u->_mp_d[un-1];
- assert (limb != 0);
-
- k = 0;
- do {
- k++; limb >>= CHAR_BIT;
- } while (limb != 0);
-
- count = (k + (un-1) * sizeof (mp_limb_t) + size - 1) / size;
-
- if (!r)
- r = gmp_xalloc (count * size);
-
- if (endian == 0)
- endian = gmp_detect_endian ();
-
- p = (unsigned char *) r;
-
- word_step = (order != endian) ? 2 * size : 0;
-
- /* Process bytes from the least significant end, so point p at the
- least significant word. */
- if (order == 1)
- {
- p += size * (count - 1);
- word_step = - word_step;
- }
-
- /* And at least significant byte of that word. */
- if (endian == 1)
- p += (size - 1);
-
- for (bytes = 0, i = 0, k = 0; k < count; k++, p += word_step)
- {
- size_t j;
- for (j = 0; j < size; j++, p -= (ptrdiff_t) endian)
- {
- if (bytes == 0)
- {
- if (i < un)
- limb = u->_mp_d[i++];
- bytes = sizeof (mp_limb_t);
- }
- *p = limb;
- limb >>= CHAR_BIT;
- bytes--;
- }
- }
- assert (i == un);
- assert (k == count);
- }
-
- if (countp)
- *countp = count;
-
- return r;
-}
diff --git a/src/plugins/e-acsl/contrib/libgmp/mini-gmp.h b/src/plugins/e-acsl/contrib/libgmp/mini-gmp.h
deleted file mode 100644
index 1d9a2a2017e..00000000000
--- a/src/plugins/e-acsl/contrib/libgmp/mini-gmp.h
+++ /dev/null
@@ -1,350 +0,0 @@
-/********************************************************************************/
-/* */
-/* mini-gmp, a minimalistic implementation of a GNU GMP subset. */
-/* */
-/* Contributed to the GNU project by Niels Möller */
-/* */
-/* Copyright 1991-1997, 1999-2015 Free Software Foundation, Inc. */
-/* */
-/* This file is part of the GNU MP Library. */
-/* */
-/* The GNU MP Library is free software; you can redistribute it and/or modify */
-/* it under the terms of either: */
-/* */
-/* * the GNU Lesser General Public License as published by the Free */
-/* Software Foundation; either version 3 of the License, or (at your */
-/* option) any later version. */
-/* */
-/* or */
-/* */
-/* * the GNU General Public License as published by the Free Software */
-/* Foundation; either version 2 of the License, or (at your option) any */
-/* later version. */
-/* */
-/* or both in parallel, as here. */
-/* */
-/* The GNU MP Library is distributed in the hope that it will be useful, but */
-/* WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY */
-/* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License */
-/* for more details. */
-/* */
-/* You should have received copies of the GNU General Public License and the */
-/* GNU Lesser General Public License along with the GNU MP Library. If not, */
-/* see https://www.gnu.org/licenses/. */
-/* */
-/* File modified by CEA (Commissariat à l'énergie atomique et aux */
-/* énergies alternatives). */
-/* */
-/********************************************************************************/
-
-/* About mini-gmp: This is a minimal implementation of a subset of the
- GMP interface. It is intended for inclusion into applications which
- have modest bignums needs, as a fallback when the real GMP library
- is not installed.
-
- This file defines the public interface. */
-
-#ifndef __MINI_GMP_H__
-#define __MINI_GMP_H__
-
-#define preconcat(x,y) x ## y
-#define concat(x,y) preconcat(x,y)
-#define public_prefix __g
-#define export_alias(n) concat(public_prefix,n)
-
-/****************/
-/* Initializers */
-/****************/
-#define mpz_init export_alias(mpz_init)
-#define mpz_init_set export_alias(mpz_init_set)
-#define mpz_init_set_ui export_alias(mpz_init_set_ui)
-#define mpz_init_set_si export_alias(mpz_init_set_si)
-#define mpz_init_set_str export_alias(mpz_init_set_str)
-#define mpz_import export_alias(mpz_import)
-
-/***************/
-/* Assignments */
-/***************/
-#define mpz_set export_alias(mpz_set)
-#define mpz_set_ui export_alias(mpz_set_ui)
-#define mpz_set_si export_alias(mpz_set_si)
-
-/*************/
-/* Finalizer */
-/*************/
-#define mpz_clear export_alias(mpz_clear)
-
-/********************/
-/* Logical operator */
-/********************/
-#define mpz_cmp export_alias(mpz_cmp)
-
-/************************/
-/* Arithmetic operators */
-/************************/
-#define mpz_neg export_alias(mpz_neg)
-#define mpz_add export_alias(mpz_add)
-#define mpz_sub export_alias(mpz_sub)
-#define mpz_mul export_alias(mpz_mul)
-#define mpz_tdiv_q export_alias(mpz_tdiv_q)
-#define mpz_tdiv_r export_alias(mpz_tdiv_r)
-
-/*********************/
-/* Bitwise operators */
-/*********************/
-#define mpz_com export_alias(mpz_com)
-
-/************************/
-/* Coercions to C types */
-/************************/
-#define mpz_get_si export_alias(mpz_get_si)
-#define mpz_get_ui export_alias(mpz_get_ui)
-
-/* For size_t */
-#include <stddef.h>
-
-static void mp_set_memory_functions (void *(*) (size_t),
- void *(*) (void *, size_t, size_t),
- void (*) (void *, size_t));
-
-static void mp_get_memory_functions (void *(**) (size_t),
- void *(**) (void *, size_t, size_t),
- void (**) (void *, size_t));
-
-typedef unsigned long mp_limb_t;
-typedef long mp_size_t;
-typedef unsigned long mp_bitcnt_t;
-
-typedef mp_limb_t *mp_ptr;
-typedef const mp_limb_t *mp_srcptr;
-
-typedef struct
-{
- int _mp_alloc; /* Number of *limbs* allocated and pointed
- to by the _mp_d field. */
- int _mp_size; /* abs(_mp_size) is the number of limbs the
- last field points to. If _mp_size is
- negative this is a negative number. */
- mp_limb_t *_mp_d; /* Pointer to the limbs. */
-} __mpz_struct;
-
-typedef __mpz_struct mpz_t[1];
-
-typedef __mpz_struct *mpz_ptr;
-typedef const __mpz_struct *mpz_srcptr;
-
-static const int mp_bits_per_limb;
-
-static void mpn_copyi (mp_ptr, mp_srcptr, mp_size_t);
-static void mpn_copyd (mp_ptr, mp_srcptr, mp_size_t);
-static void mpn_zero (mp_ptr, mp_size_t);
-
-static int mpn_cmp (mp_srcptr, mp_srcptr, mp_size_t);
-static int mpn_zero_p (mp_srcptr, mp_size_t);
-
-static mp_limb_t mpn_add_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
-static mp_limb_t mpn_add_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t);
-static mp_limb_t mpn_add (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
-
-static mp_limb_t mpn_sub_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
-static mp_limb_t mpn_sub_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t);
-static mp_limb_t mpn_sub (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
-
-static mp_limb_t mpn_mul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
-static mp_limb_t mpn_addmul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
-static mp_limb_t mpn_submul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
-
-static mp_limb_t mpn_mul (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
-static void mpn_mul_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t);
-static void mpn_sqr (mp_ptr, mp_srcptr, mp_size_t);
-static int mpn_perfect_square_p (mp_srcptr, mp_size_t);
-static mp_size_t mpn_sqrtrem (mp_ptr, mp_ptr, mp_srcptr, mp_size_t);
-
-static mp_limb_t mpn_lshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int);
-static mp_limb_t mpn_rshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int);
-
-static mp_bitcnt_t mpn_scan0 (mp_srcptr, mp_bitcnt_t);
-static mp_bitcnt_t mpn_scan1 (mp_srcptr, mp_bitcnt_t);
-
-static mp_bitcnt_t mpn_popcount (mp_srcptr, mp_size_t);
-
-static mp_limb_t mpn_invert_3by2 (mp_limb_t, mp_limb_t);
-#define mpn_invert_limb(x) mpn_invert_3by2 ((x), 0)
-
-static size_t mpn_get_str (unsigned char *, int, mp_ptr, mp_size_t);
-static mp_size_t mpn_set_str (mp_ptr, const unsigned char *, size_t, int);
-
- void mpz_init (mpz_t);
-static void mpz_init2 (mpz_t, mp_bitcnt_t);
- void mpz_clear (mpz_t);
-
-#define mpz_odd_p(z) (((z)->_mp_size != 0) & (int) (z)->_mp_d[0])
-#define mpz_even_p(z) (! mpz_odd_p (z))
-
-static int mpz_sgn (const mpz_t);
-static int mpz_cmp_si (const mpz_t, long);
-static int mpz_cmp_ui (const mpz_t, unsigned long);
- int mpz_cmp (const mpz_t, const mpz_t);
-static int mpz_cmpabs_ui (const mpz_t, unsigned long);
-static int mpz_cmpabs (const mpz_t, const mpz_t);
-static int mpz_cmp_d (const mpz_t, double);
-static int mpz_cmpabs_d (const mpz_t, double);
-
-static void mpz_abs (mpz_t, const mpz_t);
- void mpz_neg (mpz_t, const mpz_t);
-static void mpz_swap (mpz_t, mpz_t);
-
-static void mpz_add_ui (mpz_t, const mpz_t, unsigned long);
- void mpz_add (mpz_t, const mpz_t, const mpz_t);
-static void mpz_sub_ui (mpz_t, const mpz_t, unsigned long);
-static void mpz_ui_sub (mpz_t, unsigned long, const mpz_t);
- void mpz_sub (mpz_t, const mpz_t, const mpz_t);
-
-static void mpz_mul_si (mpz_t, const mpz_t, long int);
-static void mpz_mul_ui (mpz_t, const mpz_t, unsigned long int);
-void mpz_mul (mpz_t, const mpz_t, const mpz_t);
-static void mpz_mul_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-static void mpz_addmul_ui (mpz_t, const mpz_t, unsigned long int);
-static void mpz_addmul (mpz_t, const mpz_t, const mpz_t);
-static void mpz_submul_ui (mpz_t, const mpz_t, unsigned long int);
-static void mpz_submul (mpz_t, const mpz_t, const mpz_t);
-
-static void mpz_cdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t);
-static void mpz_fdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t);
-static void mpz_tdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t);
-static void mpz_cdiv_q (mpz_t, const mpz_t, const mpz_t);
-static void mpz_fdiv_q (mpz_t, const mpz_t, const mpz_t);
- void mpz_tdiv_q (mpz_t, const mpz_t, const mpz_t);
-static void mpz_cdiv_r (mpz_t, const mpz_t, const mpz_t);
-static void mpz_fdiv_r (mpz_t, const mpz_t, const mpz_t);
- void mpz_tdiv_r (mpz_t, const mpz_t, const mpz_t);
-
-static void mpz_cdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-static void mpz_fdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-static void mpz_tdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-static void mpz_cdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-static void mpz_fdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-static void mpz_tdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
-
-static void mpz_mod (mpz_t, const mpz_t, const mpz_t);
-
-static void mpz_divexact (mpz_t, const mpz_t, const mpz_t);
-
-static int mpz_divisible_p (const mpz_t, const mpz_t);
-static int mpz_congruent_p (const mpz_t, const mpz_t, const mpz_t);
-
-static unsigned long mpz_cdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_fdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_tdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_cdiv_q_ui (mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_fdiv_q_ui (mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_tdiv_q_ui (mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_cdiv_r_ui (mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_fdiv_r_ui (mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_tdiv_r_ui (mpz_t, const mpz_t, unsigned long);
-static unsigned long mpz_cdiv_ui (const mpz_t, unsigned long);
-static unsigned long mpz_fdiv_ui (const mpz_t, unsigned long);
-static unsigned long mpz_tdiv_ui (const mpz_t, unsigned long);
-
-static unsigned long mpz_mod_ui (mpz_t, const mpz_t, unsigned long);
-
-static void mpz_divexact_ui (mpz_t, const mpz_t, unsigned long);
-
-static int mpz_divisible_ui_p (const mpz_t, unsigned long);
-
-static unsigned long mpz_gcd_ui (mpz_t, const mpz_t, unsigned long);
-static void mpz_gcd (mpz_t, const mpz_t, const mpz_t);
-static void mpz_gcdext (mpz_t, mpz_t, mpz_t, const mpz_t, const mpz_t);
-static void mpz_lcm_ui (mpz_t, const mpz_t, unsigned long);
-static void mpz_lcm (mpz_t, const mpz_t, const mpz_t);
-static int mpz_invert (mpz_t, const mpz_t, const mpz_t);
-
-static void mpz_sqrtrem (mpz_t, mpz_t, const mpz_t);
-static void mpz_sqrt (mpz_t, const mpz_t);
-static int mpz_perfect_square_p (const mpz_t);
-
-static void mpz_pow_ui (mpz_t, const mpz_t, unsigned long);
-static void mpz_ui_pow_ui (mpz_t, unsigned long, unsigned long);
-static void mpz_powm (mpz_t, const mpz_t, const mpz_t, const mpz_t);
-static void mpz_powm_ui (mpz_t, const mpz_t, unsigned long, const mpz_t);
-
-static void mpz_rootrem (mpz_t, mpz_t, const mpz_t, unsigned long);
-static int mpz_root (mpz_t, const mpz_t, unsigned long);
-
-static void mpz_fac_ui (mpz_t, unsigned long);
-static void mpz_bin_uiui (mpz_t, unsigned long, unsigned long);
-
-static int mpz_probab_prime_p (const mpz_t, int);
-
-static int mpz_tstbit (const mpz_t, mp_bitcnt_t);
-static void mpz_setbit (mpz_t, mp_bitcnt_t);
-static void mpz_clrbit (mpz_t, mp_bitcnt_t);
-static void mpz_combit (mpz_t, mp_bitcnt_t);
-
- void mpz_com (mpz_t, const mpz_t);
-static void mpz_and (mpz_t, const mpz_t, const mpz_t);
-static void mpz_ior (mpz_t, const mpz_t, const mpz_t);
-static void mpz_xor (mpz_t, const mpz_t, const mpz_t);
-
-static mp_bitcnt_t mpz_popcount (const mpz_t);
-static mp_bitcnt_t mpz_hamdist (const mpz_t, const mpz_t);
-static mp_bitcnt_t mpz_scan0 (const mpz_t, mp_bitcnt_t);
-static mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t);
-
-static int mpz_fits_slong_p (const mpz_t);
-static int mpz_fits_ulong_p (const mpz_t);
- long int mpz_get_si (const mpz_t);
- unsigned long int mpz_get_ui (const mpz_t);
-static double mpz_get_d (const mpz_t);
-static size_t mpz_size (const mpz_t);
-static mp_limb_t mpz_getlimbn (const mpz_t, mp_size_t);
-
-static void mpz_realloc2 (mpz_t, mp_bitcnt_t);
-static mp_srcptr mpz_limbs_read (mpz_srcptr);
-static mp_ptr mpz_limbs_modify (mpz_t, mp_size_t);
-static mp_ptr mpz_limbs_write (mpz_t, mp_size_t);
-static void mpz_limbs_finish (mpz_t, mp_size_t);
-static mpz_srcptr mpz_roinit_n (mpz_t, mp_srcptr, mp_size_t);
-
-#define MPZ_ROINIT_N(xp, xs) {{0, (xs),(xp) }}
-
- void mpz_set_si (mpz_t, signed long int);
- void mpz_set_ui (mpz_t, unsigned long int);
- void mpz_set (mpz_t, const mpz_t);
-static void mpz_set_d (mpz_t, double);
-
- void mpz_init_set_si (mpz_t, signed long int);
- void mpz_init_set_ui (mpz_t, unsigned long int);
- void mpz_init_set (mpz_t, const mpz_t);
-static void mpz_init_set_d (mpz_t, double);
-
-static size_t mpz_sizeinbase (const mpz_t, int);
-static char *mpz_get_str (char *, int, const mpz_t);
-static int mpz_set_str (mpz_t, const char *, int);
- int mpz_init_set_str (mpz_t, const char *, int);
-
-/* This long list taken from gmp.h. */
-/* For reference, "defined(EOF)" cannot be used here. In g++ 2.95.4,
- <iostream> defines EOF but not FILE. */
-#if defined (FILE) \
- || defined (H_STDIO) \
- || defined (_H_STDIO) /* AIX */ \
- || defined (_STDIO_H) /* glibc, Sun, SCO */ \
- || defined (_STDIO_H_) /* BSD, OSF */ \
- || defined (__STDIO_H) /* Borland */ \
- || defined (__STDIO_H__) /* IRIX */ \
- || defined (_STDIO_INCLUDED) /* HPUX */ \
- || defined (__dj_include_stdio_h_) /* DJGPP */ \
- || defined (_FILE_DEFINED) /* Microsoft */ \
- || defined (__STDIO__) /* Apple MPW MrC */ \
- || defined (_MSL_STDIO_H) /* Metrowerks */ \
- || defined (_STDIO_H_INCLUDED) /* QNX4 */ \
- || defined (_ISO_STDIO_ISO_H) /* Sun C++ */ \
- || defined (__STDIO_LOADED) /* VMS */
-static size_t mpz_out_str (FILE *, int, const mpz_t);
-#endif
-
- void mpz_import (mpz_t, size_t, int, size_t, int, size_t, const void *);
-static void *mpz_export (void *, size_t *, int, size_t, int, size_t, const mpz_t);
-
-#endif /* __MINI_GMP_H__ */
diff --git a/src/plugins/e-acsl/dup_functions.ml b/src/plugins/e-acsl/dup_functions.ml
index 9bcb51fe995..3b675f434bc 100644
--- a/src/plugins/e-acsl/dup_functions.ml
+++ b/src/plugins/e-acsl/dup_functions.ml
@@ -222,7 +222,7 @@ let dup_global loc actions spec bhv sound_verdict_vi kf vi new_vi =
(* Visitor *)
(* ********************************************************************** *)
-type position = Before_gmp | Gmp | After_gmp | Memory_model | Code
+type position = Before_gmp | Gmpz | After_gmp | Memory_model | Code
class dup_functions_visitor prj = object (self)
inherit Visitor.frama_c_copy prj
@@ -253,7 +253,7 @@ class dup_functions_visitor prj = object (self)
vi
method private before_memory_model = match before_memory_model with
- | Before_gmp | Gmp | After_gmp -> true
+ | Before_gmp | Gmpz | After_gmp -> true
| Memory_model | Code -> false
method private insert_libc l =
@@ -275,7 +275,7 @@ class dup_functions_visitor prj = object (self)
method private next () =
match before_memory_model with
| Before_gmp -> ()
- | Gmp -> before_memory_model <- After_gmp
+ | Gmpz -> before_memory_model <- After_gmp
| After_gmp -> ()
| Memory_model -> before_memory_model <- Code
| Code -> ()
@@ -380,8 +380,8 @@ if there are memory-related annotations.@]"
| GVarDecl(_, loc) | GFunDecl(_, _, loc) | GFun(_, loc)
when Misc.is_library_loc loc ->
(match before_memory_model with
- | Before_gmp -> before_memory_model <- Gmp
- | Gmp | Memory_model -> ()
+ | Before_gmp -> before_memory_model <- Gmpz
+ | Gmpz | Memory_model -> ()
| After_gmp -> before_memory_model <- Memory_model
| Code -> () (* still processing the GMP and memory model headers,
but reading some libc code *));
diff --git a/src/plugins/e-acsl/env.ml b/src/plugins/e-acsl/env.ml
index 8dc08c1f823..60896dd441f 100644
--- a/src/plugins/e-acsl/env.ml
+++ b/src/plugins/e-acsl/env.ml
@@ -34,44 +34,49 @@ type scope =
| Function
| Local_block
-type mpz_tbl = {
- new_exps: (varinfo * exp) Term.Map.t; (* generated mpz variables as exp from
- terms *)
- clear_stmts: stmt list; (* stmts freeing the memory before exiting the
- block *)
+type mp_tbl = {
+ new_exps: (varinfo * exp) Term.Map.t;
+ (* generated mp variables as exp from terms *)
+ clear_stmts: stmt list;
+ (* stmts freeing the memory before exiting the block *)
}
type block_info = {
- new_block_vars: varinfo list; (* generated variables local to the block *)
- new_stmts: stmt list; (* generated stmts to put at the beginning of the
- block *)
- pre_stmts: stmt list; (* stmts already inserted into the current stmt, but
- which should be before [new_stmts]. *)
+ new_block_vars: varinfo list;
+ (* generated variables local to the block *)
+ new_stmts: stmt list;
+ (* generated stmts to put at the beginning of the block *)
+ pre_stmts: stmt list;
+ (* stmts already inserted into the current stmt,
+ but which should be before [new_stmts]. *)
post_stmts: stmt list;
}
-type local_env =
- { block_info: block_info;
- mpz_tbl: mpz_tbl;
- rte: bool }
-
-type t =
- { visitor: Visitor.frama_c_visitor;
- lscope: Lscope.t;
- lscope_reset: bool;
- annotation_kind: Misc.annotation_kind;
- new_global_vars: (varinfo * localized_scope) list;
- (* generated variables. The scope indicates the level where the variable
- should be added. *)
- global_mpz_tbl: mpz_tbl;
- env_stack: local_env list;
- var_mapping: Varinfo.t Stack.t Logic_var.Map.t;
- (* records of C bindings for logic vars *)
- loop_invariants: predicate list list;
- (* list of loop invariants for each currently visited loops *)
- cpt: int; (* counter used when generating variables *) }
-
-module Varname: sig
+type local_env = {
+ block_info: block_info;
+ mp_tbl: mp_tbl;
+ rte: bool
+}
+
+type t = {
+ visitor: Visitor.frama_c_visitor;
+ lscope: Lscope.t;
+ lscope_reset: bool;
+ annotation_kind: Misc.annotation_kind;
+ new_global_vars: (varinfo * localized_scope) list;
+ (* generated variables. The scope indicates the level where the variable
+ should be added. *)
+ global_mp_tbl: mp_tbl;
+ env_stack: local_env list;
+ var_mapping: Varinfo.t Stack.t Logic_var.Map.t;
+ (* records of C bindings for logic vars *)
+ loop_invariants: predicate list list;
+ (* list of loop invariants for each currently visited loops *)
+ cpt: int;
+ (* counter used when generating variables *)
+}
+
+module Varname: sig
val get: scope:scope -> string -> string
val clear: unit -> unit
end = struct
@@ -80,7 +85,7 @@ end = struct
let tbl = H.create 7
let globals = H.create 7
- let get ~scope s =
+ let get ~scope s =
let _, u =
Extlib.make_unique_name
(fun s -> H.mem tbl s || H.mem globals s)
@@ -102,16 +107,15 @@ let empty_block =
{ new_block_vars = [];
new_stmts = [];
pre_stmts = [];
- post_stmts = []
-}
+ post_stmts = [] }
-let empty_mpz_tbl =
+let empty_mp_tbl =
{ new_exps = Term.Map.empty;
clear_stmts = [] }
let empty_local_env =
{ block_info = empty_block;
- mpz_tbl = empty_mpz_tbl;
+ mp_tbl = empty_mp_tbl;
rte = true }
let dummy =
@@ -120,7 +124,7 @@ let dummy =
lscope_reset = true;
annotation_kind = Misc.Assertion;
new_global_vars = [];
- global_mpz_tbl = empty_mpz_tbl;
+ global_mp_tbl = empty_mp_tbl;
env_stack = [];
var_mapping = Logic_var.Map.empty;
loop_invariants = [];
@@ -132,7 +136,7 @@ let empty v =
lscope_reset = true;
annotation_kind = Misc.Assertion;
new_global_vars = [];
- global_mpz_tbl = empty_mpz_tbl;
+ global_mp_tbl = empty_mp_tbl;
env_stack = [];
var_mapping = Logic_var.Map.empty;
loop_invariants = [];
@@ -194,8 +198,10 @@ let acc_list_rev acc l = List.fold_left (fun acc x -> x :: acc) acc l
let do_new_var ~loc ?(scope=Local_block) ?(name="") env t ty mk_stmts =
let local_env, tl_env = top env in
let local_block = local_env.block_info in
- let is_t = Gmpz.is_t ty in
- if is_t then Gmpz.is_now_referenced ();
+ let is_z_t = Gmp.is_z_t ty in
+ if is_z_t then Gmp.is_z_now_referenced ();
+ let is_q_t = Gmp.is_q_t ty in
+ if is_q_t then Gmp.is_q_now_referenced ();
let n = succ env.cpt in
let v =
Cil.makeVarinfo
@@ -220,50 +226,50 @@ let do_new_var ~loc ?(scope=Local_block) ?(name="") env t ty mk_stmts =
| Global | Function -> local_block.new_block_vars
| Local_block -> v :: local_block.new_block_vars
in
- let new_block =
- { new_block_vars = new_block_vars;
+ let new_block =
+ { new_block_vars = new_block_vars;
new_stmts = new_stmts;
pre_stmts = local_block.pre_stmts;
post_stmts = local_block.post_stmts
}
in
v,
- e,
- if is_t then begin
- let extend_tbl tbl =
-(* Options.feedback "memoizing %a for term %a"
- Varinfo.pretty v (fun fmt t -> match t with None -> Format.fprintf fmt
- "NONE" | Some t -> Term.pretty fmt t) t;*)
- { clear_stmts = Gmpz.clear ~loc e :: tbl.clear_stmts;
- new_exps = match t with
- | None -> tbl.new_exps
- | Some t -> Term.Map.add t (v, e) tbl.new_exps }
+ e,
+ if is_z_t || is_q_t then begin
+ let extend_tbl tbl =
+(* Options.feedback "memoizing %a for term %a"
+ Varinfo.pretty v (fun fmt t -> match t with None -> Format.fprintf fmt
+ "NONE" | Some t -> Term.pretty fmt t) t;*)
+ { clear_stmts = Gmp.clear ~loc e :: tbl.clear_stmts;
+ new_exps = match t with
+ | None -> tbl.new_exps
+ | Some t -> Term.Map.add t (v, e) tbl.new_exps }
in
match scope with
| Global | Function ->
let local_env = { local_env with block_info = new_block } in
(* also memoize the new variable, but must never be used *)
{ env with
- cpt = n;
+ cpt = n;
new_global_vars = (v, lscope) :: env.new_global_vars;
- global_mpz_tbl = extend_tbl env.global_mpz_tbl;
- env_stack = local_env :: tl_env }
+ global_mp_tbl = extend_tbl env.global_mp_tbl;
+ env_stack = local_env :: tl_env }
| Local_block ->
- let local_env =
- { block_info = new_block;
- mpz_tbl = extend_tbl local_env.mpz_tbl;
- rte = false (* must be already checked by mk_stmts *) }
+ let local_env =
+ { block_info = new_block;
+ mp_tbl = extend_tbl local_env.mp_tbl;
+ rte = false (* must be already checked by mk_stmts *) }
in
- { env with
- cpt = n;
- env_stack = local_env :: tl_env;
+ { env with
+ cpt = n;
+ env_stack = local_env :: tl_env;
new_global_vars = (v, lscope) :: env.new_global_vars }
end else
let new_global_vars = (v, lscope) :: env.new_global_vars in
- let local_env =
- { local_env with
- block_info = new_block;
- rte = false (* must be already checked by mk_stmts *) }
+ let local_env =
+ { local_env with
+ block_info = new_block;
+ rte = false (* must be already checked by mk_stmts *) }
in
{ env with
new_global_vars = new_global_vars;
@@ -285,8 +291,8 @@ let new_var ~loc ?(scope=Local_block) ?name env t ty mk_stmts =
do_new_var ~loc ~scope ?name env t ty mk_stmts
in
match scope with
- | Global | Function -> memo env.global_mpz_tbl
- | Local_block -> memo local_env.mpz_tbl
+ | Global | Function -> memo env.global_mp_tbl
+ | Local_block -> memo local_env.mp_tbl
let new_var_and_mpz_init ~loc ?scope ?name env t mk_stmts =
new_var
@@ -295,8 +301,8 @@ let new_var_and_mpz_init ~loc ?scope ?name env t mk_stmts =
?name
env
t
- (Gmpz.t ())
- (fun v e -> Gmpz.init ~loc e :: mk_stmts v e)
+ (Gmp.z_t ())
+ (fun v e -> Gmp.init ~loc e :: mk_stmts v e)
module Logic_binding = struct
@@ -316,11 +322,12 @@ module Logic_binding = struct
| Some ty -> ty
| None -> match logic_v.lv_type with
| Ctype ty -> ty
- | Linteger -> Gmpz.t ()
+ | Linteger -> Gmp.z_t ()
| Ltype _ as ty when Logic_const.is_boolean_type ty -> Cil.charType
| Ltype _ | Lvar _ | Lreal | Larrow _ as lty ->
let msg =
- Format.asprintf "logic variable of type %a" Logic_type.pretty lty
+ Format.asprintf
+ "logic variable of type %a" Logic_type.pretty lty
in
Error.not_yet msg
in
@@ -360,10 +367,10 @@ module Logic_scope = struct
else env
end
-let emitter =
+let emitter =
Emitter.create
- "E_ACSL"
- [ Emitter.Code_annot ]
+ "E_ACSL"
+ [ Emitter.Code_annot ]
~correctness:[ Options.Gmp_only.parameter ]
~tuning:[]
@@ -371,7 +378,7 @@ let add_assert env stmt annot = match current_kf env with
| None -> assert false
| Some kf ->
Queue.add
- (fun () -> Annotations.add_assert emitter ~kf stmt annot)
+ (fun () -> Annotations.add_assert emitter ~kf stmt annot)
env.visitor#get_filling_actions
let add_stmt ?(post=false) ?before env stmt =
@@ -406,7 +413,7 @@ let extend_stmt_in_place env stmt ~label block =
else
env
-let push env =
+let push env =
(* Options.feedback "push (was %d)" (List.length env.env_stack);*)
{ env with env_stack = empty_local_env :: env.env_stack }
@@ -418,7 +425,7 @@ let pop env =
let transfer ~from env = match from.env_stack, env.env_stack with
| { block_info = from_blk } :: _, ({ block_info = env_blk } as local) :: tl
->
- let new_blk =
+ let new_blk =
{ new_block_vars = from_blk.new_block_vars @ env_blk.new_block_vars;
new_stmts = from_blk.new_stmts @ env_blk.new_stmts;
pre_stmts = from_blk.pre_stmts @ env_blk.pre_stmts;
@@ -436,9 +443,9 @@ let pop_and_get ?(split=false) env stmt ~global_clear where =
let clear =
if global_clear then begin
Varname.clear ();
- env.global_mpz_tbl.clear_stmts @ local_env.mpz_tbl.clear_stmts
+ env.global_mp_tbl.clear_stmts @ local_env.mp_tbl.clear_stmts
end else
- local_env.mpz_tbl.clear_stmts
+ local_env.mp_tbl.clear_stmts
in
(* Options.feedback "clearing %d mpz (global_clear: %b)"
(List.length clear) global_clear;*)
@@ -511,23 +518,23 @@ module Context = struct
let ctx = ref []
let save env = ctx := env.new_global_vars
- let restore env =
+ let restore env =
if !ctx <> [] then begin
let vars = env.new_global_vars in
let env =
- { env with new_global_vars =
+ { env with new_global_vars =
List.filter
(fun (v, scope) ->
(match scope with
| LGlobal | LFunction _ -> true
| LLocal_block _ -> false)
&& List.for_all (fun (v', _) -> v != v') vars)
- !ctx
+ !ctx
@ vars }
in
ctx := [];
env
- end else
+ end else
env
end
@@ -536,9 +543,9 @@ end
let pretty fmt env =
let local_env, _ = top env in
Format.fprintf fmt "local new_stmts %t"
- (fun fmt ->
+ (fun fmt ->
List.iter
- (fun s -> Printer.pp_stmt fmt s)
+ (fun s -> Printer.pp_stmt fmt s)
local_env.block_info.new_stmts)
(*
diff --git a/src/plugins/e-acsl/gmp.ml b/src/plugins/e-acsl/gmp.ml
new file mode 100644
index 00000000000..3400dba2492
--- /dev/null
+++ b/src/plugins/e-acsl/gmp.ml
@@ -0,0 +1,213 @@
+(**************************************************************************)
+(* *)
+(* This file is part of the Frama-C's E-ACSL plug-in. *)
+(* *)
+(* Copyright (C) 2012-2018 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+open Cil_types
+
+(**************************************************************************)
+(***************************** mpz type ***********************************)
+(**************************************************************************)
+
+let z_t_torig_ref =
+ ref
+ { torig_name = "";
+ tname = "";
+ ttype = TVoid [];
+ treferenced = false }
+
+let z_t_struct_torig_ref =
+ ref
+ { torig_name = "";
+ tname = "";
+ ttype = TVoid [];
+ treferenced = false }
+
+let set_z_t ty = z_t_torig_ref := ty
+
+let is_z_now_referenced () = !z_t_torig_ref.treferenced <- true
+
+let z_t () = TNamed(!z_t_torig_ref, [])
+
+let z_t_ptr () = TNamed(
+ {
+ torig_name = "";
+ tname = "__e_acsl_mpz_struct *";
+ ttype = TArray(
+ TNamed(!z_t_struct_torig_ref, []),
+ Some (Cil.one ~loc:Cil_datatype.Location.unknown),
+ {scache = Not_Computed},
+ []);
+ treferenced = true;
+ },
+[])
+
+let is_z_t ty = Cil_datatype.Typ.equal ty (z_t ())
+
+(**************************************************************************)
+(***************************** mpq type ***********************************)
+(**************************************************************************)
+
+let q_t_torig_ref =
+ ref
+ { torig_name = "";
+ tname = "";
+ ttype = TVoid [];
+ treferenced = false }
+
+let set_q_t ty = q_t_torig_ref := ty
+
+let is_q_now_referenced () = !q_t_torig_ref.treferenced <- true
+
+let q_t () = TNamed(!q_t_torig_ref, [])
+let is_q_t ty = Cil_datatype.Typ.equal ty (q_t ())
+
+(**************************************************************************)
+(******************* Initialization of mpz and mpq types ******************)
+(**************************************************************************)
+
+let init_t () =
+ Options.feedback ~level:2 "initializing GMP types.";
+ let set_mp_t = object
+ inherit Cil.nopCilVisitor
+ method !vglob = function
+ | GType({ torig_name = s } as info, _) when s = "__e_acsl_mpz_t" ->
+ set_z_t info;
+ Cil.SkipChildren
+ | GType({ torig_name = s } as info, _) when s = "__e_acsl_mpq_t" ->
+ set_q_t info;
+ Cil.SkipChildren
+ | _ ->
+ Cil.SkipChildren
+ end in
+ Cil.visitCilFileSameGlobals set_mp_t (Ast.get ())
+
+(**************************************************************************)
+(************************* Calls to builtins ******************************)
+(**************************************************************************)
+
+let apply_on_var ~loc funname e =
+ let prefix =
+ let ty = Cil.typeOf e in
+ if is_z_t ty then "__gmpz_"
+ else if is_q_t ty then "__gmpq_"
+ else assert false
+ in
+ Misc.mk_call ~loc (prefix ^ funname) [ e ]
+let init ~loc e = apply_on_var "init" ~loc e
+let clear ~loc e = apply_on_var "clear" ~loc e
+
+exception Longlong of ikind
+
+let get_set_suffix_and_arg e =
+ let ty = Cil.typeOf e in
+ if is_z_t ty || is_q_t ty then "", [ e ]
+ else
+ match Cil.unrollType ty with
+ | TInt(IChar, _) ->
+ (if Cil.theMachine.Cil.theMachine.char_is_unsigned then "_ui"
+ else "_si"),
+ [ e ]
+ | TInt((IBool | IUChar | IUInt | IUShort | IULong), _) ->
+ "_ui", [ e ]
+ | TInt((ISChar | IShort | IInt | ILong), _) -> "_si", [ e ]
+ | TInt((ILongLong | IULongLong as ikind), _) -> raise (Longlong ikind)
+ | TPtr(TInt(IChar, _), _) ->
+ "_str",
+ (* decimal base for the number given as string *)
+ [ e; Cil.integer ~loc:e.eloc 10 ]
+ | TFloat((FDouble | FFloat), _) ->
+ (* FFloat is a strict subset of FDouble (modulo exceptional numbers)
+ Hence, calling [set_d] for bor of them is sound.
+ HOWEVER: the machdep MUST NOT be vulnerable to double rounding *)
+ "_d", [ e ]
+ | TFloat(FLongDouble, _) ->
+ Error.not_yet "creating gmp from long double"
+ | _ ->
+ assert false
+
+let generic_affect ~loc fname lv ev e =
+ let ty = Cil.typeOf ev in
+ if is_z_t ty then begin
+ assert
+ (* Missing cast/wrong typing happened previously *)
+ (not (is_q_t (Cil.typeOf e)));
+ let suf, args = get_set_suffix_and_arg e in
+ Misc.mk_call ~loc (fname ^ suf) (ev :: args)
+ end else if is_q_t ty then begin
+ assert
+ (* Missing cast/wrong typing happened previously *)
+ (not (is_z_t (Cil.typeOf e)));
+ (* TODO: If we try to factorize the following the above
+ then the result is different... why ?! *)
+ let suf, args = get_set_suffix_and_arg e in
+ Misc.mk_call ~loc (fname ^ suf) (ev :: args)
+ end else
+ Cil.mkStmtOneInstr ~valid_sid:true (Set(lv, e, e.eloc))
+
+let init_set ~loc lv ev e =
+ let fname =
+ let ty = Cil.typeOf ev in
+ if is_z_t ty then
+ "__gmpz_init_set"
+ else if is_q_t ty then
+ Options.fatal "no __gmpq_init_set: init then set separately"
+ else
+ ""
+ in
+ try generic_affect ~loc fname lv ev e
+ with
+ | Longlong IULongLong ->
+ (match e.enode with
+ | Lval elv ->
+ assert (is_z_t (Cil.typeOf ev));
+ let call = Misc.mk_call
+ ~loc
+ "__gmpz_import"
+ [ ev;
+ Cil.one ~loc;
+ Cil.one ~loc;
+ Cil.sizeOf ~loc (TInt(IULongLong, []));
+ Cil.zero ~loc;
+ Cil.zero ~loc;
+ Cil.mkAddrOf ~loc elv ]
+ in
+ Cil.mkStmt ~valid_sid:true (Block (Cil.mkBlock [ init ~loc ev; call ]))
+ | _ ->
+ Error.not_yet "unsigned long long expression requiring GMP")
+ | Longlong ILongLong ->
+ Error.not_yet "long long requiring GMP"
+
+let affect ~loc lv ev e =
+ let fname =
+ let ty = Cil.typeOf ev in
+ if is_z_t ty then "__gmpz_set"
+ else if is_q_t ty then "__gmpq_set"
+ else ""
+ in
+ try generic_affect ~loc fname lv ev e
+ with Longlong _ ->
+ Error.not_yet "quantification over long long and requiring GMP"
+
+(*
+Local Variables:
+compile-command: "make"
+End:
+*)
diff --git a/src/plugins/e-acsl/gmpz.mli b/src/plugins/e-acsl/gmp.mli
similarity index 62%
rename from src/plugins/e-acsl/gmpz.mli
rename to src/plugins/e-acsl/gmp.mli
index 4f1f25f47e3..f115edd1ad6 100644
--- a/src/plugins/e-acsl/gmpz.mli
+++ b/src/plugins/e-acsl/gmp.mli
@@ -24,35 +24,55 @@
open Cil_types
+(**************************************************************************)
+(******************************** Types ***********************************)
+(**************************************************************************)
+
val init_t: unit -> unit
(** Must be called before any use of GMP *)
-val set_t: typeinfo -> unit
+val set_z_t: typeinfo -> unit
+val set_q_t: typeinfo -> unit
-val t: unit -> typ
- (** type "mpz_t" *)
-val t_ptr: unit -> typ
+val z_t: unit -> typ
+(** type [mpz_t] *)
+
+val z_t_ptr: unit -> typ
(** type "_mpz_struct *" *)
-
-val is_now_referenced: unit -> unit
- (** Should be called once one variable of type "mpz_t" exists *)
-val is_t: typ -> bool
- (** is the type equal to "mpz_t"? *)
+val q_t: unit -> typ
+(** type [mpq_t] *)
+
+val is_z_now_referenced: unit -> unit
+(** Should be called once one variable of type [mpz_t] exists *)
+
+val is_q_now_referenced: unit -> unit
+(** Should be called once one variable of type [mpq_t] exists *)
+
+val is_z_t: typ -> bool
+(** is the type equal to [mpz_t]? *)
+val is_q_t: typ -> bool
+(** is the type equal to [mpq_t]? *)
+
+(**************************************************************************)
+(************************* Calls to builtins ******************************)
+(**************************************************************************)
val init: loc:location -> exp -> stmt
- (** build stmt "mpz_init(v)" *)
+(** build stmt [mpz_init(v)] or [mpq_init(v)] depending on typ of [v] *)
val init_set: loc:location -> lval -> exp -> exp -> stmt
(** [init_set x_as_lv x_as_exp e] builds stmt [x = e] or [mpz_init_set*(v, e)]
- with the good function 'set' according to the type of e *)
+ or [mpq_init_set*(v, e)] with the good function 'set'
+ according to the type of [e] *)
val clear: loc:location -> exp -> stmt
-(** build stmt "mpz_clear(v)" *)
+(** build stmt [mpz_clear(v)] or [mpq_clear(v)] depending on typ of [v] *)
val affect: loc:location -> lval -> exp -> exp -> stmt
-(** [affect x_as_lv x_as_exp e] builds stmt [x = e] or [mpz_set*(e)] with the
- good function 'set' according to the type of e *)
+(** [affect x_as_lv x_as_exp e] builds stmt [x = e] or [mpz_set*(e)]
+ or [mpq_set*(e)] with the good function 'set'
+ according to the type of [e] *)
(*
Local Variables:
diff --git a/src/plugins/e-acsl/gmpz.ml b/src/plugins/e-acsl/gmpz.ml
deleted file mode 100644
index 54e5597f325..00000000000
--- a/src/plugins/e-acsl/gmpz.ml
+++ /dev/null
@@ -1,142 +0,0 @@
-(**************************************************************************)
-(* *)
-(* This file is part of the Frama-C's E-ACSL plug-in. *)
-(* *)
-(* Copyright (C) 2012-2018 *)
-(* 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). *)
-(* *)
-(**************************************************************************)
-
-open Cil_types
-
-let t_torig_ref =
- ref
- { torig_name = "";
- tname = "";
- ttype = TVoid [];
- treferenced = false }
-let t_struct_torig_ref =
- ref
- { torig_name = "";
- tname = "";
- ttype = TVoid [];
- treferenced = false }
-
-let set_t ty = t_torig_ref := ty
-let set_t_struct ty = t_struct_torig_ref := ty
-
-let is_now_referenced () = !t_torig_ref.treferenced <- true
-
-let t () = TNamed(!t_torig_ref, [])
-let t_ptr () = TNamed(
- {
- torig_name = "";
- tname = "__e_acsl_mpz_struct *";
- ttype = TArray(
- TNamed(!t_struct_torig_ref, []),
- Some (Cil.one ~loc:Cil_datatype.Location.unknown),
- {scache = Not_Computed},
- []);
- treferenced = true;
- },
-[])
-
-let is_t ty =
- Cil_datatype.Typ.equal ty (t ()) || Cil_datatype.Typ.equal ty (t_ptr ())
-
-let apply_on_var ~loc funname e = Misc.mk_call ~loc ("__gmpz_" ^ funname) [ e ]
-let init ~loc e = apply_on_var "init" ~loc e
-let clear ~loc e = apply_on_var "clear" ~loc e
-
-exception Longlong of ikind
-
-let get_set_suffix_and_arg e =
- let ty = Cil.typeOf e in
- if is_t ty then "", [ e ]
- else
- match Cil.unrollType ty with
- | TInt(IChar, _) ->
- (if Cil.theMachine.Cil.theMachine.char_is_unsigned then "_ui"
- else "_si"),
- [ e ]
- | TInt((IBool | IUChar | IUInt | IUShort | IULong), _) ->
- "_ui", [ e ]
- | TInt((ISChar | IShort | IInt | ILong), _) -> "_si", [ e ]
- | TInt((ILongLong | IULongLong as ikind), _) -> raise (Longlong ikind)
- | TPtr(TInt(IChar, _), _) ->
- "_str",
- (* decimal base for the number given as string *)
- [ e; Cil.integer ~loc:e.eloc 10 ]
- | _ -> assert false
-
-let generic_affect ~loc fname lv ev e =
- let ty = Cil.typeOf ev in
- if is_t ty then
- let suf, args = get_set_suffix_and_arg e in
- Misc.mk_call ~loc (fname ^ suf) (ev :: args)
- else
- Cil.mkStmtOneInstr ~valid_sid:true (Set(lv, e, e.eloc))
-
-let init_set ~loc lv ev e =
- try generic_affect ~loc "__gmpz_init_set" lv ev e
- with
- | Longlong IULongLong ->
- (match e.enode with
- | Lval elv ->
- let call =
- Misc.mk_call ~loc
- "__gmpz_import"
- [ ev;
- Cil.one ~loc;
- Cil.one ~loc;
- Cil.sizeOf ~loc (TInt(IULongLong, []));
- Cil.zero ~loc;
- Cil.zero ~loc;
- Cil.mkAddrOf ~loc elv ]
- in
- Cil.mkStmt
- ~valid_sid:true
- (Block (Cil.mkBlock [ init ~loc ev; call ]))
- | _ -> Error.not_yet "unsigned long long expression requiring GMP")
- | Longlong ILongLong ->
- Error.not_yet "long long requiring GMP"
-
-let affect ~loc lv ev e =
- try generic_affect ~loc "__gmpz_set" lv ev e
- with Longlong _ ->
- Error.not_yet "quantification over long long and requiring GMP"
-
-let init_t () =
- Options.feedback ~level:2 "initializing GMP type.";
- let set_mpzt = object
- inherit Cil.nopCilVisitor
- method !vglob = function
- | GType({ torig_name = s } as info, _) when s = "__e_acsl_mpz_t" ->
- set_t info;
- Cil.SkipChildren
- | GType({ torig_name = s } as info, _) when s = "__e_acsl_mpz_struct" ->
- set_t_struct info;
- Cil.SkipChildren
- | _ ->
- Cil.SkipChildren
- end in
- Cil.visitCilFileSameGlobals set_mpzt (Ast.get ())
-
-(*
-Local Variables:
-compile-command: "make"
-End:
-*)
diff --git a/src/plugins/e-acsl/interval.ml b/src/plugins/e-acsl/interval.ml
index 5600b0b435a..8124f877b46 100644
--- a/src/plugins/e-acsl/interval.ml
+++ b/src/plugins/e-acsl/interval.ml
@@ -22,13 +22,18 @@
open Cil_types
-(* Implement Figure 3 of J. Signoles' JFLA'15 paper "Rester statique pour
- devenir plus rapide, plus précis et plus mince". *)
+(* Implements Figure 3 of J. Signoles' JFLA'15 paper "Rester statique pour
+ devenir plus rapide, plus précis et plus mince".
+ Also implements a partial support for real numbers. *)
(* ********************************************************************* *)
(* Basic datatypes and operations *)
(* ********************************************************************* *)
+exception Is_a_real
+exception Not_a_number
+(* Not_a_number has priority over Is_a_real *)
+
exception Not_an_integer
(* constructors *)
@@ -43,24 +48,31 @@ let interv_of_unknown_block =
(Some Integer.zero)
(Some (Bit_utils.max_byte_address ())))
-let rec interv_of_typ ty = match Cil.unrollType ty with
+(* The boolean indicates whether we have real numbers *)
+let rec interv_of_typ_with_real ty is_real = match Cil.unrollType ty with
| TInt (k,_) as ty ->
let n = Cil.bitsSizeOf ty in
let l, u =
if Cil.isSigned k then Cil.min_signed_number n, Cil.max_signed_number n
else Integer.zero, Cil.max_unsigned_number n
in
- Ival.inject_range (Some l) (Some u)
- | TEnum(enuminfo, _) -> interv_of_typ (TInt (enuminfo.ekind, []))
+ Ival.inject_range (Some l) (Some u), is_real
+ | TEnum(enuminfo, _) ->
+ interv_of_typ_with_real (TInt (enuminfo.ekind, [])) is_real
+ | TFloat _ ->
+ (* TODO: Do not systematically consider floats as reals for efficiency *)
+ Ival.bottom, true
+ | _ when Libr.is_t ty ->
+ Ival.bottom, true
| _ ->
- raise Not_an_integer
+ raise Not_a_number
let interv_of_logic_typ = function
- | Ctype ty -> interv_of_typ ty
- | Linteger -> Ival.inject_range None None
+ | Ctype ty -> interv_of_typ_with_real ty false
+ | Linteger -> Ival.inject_range None None, false
+ | Lreal -> Ival.bottom, true
| Ltype _ -> Error.not_yet "user-defined logic type"
| Lvar _ -> Error.not_yet "type variable"
- | Lreal -> Error.not_yet "real number"
| Larrow _ -> Error.not_yet "functional type"
let ikind_of_interv i =
@@ -102,7 +114,9 @@ end
(* Environment for handling recursive logic functions *)
and Logic_function_env: sig
- val widen: infer:(term -> Ival.t) -> term -> Ival.t -> bool * Ival.t
+ val widen:
+ infer_with_real:(term -> bool -> Ival.t * bool) -> term -> Ival.t
+ -> bool * Ival.t
val clear: unit -> unit
end = struct
@@ -128,21 +142,24 @@ end = struct
let interv_of_typ_containing_interv i =
try
let kind = ikind_of_interv i in
- interv_of_typ (TInt(kind, []))
+ interv_of_typ_with_real (TInt(kind, [])) false
with Cil.Not_representable ->
(* infinity *)
- Ival.inject_range None None
+ Ival.inject_range None None, false
- let extract_profile ~infer t = match t.term_node with
+ let extract_profile ~infer_with_real t = match t.term_node with
| Tapp(li, _, args) ->
li.l_var_info.lv_name,
List.map2
(fun param arg ->
try
- let i = infer arg in
+ (* TODO RATIONAL: what if a rational is used as argument or
+ returned? *)
+ let i, _is_real = infer_with_real arg false in
(* over-approximation of the interval to reach the fixpoint
faster, and to generate fewer specialized functions *)
- let larger_i = interv_of_typ_containing_interv i in
+ let larger_i, _is_real = interv_of_typ_containing_interv i in
+ (* TODO RATIONAL: what to do with is_real? *)
Env.add param larger_i;
larger_i
with Not_an_integer ->
@@ -153,8 +170,8 @@ end = struct
| _ ->
assert false
- let widen ~infer t i =
- let p = extract_profile ~infer t in
+ let widen ~infer_with_real t i =
+ let p = extract_profile ~infer_with_real t in
try
let old_i = LF.Hashtbl.find tbl p in
if Ival.is_included i old_i then true, old_i
@@ -173,78 +190,82 @@ end
(* Main algorithm *)
(* ********************************************************************* *)
-let infer_sizeof ty =
- try singleton_of_int (Cil.bytesSizeOf ty)
- with Cil.SizeOfError _ -> interv_of_typ Cil.theMachine.Cil.typeOfSizeOf
+let infer_sizeof ty is_real =
+ try singleton_of_int (Cil.bytesSizeOf ty), is_real
+ with Cil.SizeOfError _ ->
+ interv_of_typ_with_real Cil.theMachine.Cil.typeOfSizeOf is_real
let infer_alignof ty = singleton_of_int (Cil.bytesAlignOf ty)
-let rec infer t =
+let rec infer_with_real t is_real =
let get_cty t = match t.term_type with Ctype ty -> ty | _ -> assert false in
match t.term_node with
- | TConst (Integer (n,_)) -> Ival.inject_singleton n
+ | TConst (Integer (n,_)) -> Ival.inject_singleton n, is_real
| TConst (LChr c) ->
let n = Cil.charConstToInt c in
- Ival.inject_singleton n
+ Ival.inject_singleton n, is_real
| TConst (LEnum enumitem) ->
let rec find_idx n = function
| [] -> assert false
| ei :: l -> if ei == enumitem then n else find_idx (n + 1) l
in
let n = Integer.of_int (find_idx 0 enumitem.eihost.eitems) in
- Ival.inject_singleton n
- | TLval lv -> infer_term_lval lv
- | TSizeOf ty -> infer_sizeof ty
- | TSizeOfE t -> infer_sizeof (get_cty t)
- | TSizeOfStr str -> singleton_of_int (String.length str + 1 (* '\0' *))
- | TAlignOf ty -> infer_alignof ty
- | TAlignOfE t -> infer_alignof (get_cty t)
+ Ival.inject_singleton n, is_real
+ | TLval lv -> infer_term_lval lv is_real
+ | TSizeOf ty -> infer_sizeof ty is_real
+ | TSizeOfE t -> infer_sizeof (get_cty t) is_real
+ | TSizeOfStr str ->
+ singleton_of_int (String.length str + 1 (* '\0' *)), is_real
+ | TAlignOf ty -> infer_alignof ty, is_real
+ | TAlignOfE t -> infer_alignof (get_cty t), is_real
| TUnOp (Neg, t) ->
- Ival.neg_int (infer t)
+ let i, is_real = infer_with_real t is_real in
+ Ival.neg_int i, is_real
| TUnOp (BNot, t) ->
- Ival.bitwise_signed_not (infer t)
+ let i, is_real = infer_with_real t is_real in
+ Ival.bitwise_signed_not i, is_real
| TUnOp (LNot, _)
| TBinOp ((Lt | Gt | Le | Ge | Eq | Ne | LAnd | LOr), _, _) ->
- Ival.zero_or_one
+ Ival.zero_or_one, is_real
| TBinOp (PlusA, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.add_int i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.add_int i1 i2, is_real1 || is_real2
| TBinOp (MinusA, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.sub_int i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.sub_int i1 i2, is_real1 || is_real2
| TBinOp (Mult, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.mul i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.mul i1 i2, is_real1 || is_real2
| TBinOp (Div, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.div i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.div i1 i2, is_real1 || is_real2
| TBinOp (Mod, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.c_rem i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.c_rem i1 i2, is_real1 || is_real2
| TBinOp (Shiftlt , _, _) -> Error.not_yet "right shift"
| TBinOp (Shiftrt , _, _) -> Error.not_yet "left shift"
| TBinOp (BAnd, _, _) -> Error.not_yet "bitwise and"
| TBinOp (BXor, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.bitwise_xor i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.bitwise_xor i1 i2, is_real1 || is_real2
| TBinOp (BOr, t1, t2) ->
- let i1 = infer t1 in
- let i2 = infer t2 in
- Ival.bitwise_or i1 i2
+ let i1, is_real1 = infer_with_real t1 is_real in
+ let i2, is_real2 = infer_with_real t2 is_real in
+ Ival.bitwise_or i1 i2, is_real1 || is_real2
| TCastE (ty, t) ->
(try
- let it = infer t in
- let ity = interv_of_typ ty in
- Ival.meet it ity
- with Not_an_integer ->
+ let it, is_real1 = infer_with_real t is_real in
+ let ity, is_real2 = interv_of_typ_with_real ty is_real in
+ Ival.meet it ity, is_real1 || is_real2
+ with Not_a_number ->
if Cil.isIntegralType ty then begin
(* heterogeneous cast from a non-integral term to an integral type:
consider that one eventually gets an integral type even if it is
@@ -253,46 +274,55 @@ let rec infer t =
~once:true "possibly unsafe cast from term '%a' to type '%a'."
Printer.pp_term t
Printer.pp_typ ty;
- interv_of_typ ty
+ interv_of_typ_with_real ty is_real
end else
- raise Not_an_integer)
+ raise Not_a_number)
| Tif (_, t2, t3) ->
- let i2 = infer t2 in
- let i3 = infer t3 in
- Ival.join i2 i3
- | Tat (t, _) -> infer t
+ let i2, is_real2 = infer_with_real t2 is_real in
+ let i3, is_real3 = infer_with_real t3 is_real in
+ Ival.join i2 i3, is_real2 || is_real3
+ | Tat (t, _) ->
+ infer_with_real t is_real
| TBinOp (MinusPP, t, _) ->
(match Cil.unrollType (get_cty t) with
| TArray(_, _, { scache = Computed n (* size in bits *) }, _) ->
(* the second argument must be in the same block than [t]. Consequently
the result of the difference belongs to [0; \block_length(t)] *)
let nb_bytes = if n mod 8 = 0 then n / 8 else n / 8 + 1 in
- Ival.inject_range (Some Integer.zero) (Some (Integer.of_int nb_bytes))
- | TArray _ | TPtr _ -> Lazy.force interv_of_unknown_block
+ let i =
+ Ival.inject_range (Some Integer.zero) (Some (Integer.of_int nb_bytes))
+ in
+ i, is_real
+ | TArray _ | TPtr _ -> Lazy.force interv_of_unknown_block, is_real
| _ -> assert false)
| Tblock_length (_, t)
| Toffset(_, t) ->
(match Cil.unrollType (get_cty t) with
| TArray(_, _, { scache = Computed n (* size in bits *) }, _) ->
let nb_bytes = if n mod 8 = 0 then n / 8 else n / 8 + 1 in
- singleton_of_int nb_bytes
- | TArray _ | TPtr _ -> Lazy.force interv_of_unknown_block
+ singleton_of_int nb_bytes, is_real
+ | TArray _ | TPtr _ -> Lazy.force interv_of_unknown_block, is_real
| _ -> assert false)
- | Tnull -> singleton_of_int 0
- | TLogic_coerce (_, t) -> infer t
+ | Tnull -> singleton_of_int 0, is_real
+ | TLogic_coerce (_, t) -> infer_with_real t is_real
| Tapp (li, _, _args) ->
(match li.l_body with
| LBpred _ ->
- Ival.zero_or_one
+ Ival.zero_or_one, false
| LBterm t' ->
let rec fixpoint i =
- let is_included, new_i = Logic_function_env.widen ~infer t i in
+ let is_included, new_i =
+ Logic_function_env.widen ~infer_with_real t' i
+ in
if is_included then begin
List.iter (fun lv -> Env.remove lv) li.l_profile;
- new_i
+ (* TODO RATIONAL: check if returning [false] is correct *)
+ new_i, false
end else
- let i = infer t' in
+ (* TODO RATIONAL: check if [false] is the correct value *)
+ (* TODO RATIONAL: what if a real is returned? *)
+ let i, _ = infer_with_real t' false in
List.iter (fun lv -> Env.remove lv) li.l_profile;
fixpoint i
in
@@ -304,25 +334,28 @@ let rec infer t =
| Some ret_type -> interv_of_logic_typ ret_type)
| LBinductive _ ->
Error.not_yet "logic functions inductively defined")
+
| Tunion _ -> Error.not_yet "tset union"
| Tinter _ -> Error.not_yet "tset intersection"
| Tcomprehension (_,_,_) -> Error.not_yet "tset comprehension"
| Trange(Some n1, Some n2) ->
- let i1 = infer n1 in
- let i2 = infer n2 in
- Ival.join i1 i2
+ let i1, is_real1 = infer_with_real n1 is_real in
+ let i2, is_real2 = infer_with_real n2 is_real in
+ Ival.join i1 i2, is_real1 || is_real2
| Trange(None, _) | Trange(_, None) ->
Options.abort "unbounded ranges are not part of E-ACSl"
| Tlet (li,t) ->
let li_t = Misc.term_of_li li in
let li_v = li.l_var_info in
- let i = infer li_t in
+ let i, is_real = infer_with_real li_t is_real in
Env.add li_v i;
- let i = infer t in
+ let i, is_real = infer_with_real t is_real in
Env.remove li_v;
- i
- | TConst (LStr _ | LWStr _ | LReal _)
+ i, is_real
+ | TConst (LReal _) ->
+ Ival.bottom, true
+ | TConst (LStr _ | LWStr _)
| TBinOp (PlusPI,_,_)
| TBinOp (IndexPI,_,_)
| TBinOp (MinusPI,_,_)
@@ -334,40 +367,53 @@ let rec infer t =
| TUpdate (_,_,_)
| Ttypeof _
| Ttype _
- | Tempty_set -> raise Not_an_integer
+ | Tempty_set ->
+ raise Not_a_number
-and infer_term_lval (host, offset as tlv) =
+and infer_term_lval (host, offset as tlv) is_real =
match offset with
- | TNoOffset -> infer_term_host host
+ | TNoOffset -> infer_term_host host is_real
| _ ->
let ty = Logic_utils.logicCType (Cil.typeOfTermLval tlv) in
- interv_of_typ ty
+ interv_of_typ_with_real ty is_real
-and infer_term_host = function
+and infer_term_host thost is_real =
+ match thost with
| TVar v ->
- (try Env.find v
+ (try Env.find v, is_real
with Not_found ->
match v.lv_type with
| Linteger ->
- Ival.inject_range None None
+ Ival.inject_range None None, false
| Ctype (TFloat _) -> (* TODO: handle in MR !226 *)
raise Not_an_integer
| Lreal ->
- Error.not_yet "real numbers"
+ Ival.bottom, true
| Ctype _ ->
- interv_of_typ (Logic_utils.logicCType v.lv_type)
+ (* TODO RATIONAL: check if [false] is the correct value *)
+ interv_of_typ_with_real (Logic_utils.logicCType v.lv_type) false
| Ltype _ | Lvar _ | Larrow _ ->
Options.fatal "unexpected logic type")
- | TResult ty -> interv_of_typ ty
+ | TResult ty ->
+ interv_of_typ_with_real ty is_real
| TMem t ->
let ty = Logic_utils.logicCType t.term_type in
match Cil.unrollType ty with
- | TPtr(ty, _) | TArray(ty, _, _, _) -> interv_of_typ ty
+ | TPtr(ty, _) | TArray(ty, _, _, _) ->
+ interv_of_typ_with_real ty is_real
| _ ->
Options.fatal "unexpected type %a for term %a"
Printer.pp_typ ty
Printer.pp_term t
+let infer t =
+ let i, is_real = infer_with_real t false in
+ if is_real then raise Is_a_real else i
+
+let interv_of_typ ty =
+ let i, is_real = interv_of_typ_with_real ty false in
+ if is_real then raise Is_a_real else i
+
(*
Local Variables:
compile-command: "make"
diff --git a/src/plugins/e-acsl/interval.mli b/src/plugins/e-acsl/interval.mli
index 79ed83499b5..e28ffe653a6 100644
--- a/src/plugins/e-acsl/interval.mli
+++ b/src/plugins/e-acsl/interval.mli
@@ -28,8 +28,9 @@
outside before computing the interval of a term containing such variables
(see module {!Interval.Env}).
- It implement Figure 3 of J. Signoles' JFLA'15 paper "Rester statique pour
+ It implements Figure 3 of J. Signoles' JFLA'15 paper "Rester statique pour
devenir plus rapide, plus précis et plus mince".
+ Also implements a partial support for real numbers.
Example: consider a variable [x] of type [int] on a (strange) architecture
in which values of type [int] belongs to the interval \[-128;127\] and a
@@ -50,7 +51,8 @@
(** {3 Useful operations on intervals} *)
(* ************************************************************************** *)
-exception Not_an_integer
+exception Is_a_real
+exception Not_a_number
val ikind_of_interv: Ival.t -> Cil_types.ikind
(** @return the smallest ikind that contains the given interval.
@@ -59,7 +61,9 @@ val ikind_of_interv: Ival.t -> Cil_types.ikind
val interv_of_typ: Cil_types.typ -> Ival.t
(** @return the smallest interval which contains the given C type.
- @raise Not_an_integer if the given type is not an integral type. *)
+ @raise Is_a_real if the given type is a float type.
+ (* TODO: also return is_real=true if ty=Libr.t *)
+ @raise Not_a_number if the given type does not represent numbers. *)
(* ************************************************************************** *)
(** {3 Environment for interval computations} *)
@@ -81,8 +85,8 @@ end
val infer: Cil_types.term -> Ival.t
(** [infer t] infers the smallest possible integer interval which the values
of the term can fit in.
- @raise Not_an_integer if the type of the term is not a subtype of
- [Linteger]. *)
+ @raise Is_a_real if the term is a float or a real
+ @raise Not_a_number if the term does not represent a number. *)
(*
Local Variables:
diff --git a/src/plugins/e-acsl/libr.ml b/src/plugins/e-acsl/libr.ml
new file mode 100644
index 00000000000..9c63a81bac4
--- /dev/null
+++ b/src/plugins/e-acsl/libr.ml
@@ -0,0 +1,163 @@
+(**************************************************************************)
+(* *)
+(* This file is part of the Frama-C's E-ACSL plug-in. *)
+(* *)
+(* Copyright (C) 2012-2018 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+open Cil_types
+
+let t () =
+ (* When support for irrationals will be provided,
+ the following typ MUST be changed into a typ that can represent them.
+ It is sound to use GMPQ for the time being since irrationals
+ raise not_yet. *)
+ Gmp.q_t ()
+
+let is_t ty = Cil_datatype.Typ.equal ty (t ())
+
+(* No init_set for GMPQ: init then set separately *)
+let init_set ~loc lval vi_e e =
+ Cil.mkStmt
+ ~valid_sid:true
+ (Block (Cil.mkBlock
+ [ Gmp.init ~loc vi_e ;
+ Gmp.affect ~loc lval vi_e e ]))
+
+let mk_real ~loc ?name e env t_opt =
+ if Gmp.is_z_t (Cil.typeOf e) then
+ (* GMPQ has no builtin for creating Q from Z. Hence:
+ 1) Get the MPZ as a string: gmZ_get_str
+ 2) Set the MPQ with that string: gmpQ_set_str *)
+ Error.not_yet "reals: creating Q from Z"
+ else
+ let _, e, env = Env.new_var
+ ~loc
+ ?name
+ env
+ t_opt
+ (t ())
+ (fun vi vi_e ->
+ [ Gmp.init ~loc vi_e ;
+ Gmp.affect ~loc (Cil.var vi) vi_e e ])
+ in
+ e, env
+
+(* ACSL considers strings written in decimal expansion to be reals.
+ Yet GMPQ considers them to be double:
+ they MUST be converted into fractional representation. *)
+let normalize_str str =
+ try
+ Misc.dec_to_frac str
+ with Invalid_argument _ ->
+ Error.not_yet "number not written in decimal expansion"
+
+let cast_to_z ~loc ?name e env =
+ ignore (loc, name, e, env);
+ Error.not_yet "reals: cast from R to Z"
+
+let add_cast ~loc ?name e env ty =
+ (* TODO: The best solution would actually be to directly write all the
+ needed functions as C builtins then just call them here
+ depending on the situation at hand. *)
+ assert (is_t (Cil.typeOf e));
+ let get_double e env =
+ let _, e, env = Env.new_var
+ ~loc
+ ?name
+ env
+ None
+ Cil.doubleType
+ (fun v _ ->
+ [ Misc.mk_call ~loc ~result:(Cil.var v) "__gmpq_get_d" [ e ] ])
+ in
+ e, env
+ in
+ match ty with
+ | TFloat(FLongDouble, _) ->
+ (* The biggest floating-point type we can extract from GMPQ is double *)
+ Error.not_yet "R to long double"
+ | TFloat(FDouble, _) ->
+ get_double e env
+ | TFloat(FFloat, _) ->
+ (* There is no such thing as [get_float] in GMPQ.
+ Fortunately, [float] \subset [double].
+ HOWEVER: going through double as intermediate step might be unsound
+ since it could cause double rounding.
+ See: [Boldo2013, Sec 2.2]
+ https://hal.inria.fr/hal-00777639/document *)
+ let e, env = get_double e env in
+ Options.warning
+ ~once:true "R to float: double rounding might cause unsoundness";
+ Cil.mkCastT ~force:false ~e ~oldt:Cil.doubleType ~newt:ty, env
+ | TInt(IULongLong, _) ->
+ (* The biggest C integer type we can extract from GMP is ulong *)
+ Error.not_yet "R to unsigned long long"
+ | TInt _ ->
+ (* 1) Cast R to Z using cast_to_z
+ 2) Extract ulong from Z
+ 3) Potentially cast ulong to ty *)
+ Error.not_yet "R to TInt"
+ | _ ->
+ Error.not_yet "R to <typ>"
+
+let potentially_mk_real ~loc e env =
+ (* TODO: sounds mergeable with add_cast *)
+ if is_t (Cil.typeOf e) then e, env else mk_real ~loc e env None
+
+let cmp ~loc bop e1 e2 env t_opt =
+ let fname = "__gmpq_cmp" in
+ let name = Misc.name_of_binop bop in
+ let e1, env = potentially_mk_real ~loc e1 env in
+ let e2, env = potentially_mk_real ~loc e2 env in
+ let _, e, env = Env.new_var
+ ~loc
+ env
+ t_opt
+ ~name
+ Cil.intType
+ (fun v _ -> [ Misc.mk_call ~loc ~result:(Cil.var v) fname [ e1; e2 ] ])
+ in
+ Cil.new_exp ~loc (BinOp(bop, e, Cil.zero ~loc, Cil.intType)), env
+
+let name_arith_bop = function
+ | PlusA -> "__gmpq_add"
+ | MinusA -> "__gmpq_sub"
+ | Mult -> "__gmpq_mul"
+ | Div -> "__gmpq_div"
+ | Mod | Lt | Gt | Le | Ge | Eq | Ne | BAnd | BXor | BOr | LAnd | LOr
+ | Shiftlt | Shiftrt | PlusPI | IndexPI | MinusPI | MinusPP -> assert false
+
+let new_var_and_init ~loc ?scope ?name env t_opt mk_stmts =
+ Env.new_var
+ ~loc
+ ?scope
+ ?name
+ env
+ t_opt
+ (t ())
+ (fun v e -> Gmp.init ~loc e :: mk_stmts v e)
+
+let mk_binop ~loc bop e1 e2 env t_opt =
+ let name = name_arith_bop bop in
+ let e1, env = potentially_mk_real ~loc e1 env in
+ let e2, env = potentially_mk_real ~loc e2 env in
+ let mk_stmts _ e = [ Misc.mk_call ~loc name [ e; e1; e2 ] ] in
+ let name = Misc.name_of_binop bop in
+ let _, e, env = new_var_and_init ~loc ~name env t_opt mk_stmts in
+ e, env
\ No newline at end of file
diff --git a/src/plugins/e-acsl/libr.mli b/src/plugins/e-acsl/libr.mli
new file mode 100644
index 00000000000..e6983729510
--- /dev/null
+++ b/src/plugins/e-acsl/libr.mli
@@ -0,0 +1,70 @@
+(**************************************************************************)
+(* *)
+(* This file is part of the Frama-C's E-ACSL plug-in. *)
+(* *)
+(* Copyright (C) 2012-2018 *)
+(* 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). *)
+(* *)
+(**************************************************************************)
+
+(** Library for real numbers.
+ For the sake of maintainability, the only access to the installed
+ real library MUST be through the current module.
+ For example, if it is `libgmp` then we MUST NEVER directly call gmp
+ builtins in outer modules (eg: `Typing` or `Translate`) for handling reals.
+ This way, if we want to change `libgmp` to something else, say `mpfr`, then
+ all changes will be centralized here. *)
+
+open Cil_types
+
+val t: unit -> typ
+(** Real typ *)
+
+val is_t: typ -> bool
+(** Is the typ real? *)
+
+val mk_real: loc:location -> ?name:string -> exp -> Env.t -> term option ->
+ exp * Env.t
+(** Create a real *)
+
+val init_set: loc:location -> lval -> exp -> exp -> stmt
+(** [init_set lval lval_as_exp exp] sets [lval] to [exp] while guranteeing that
+ [lval] is properly initialized wrt the underlying real library. *)
+
+val normalize_str: string -> string
+(** Normalize the string so that it fits the representation used by the
+ underlying real library. For example, "0.1" is a real number in ACSL
+ whereas it is considered as a double by `libgmp` because it is written in
+ decimal expansion. In order to make `libgmp` consider it to be a rational,
+ it must be converted into "1/10". *)
+
+val cast_to_z: loc:location -> ?name:string -> exp -> Env.t -> exp * Env.t
+(** Assumes that the given exp is of real type and casts it into Z *)
+
+val add_cast: loc:location -> ?name:string -> exp -> Env.t -> typ ->
+ exp * Env.t
+(** Assumes that the given exp is of real type and casts it into
+ the given typ *)
+
+val mk_binop: loc:location -> binop -> exp -> exp -> Env.t -> term option ->
+ exp * Env.t
+(** Applies [binop] to the given expressions. The optional term
+ indicates whether the comparison has a correspondance in the logic. *)
+
+val cmp: loc:location -> binop -> exp -> exp -> Env.t -> term option ->
+ exp * Env.t
+(** Compares two expressions according to the given [binop]. The optional term
+ indicates whether the comparison has a correspondance in the logic. *)
\ No newline at end of file
diff --git a/src/plugins/e-acsl/logic_functions.ml b/src/plugins/e-acsl/logic_functions.ml
index 45b42e2865a..f7f83847db7 100644
--- a/src/plugins/e-acsl/logic_functions.ml
+++ b/src/plugins/e-acsl/logic_functions.ml
@@ -41,7 +41,7 @@ let term_to_exp_ref
(* @return true iff the result of the function is provided by reference as the
first extra argument at each call *)
-let result_as_extra_argument = Gmpz.is_t
+let result_as_extra_argument = Gmp.is_z_t
(* TODO: to be extended to any compound type? E.g. returning a struct is not
good practice... *)
@@ -88,7 +88,7 @@ let pred_to_block ~loc kf env ret_vi p =
(* Generate the function's body for terms. *)
let term_to_block ~loc kf env ret_ty ret_vi t =
- Typing.type_term ~use_gmp_opt:false ~ctx:(Typing.integer_ty_of_typ ret_ty) t;
+ Typing.type_term ~use_gmp_opt:false ~ctx:(Typing.number_ty_of_typ ret_ty) t;
let e, env = !term_to_exp_ref kf env t in
if Cil.isVoidType ret_ty then
(* if the function's result is a GMP, it is the first parameter of the
@@ -96,7 +96,7 @@ let term_to_block ~loc kf env ret_ty ret_vi t =
let set =
let lv_star_ret = Cil.mkMem ~addr:(Cil.evar ~loc ret_vi) ~off:NoOffset in
let star_ret = Cil.new_exp ~loc (Lval lv_star_ret) in
- Gmpz.init_set ~loc lv_star_ret star_ret e
+ Gmp.init_set ~loc lv_star_ret star_ret e
in
let return_void = Cil.mkStmt ~valid_sid:true (Return (None, loc)) in
let b, env = Env.pop_and_get env set ~global_clear:false Env.Middle in
@@ -122,12 +122,15 @@ let generate_kf ~loc fname env ret_ty params_ty li =
List.fold_right2
(fun lvi pty (params, params_ty) ->
let ty = match pty with
- | Typing.Gmp ->
+ | Typing.Gmpz ->
(* GMP's integer are arrays: consider them as pointers in function's
parameters *)
- Gmpz.t_ptr ()
+ Gmp.z_t_ptr ()
| Typing.C_type ik -> TInt(ik, [])
- | Typing.Other -> Typing.typ_of_lty lvi.lv_type
+ | Typing.Libr ->
+ (* TODO RATIONAL: implement this case *)
+ assert false
+ | Typing.Nan -> Typing.typ_of_lty lvi.lv_type
in
(* build the formals: cannot use [Cil.makeFormal] since the function
does not yet exist *)
@@ -192,7 +195,8 @@ let generate_kf ~loc fname env ret_ty params_ty li =
(match vi.vtype with
| TInt _ as ty -> Interval.Env.add lvi (Interval.interv_of_typ ty)
| ty ->
- if Gmpz.is_t ty then
+ (* TODO RATIONAL: what to do with rationals? *)
+ if Gmp.is_z_t ty then
Interval.Env.add lvi (Ival.inject_range None None));
Env.Logic_binding.add_binding env lvi vi
in
diff --git a/src/plugins/e-acsl/logic_functions.mli b/src/plugins/e-acsl/logic_functions.mli
index 3e2c0d25c90..3738f98117b 100644
--- a/src/plugins/e-acsl/logic_functions.mli
+++ b/src/plugins/e-acsl/logic_functions.mli
@@ -38,7 +38,7 @@ val reset: unit -> unit
val tapp_to_exp:
loc:location ->
- string -> Env.t -> term -> logic_info -> Typing.integer_ty list -> exp list ->
+ string -> Env.t -> term -> logic_info -> Typing.number_ty list -> exp list ->
varinfo * exp * Env.t
val add_generated_functions: global list -> global list
diff --git a/src/plugins/e-acsl/loops.ml b/src/plugins/e-acsl/loops.ml
index a6da567257a..4d44b77ef1e 100644
--- a/src/plugins/e-acsl/loops.ml
+++ b/src/plugins/e-acsl/loops.ml
@@ -142,7 +142,7 @@ let bounds_for_small_type ~loc (t1, lv, t2) =
let min, max = Misc.finite_min_and_max i in
let t1 = Logic_const.tint ~loc min in
let t2 = Logic_const.tint ~loc max in
- let ctx = Typing.integer_ty_of_typ ty in
+ let ctx = Typing.number_ty_of_typ ty in
(* we are assured that we will not have a GMP,
once again because we intersected with [ity] *)
Typing.type_term ~use_gmp_opt:false ~ctx t1;
@@ -171,8 +171,8 @@ let rec mk_nested_loops ~loc mk_innermost_block kf env lscope_vars =
bounds_for_small_type ~loc (t1, logic_x, t2)
in
let ctx =
- let ty1 = Typing.get_integer_ty t1 in
- let ty2 = Typing.get_integer_ty t2 in
+ let ty1 = Typing.get_number_ty t1 in
+ let ty2 = Typing.get_number_ty t2 in
Typing.join ty1 ty2
in
let t_plus_one ?ty t =
@@ -210,21 +210,21 @@ let rec mk_nested_loops ~loc mk_innermost_block kf env lscope_vars =
in
Typing.type_term ~use_gmp_opt:false ~ctx t2_one;
let ctx_one =
- let ty1 = Typing.get_integer_ty t1 in
- let ty2 = Typing.get_integer_ty t2_one in
+ let ty1 = Typing.get_number_ty t1 in
+ let ty2 = Typing.get_number_ty t2_one in
Typing.join ty1 ty2
in
let ty =
- try Typing.typ_of_integer_ty ctx_one
- with Typing.Not_an_integer -> assert false
+ try Typing.typ_of_number_ty ctx_one
+ with Typing.Not_a_number -> assert false
in
(* loop counter corresponding to the quantified variable *)
let var_x, x, env = Env.Logic_binding.add ~ty env logic_x in
let lv_x = var var_x in
let env = match ctx_one with
| Typing.C_type _ -> env
- | Typing.Gmp -> Env.add_stmt env (Gmpz.init ~loc x)
- | Typing.Other -> assert false
+ | Typing.Gmpz -> Env.add_stmt env (Gmp.init ~loc x)
+ | Typing.Libr | Typing.Nan -> assert false
in
(* build the inner loops and loop body *)
let body, env =
@@ -234,7 +234,7 @@ let rec mk_nested_loops ~loc mk_innermost_block kf env lscope_vars =
let e1, env = term_to_exp kf (Env.push env) t1 in
let init_blk, env = Env.pop_and_get
env
- (Gmpz.affect ~loc:e1.eloc lv_x x e1)
+ (Gmp.affect ~loc:e1.eloc lv_x x e1)
~global_clear:false
Env.Middle
in
@@ -268,7 +268,7 @@ let rec mk_nested_loops ~loc mk_innermost_block kf env lscope_vars =
let incr, env = term_to_exp kf (Env.push env) tlv_one in
let next_blk, env = Env.pop_and_get
env
- (Gmpz.affect ~loc:incr.eloc lv_x x incr)
+ (Gmp.affect ~loc:incr.eloc lv_x x incr)
~global_clear:false
Env.Middle
in
@@ -303,7 +303,9 @@ let rec mk_nested_loops ~loc mk_innermost_block kf env lscope_vars =
let ty = Typing.get_typ t in
let vi_of_lv, exp_of_lv, env = Env.Logic_binding.add ~ty env lv in
let e, env = term_to_exp kf env t in
- let let_stmt = Gmpz.init_set ~loc (Cil.var vi_of_lv) exp_of_lv e in
+ let ty = Cil.typeOf e in
+ let init_set = if Libr.is_t ty then Libr.init_set else Gmp.init_set in
+ let let_stmt = init_set ~loc (Cil.var vi_of_lv) exp_of_lv e in
let stmts, env =
mk_nested_loops ~loc mk_innermost_block kf env lscope_vars'
in
diff --git a/src/plugins/e-acsl/main.ml b/src/plugins/e-acsl/main.ml
index a78c2863e62..b506ae9f5dc 100644
--- a/src/plugins/e-acsl/main.ml
+++ b/src/plugins/e-acsl/main.ml
@@ -159,7 +159,7 @@ let generate_code =
Project.on
dup_prj
(fun () ->
- Gmpz.init_t ();
+ Gmp.init_t ();
Mmodel_analysis.reset ();
let visit prj = Visit.do_visit ~prj true in
let prj = File.create_project_from_visitor name visit in
@@ -257,7 +257,7 @@ let main () =
if Options.Check.get () then
apply_on_e_acsl_ast
(fun () ->
- Gmpz.init_t ();
+ Gmp.init_t ();
ignore (check ()))
()
diff --git a/src/plugins/e-acsl/misc.ml b/src/plugins/e-acsl/misc.ml
index 4956b8633e3..2738ea57551 100644
--- a/src/plugins/e-acsl/misc.ml
+++ b/src/plugins/e-acsl/misc.ml
@@ -315,6 +315,79 @@ let finite_min_and_max i = match Ival.min_and_max i with
| Some min, Some max -> min, max
| None, _ | _, None -> assert false
+(* Author: Frédéric Recoules
+ Complexity: Linear
+ It iterates **once** over [str] during which three cases are distinguished,
+ example for "43.567":
+ Case1: pre: no '.' has been found yet ==> copy current char into buf
+ buf: | 4 | | | | | | | | | | | |
+ | 4 | 3 | | | | | | | | | | |
+ Case2: mid: current char is '.' ==> put "/1" into buf at [(length str) - 1]
+ buf: | 4 | 3 | | | | / | 1 | | | | | |
+ Case3: post: a '.' was found ==> put current char in numerator AND '0' in den
+ buf: | 4 | 3 | 5 | | | / | 1 | 0 | | | | |
+ | 4 | 3 | 5 | 6 | | / | 1 | 0 | 0 | | | |
+ | 4 | 3 | 5 | 6 | 7 | / | 1 | 0 | 0 | 0 | | | *)
+let dec_to_frac str =
+ let rec post str len buf len' i =
+ if i = len then
+ Bytes.sub_string buf 0 len'
+ else
+ match String.unsafe_get str i with
+ | c when '0' <= c && c <= '9' ->
+ Bytes.unsafe_set buf (i - 1) c;
+ Bytes.unsafe_set buf len' '0';
+ post str len buf (len' + 1) (i + 1)
+ | _ ->
+ raise (Invalid_argument str)
+ in
+ let mid buf len =
+ Bytes.unsafe_set buf (len - 1) '/';
+ Bytes.unsafe_set buf len '1'
+ in
+ let rec pre str len buf i =
+ if i = len then
+ str
+ else
+ match String.unsafe_get str i with
+ | '.' ->
+ mid buf len;
+ post str len buf (len + 1) (i + 1)
+ | c when '0' <= c && c <= '9' ->
+ Bytes.unsafe_set buf i c;
+ pre str len buf (i + 1)
+ | _ ->
+ raise (Invalid_argument str)
+ in
+ let strlen = String.length str in
+ let buflen =
+ (* The fractional representation is at most twice as lengthy
+ as the decimal one. *)
+ 2 * strlen
+ in
+ pre str strlen (Bytes.create buflen) 0
+
+let name_of_binop = function
+ | Lt -> "lt"
+ | Gt -> "gt"
+ | Le -> "le"
+ | Ge -> "ge"
+ | Eq -> "eq"
+ | Ne -> "ne"
+ | LOr -> "or"
+ | LAnd -> "and"
+ | BOr -> "bor"
+ | BXor -> "bxor"
+ | BAnd -> "band"
+ | Shiftrt -> "shiftr"
+ | Shiftlt -> "shiftl"
+ | Mod -> "mod"
+ | Div -> "div"
+ | Mult -> "mul"
+ | PlusA -> "add"
+ | MinusA -> "sub"
+ | MinusPP | MinusPI | IndexPI | PlusPI -> assert false
+
(*
Local Variables:
compile-command: "make"
diff --git a/src/plugins/e-acsl/misc.mli b/src/plugins/e-acsl/misc.mli
index 3fd7f4c409c..b5115bf6302 100644
--- a/src/plugins/e-acsl/misc.mli
+++ b/src/plugins/e-acsl/misc.mli
@@ -98,11 +98,11 @@ val cty: logic_type -> typ
val ptr_index: ?loc:location -> ?index:exp -> exp
-> Cil_types.exp * Cil_types.exp
(** Split pointer-arithmetic expression of the type `p + i` into its
-pointer and integer parts. *)
+ pointer and integer parts. *)
val term_of_li: logic_info -> term
(** [term_of_li li] assumes that [li.l_body] matches [LBterm t]
- and returns [t]. *)
+ and returns [t]. *)
val is_set_of_ptr_or_array: logic_type -> bool
(** Checks whether the given logic type is a set of pointers. *)
@@ -122,7 +122,16 @@ type pred_or_term = PoT_pred of predicate | PoT_term of term
val mk_ptr_sizeof: typ -> location -> exp
(** [mk_ptr_sizeof ptr_typ loc] takes the pointer typ [ptr_typ] that points
- to a [typ] typ and returns [sizeof(typ)]. *)
+ to a [typ] typ and returns [sizeof(typ)]. *)
+
+val dec_to_frac: string -> string
+(** Computes the fractional representation of a decimal number.
+ Does NOT perform reduction.
+ Eg: [dec_to_frac "43.567"] evaluates to ["43567/1000"]
+ @raise [Invalid_argument] if input is not written in decimal expansion. *)
+
+val name_of_binop: binop -> string
+(** Returns the name of the given binop as a string *)
val finite_min_and_max: Ival.t -> Integer.t * Integer.t
(** [finite_min_and_max i] takes the finite ival [i] and returns its bounds *)
diff --git a/src/plugins/e-acsl/mmodel_translate.ml b/src/plugins/e-acsl/mmodel_translate.ml
index 5880b8b8024..8fc258a765b 100644
--- a/src/plugins/e-acsl/mmodel_translate.ml
+++ b/src/plugins/e-acsl/mmodel_translate.ml
@@ -190,7 +190,7 @@ let call_memory_block ~loc kf name ctx env ptr r p =
Logic_const.term ~loc (TBinOp(Mult, s, n1)) Linteger))
(Ctype typ_charptr)
in
- Typing.type_term ~use_gmp_opt:false ~ctx:Typing.other ptr;
+ Typing.type_term ~use_gmp_opt:false ~ctx:Typing.nan ptr;
let term_to_exp = !term_to_exp_ref in
let ptr, env = term_to_exp kf (Env.rte env true) ptr in
(* size *)
@@ -208,13 +208,13 @@ let call_memory_block ~loc kf name ctx env ptr r p =
Linteger
in
Typing.type_term ~use_gmp_opt:false size_term;
- let size, env = match Typing.get_integer_ty size_term with
- | Typing.Gmp ->
+ let size, env = match Typing.get_number_ty size_term with
+ | Typing.Gmpz ->
gmp_to_sizet ~loc kf env size_term p
| Typing.C_type _ ->
let size, env = term_to_exp kf env size_term in
Cil.constFold false size, env
- | Typing.Other ->
+ | Typing.Libr | Typing.Nan ->
assert false
in
(* base and base_addr *)
diff --git a/src/plugins/e-acsl/scripts/e-acsl-gcc.sh b/src/plugins/e-acsl/scripts/e-acsl-gcc.sh
index 8406aeaf9ab..92da93f8982 100755
--- a/src/plugins/e-acsl/scripts/e-acsl-gcc.sh
+++ b/src/plugins/e-acsl/scripts/e-acsl-gcc.sh
@@ -757,7 +757,7 @@ FRAMAC_FLAGS="$FRAMAC_FLAGS -variadic-no-translation"
# C, CPP and LD flags for compilation of E-ACSL-generated sources
EACSL_CFLAGS="$OPTION_EXTERNAL_ASSERT"
EACSL_CPPFLAGS="-I$EACSL_SHARE"
-EACSL_LDFLAGS="$LIBDIR/libeacsl-dlmalloc.a $LIBDIR/libeacsl-gmp.a -lm"
+EACSL_LDFLAGS="$LIBDIR/libeacsl-dlmalloc.a -lgmp -lm"
# Output file names
OUTPUT_CODE="$OPTION_OUTPUT_CODE" # E-ACSL instrumented source
diff --git a/src/plugins/e-acsl/share/e-acsl/e_acsl_gmp_api.h b/src/plugins/e-acsl/share/e-acsl/e_acsl_gmp_api.h
index 89d73da7064..2f60cf14470 100644
--- a/src/plugins/e-acsl/share/e-acsl/e_acsl_gmp_api.h
+++ b/src/plugins/e-acsl/share/e-acsl/e_acsl_gmp_api.h
@@ -38,6 +38,8 @@
#define mpz_struct export_alias(mpz_struct)
#define mpz_t export_alias(mpz_t)
+#define mpq_struct export_alias(mpq_struct)
+#define mpq_t export_alias(mpq_t)
struct mpz_struct {
int _mp_alloc;
@@ -48,6 +50,14 @@ struct mpz_struct {
typedef struct mpz_struct mpz_struct;
typedef mpz_struct (__attribute__((__FC_BUILTIN__)) mpz_t)[1];
+struct mpq_struct {
+ mpz_struct _mp_num;
+ mpz_struct _mp_den;
+};
+
+typedef struct mpq_struct mpq_struct;
+typedef mpq_struct (__attribute__((__FC_BUILTIN__)) mpq_t)[1];
+
/****************/
/* Initializers */
/****************/
@@ -61,6 +71,13 @@ typedef mpz_struct (__attribute__((__FC_BUILTIN__)) mpz_t)[1];
extern void __gmpz_init(mpz_t z)
__attribute__((FC_BUILTIN));
+/*@ requires ! \initialized(q);
+ @ ensures \valid(q);
+ @ allocates q;
+ @ assigns *q \from __e_acsl_init; */
+extern void __gmpq_init(mpq_t q)
+ __attribute__((FC_BUILTIN));
+
/*@ requires \valid_read(z_orig);
@ requires ! \initialized(z);
@ allocates z;
@@ -116,6 +133,30 @@ extern void __gmpz_import (mpz_t z, size_t, int, size_t, int, size_t, const void
extern void __gmpz_set(mpz_t z, const mpz_t z_orig)
__attribute__((FC_BUILTIN));
+/*@ requires \valid_read(q_orig);
+ @ requires \valid(q);
+ @ assigns *q \from *q_orig; */
+extern void __gmpq_set(mpq_t q, const mpq_t q_orig)
+ __attribute__((FC_BUILTIN));
+
+/*@ requires \valid(q);
+ @ assigns *q \from d; */
+extern void __gmpq_set_d(mpq_t q, double d)
+ __attribute__((FC_BUILTIN));
+
+/*@ requires \valid(q);
+ @ assigns *q \from n; */
+extern void __gmpq_set_si(mpq_t q, signed long int n)
+ __attribute__((FC_BUILTIN));
+
+/*@ allocates q;
+ @ ensures \valid(q);
+ @ ensures \initialized(q);
+ @ assigns *q \from str[0..],base;
+ @ assigns \result \from str[0..],base; */
+extern int __gmpq_set_str(mpq_t q, const char *str, int base)
+ __attribute__((FC_BUILTIN));
+
/*@ requires \valid(z);
// @ ensures z->n == n;
@ assigns *z \from n; */
@@ -138,6 +179,12 @@ extern void __gmpz_set_si(mpz_t z, signed long int n)
extern void __gmpz_clear(mpz_t x)
__attribute__((FC_BUILTIN));
+/*@ requires \valid(x);
+// @ frees x;
+ @ assigns *x \from *x; */
+extern void __gmpq_clear(mpq_t x)
+ __attribute__((FC_BUILTIN));
+
/********************/
/* Logical operator */
/********************/
@@ -148,6 +195,12 @@ extern void __gmpz_clear(mpz_t x)
extern int __gmpz_cmp(const mpz_t z1, const mpz_t z2)
__attribute__((FC_BUILTIN));
+/*@ requires \valid_read(q1);
+ @ requires \valid_read(q2);
+ @ assigns \result \from *q1, *q2; */
+extern int __gmpq_cmp(const mpq_t q1, const mpq_t q2)
+ __attribute__((FC_BUILTIN));
+
/************************/
/* Arithmetic operators */
/************************/
@@ -165,6 +218,13 @@ extern void __gmpz_neg(mpz_t z1, const mpz_t z2)
extern void __gmpz_add(mpz_t z1, const mpz_t z2, const mpz_t z3)
__attribute__((FC_BUILTIN));
+/*@ requires \valid(q1);
+ @ requires \valid_read(q2);
+ @ requires \valid_read(q3);
+ @ assigns *q1 \from *q2, *q3; */
+extern void __gmpq_add(mpq_t q1, const mpq_t q2, const mpq_t q3)
+ __attribute__((FC_BUILTIN));
+
/*@ requires \valid(z1);
@ requires \valid_read(z2);
@ requires \valid_read(z3);
@@ -172,6 +232,13 @@ extern void __gmpz_add(mpz_t z1, const mpz_t z2, const mpz_t z3)
extern void __gmpz_sub(mpz_t z1, const mpz_t z2, const mpz_t z3)
__attribute__((FC_BUILTIN));
+/*@ requires \valid(q1);
+ @ requires \valid_read(q2);
+ @ requires \valid_read(q3);
+ @ assigns *q1 \from *q2, *q3; */
+extern void __gmpq_sub(mpq_t q1, const mpq_t q2, const mpq_t q3)
+ __attribute__((FC_BUILTIN));
+
/*@ requires \valid(z1);
@ requires \valid_read(z2);
@ requires \valid_read(z3);
@@ -179,6 +246,13 @@ extern void __gmpz_sub(mpz_t z1, const mpz_t z2, const mpz_t z3)
extern void __gmpz_mul(mpz_t z1, const mpz_t z2, const mpz_t z3)
__attribute__((FC_BUILTIN));
+/*@ requires \valid(q1);
+ @ requires \valid_read(q2);
+ @ requires \valid_read(q3);
+ @ assigns *q1 \from *q2, *q3; */
+extern void __gmpq_mul(mpq_t q1, const mpq_t q2, const mpq_t q3)
+ __attribute__((FC_BUILTIN));
+
/*@ requires \valid(z1);
@ requires \valid_read(z2);
@ requires \valid_read(z3);
@@ -193,6 +267,13 @@ extern void __gmpz_tdiv_q(mpz_t z1, const mpz_t z2, const mpz_t z3)
extern void __gmpz_tdiv_r(mpz_t z1, const mpz_t z2, const mpz_t z3)
__attribute__((FC_BUILTIN));
+/*@ requires \valid(q1);
+ @ requires \valid_read(q2);
+ @ requires \valid_read(q3);
+ @ assigns *q1 \from *q2, *q3; */
+extern void __gmpq_div(mpq_t q1, const mpq_t q2, const mpq_t q3)
+ __attribute__((FC_BUILTIN));
+
/*********************/
/* Bitwise operators */
/*********************/
@@ -213,6 +294,11 @@ extern int __gmpz_com(mpz_t z1, const mpz_t z2)
extern long __gmpz_get_si(const mpz_t z)
__attribute__((FC_BUILTIN));
+/*@ requires \valid_read(q);
+ @ assigns \result \from *q; */
+extern double __gmpq_get_d(const mpq_t q)
+ __attribute__((FC_BUILTIN));
+
/*@ requires \valid_read(z);
@ assigns \result \from *z; */
extern unsigned long __gmpz_get_ui(const mpz_t z)
diff --git a/src/plugins/e-acsl/tests/bts/bts1307.i b/src/plugins/e-acsl/tests/bts/bts1307.i
index e4d5b2dfb35..2932f7253cf 100644
--- a/src/plugins/e-acsl/tests/bts/bts1307.i
+++ b/src/plugins/e-acsl/tests/bts/bts1307.i
@@ -8,9 +8,12 @@
@ behavior OverEstimate_Motoring:
@ assumes \true;
- @ ensures *Mtmax_out == *Mtmax_in + (5 - (((5 / 80) * *Mwmax) * 0.4));
+ @ ensures *Mtmax_out != *Mtmax_in + (5 - (((5 / 80) * *Mwmax) * 0.4));
@*/
void foo(float* Mtmax_in, float* Mwmax, float* Mtmax_out) {
+ /* Real semantics and floating-point semantics give different results because:
+ 1) Mtmax_out is 5.975 is in R
+ 2) The float closest to 5.975 is 5.97499999999999964472863211995 */
*Mtmax_out = *Mtmax_in + (5 - (((5 / 80) * *Mwmax) * 0.4));
}
diff --git a/src/plugins/e-acsl/tests/bts/oracle/bts1307.res.oracle b/src/plugins/e-acsl/tests/bts/oracle/bts1307.res.oracle
index 827a2632149..0491679011c 100644
--- a/src/plugins/e-acsl/tests/bts/oracle/bts1307.res.oracle
+++ b/src/plugins/e-acsl/tests/bts/oracle/bts1307.res.oracle
@@ -1,32 +1,9 @@
-[kernel:parser:decimal-float] tests/bts/bts1307.i:14: Warning:
+[kernel:parser:decimal-float] tests/bts/bts1307.i:17: Warning:
Floating-point constant 0.4 is not represented exactly. Will use 0x1.999999999999ap-2.
(warn-once: no further messages from category 'parser:decimal-float' will be emitted)
[e-acsl] beginning translation.
-[e-acsl] tests/bts/bts1307.i:23: Warning: approximating a real number by a float
-[e-acsl] tests/bts/bts1307.i:23: Warning:
- E-ACSL construct `logic functions with no definition nor reads clause'
- is not yet supported.
- Ignoring annotation.
-[e-acsl] tests/bts/bts1307.i:23: Warning: approximating a real number by a float
-[e-acsl] tests/bts/bts1307.i:23: Warning:
- E-ACSL construct `logic functions with no definition nor reads clause'
- is not yet supported.
- Ignoring annotation.
-[e-acsl] tests/bts/bts1307.i:11: Warning: approximating a real number by a float
-[e-acsl] tests/bts/bts1307.i:11: Warning:
- E-ACSL construct `logic functions with no definition nor reads clause'
- is not yet supported.
- Ignoring annotation.
-[e-acsl] tests/bts/bts1307.i:11: Warning:
- E-ACSL construct `logic functions with no definition nor reads clause'
- is not yet supported.
- Ignoring annotation.
-[e-acsl] tests/bts/bts1307.i:11: Warning:
- E-ACSL construct `logic functions with no definition nor reads clause'
- is not yet supported.
- Ignoring annotation.
-[e-acsl] tests/bts/bts1307.i:11: Warning:
- E-ACSL construct `logic functions with no definition nor reads clause'
- is not yet supported.
- Ignoring annotation.
[e-acsl] translation done in project "e-acsl".
+[eva:alarm] tests/bts/bts1307.i:11: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/bts/bts1307.i:11: Warning:
+ function __gen_e_acsl_foo, behavior OverEstimate_Motoring: postcondition got status invalid.
diff --git a/src/plugins/e-acsl/tests/bts/oracle/gen_bts1307.c b/src/plugins/e-acsl/tests/bts/oracle/gen_bts1307.c
index 4ef93d78916..c735e13f00f 100644
--- a/src/plugins/e-acsl/tests/bts/oracle/gen_bts1307.c
+++ b/src/plugins/e-acsl/tests/bts/oracle/gen_bts1307.c
@@ -10,7 +10,7 @@ extern int __e_acsl_sound_verdict;
behavior OverEstimate_Motoring:
assumes \true;
ensures
- *\old(Mtmax_out) ≡
+ *\old(Mtmax_out) ≢
*\old(Mtmax_in) + (5 - ((5 / 80) * *\old(Mwmax)) * 0.4);
*/
void __gen_e_acsl_foo(float *Mtmax_in, float *Mwmax, float *Mtmax_out);
@@ -113,83 +113,101 @@ void __gen_e_acsl_bar(float *Mtmin_in, float *Mwmin, float *Mtmin_out)
(void *)Mtmin_in,
(void *)(& Mtmin_in));
__e_acsl_assert(__gen_e_acsl_valid,(char *)"Precondition",(char *)"bar",
- (char *)"\\valid(Mtmin_in)",17);
+ (char *)"\\valid(Mtmin_in)",20);
__gen_e_acsl_valid_2 = __e_acsl_valid((void *)Mwmin,sizeof(float),
(void *)Mwmin,(void *)(& Mwmin));
__e_acsl_assert(__gen_e_acsl_valid_2,(char *)"Precondition",
- (char *)"bar",(char *)"\\valid(Mwmin)",18);
+ (char *)"bar",(char *)"\\valid(Mwmin)",21);
__gen_e_acsl_valid_3 = __e_acsl_valid((void *)Mtmin_out,sizeof(float),
(void *)Mtmin_out,
(void *)(& Mtmin_out));
__e_acsl_assert(__gen_e_acsl_valid_3,(char *)"Precondition",
- (char *)"bar",(char *)"\\valid(Mtmin_out)",19);
+ (char *)"bar",(char *)"\\valid(Mtmin_out)",22);
}
bar(Mtmin_in,Mwmin,Mtmin_out);
{
- int __gen_e_acsl_valid_read;
- int __gen_e_acsl_valid_read_2;
+ __e_acsl_mpq_t __gen_e_acsl_;
+ __e_acsl_mpq_t __gen_e_acsl__2;
+ int __gen_e_acsl_eq;
int __gen_e_acsl_and;
int __gen_e_acsl_if;
- __gen_e_acsl_valid_read = __e_acsl_valid_read((void *)__gen_e_acsl_at_2,
- sizeof(float),
- (void *)__gen_e_acsl_at_2,
- (void *)(& __gen_e_acsl_at_2));
- __e_acsl_assert(__gen_e_acsl_valid_read,(char *)"RTE",(char *)"bar",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_2)",23);
- __gen_e_acsl_valid_read_2 = __e_acsl_valid_read((void *)__gen_e_acsl_at,
- sizeof(float),
- (void *)__gen_e_acsl_at,
- (void *)(& __gen_e_acsl_at));
- __e_acsl_assert(__gen_e_acsl_valid_read_2,(char *)"RTE",(char *)"bar",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at)",23);
- if (*__gen_e_acsl_at == *__gen_e_acsl_at_2) {
- int __gen_e_acsl_valid_read_3;
- int __gen_e_acsl_valid_read_4;
- __gen_e_acsl_valid_read_3 = __e_acsl_valid_read((void *)__gen_e_acsl_at_4,
- sizeof(float),
- (void *)__gen_e_acsl_at_4,
- (void *)(& __gen_e_acsl_at_4));
- __e_acsl_assert(__gen_e_acsl_valid_read_3,(char *)"RTE",(char *)"bar",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_4)",
- 23);
- __gen_e_acsl_valid_read_4 = __e_acsl_valid_read((void *)__gen_e_acsl_at_3,
- sizeof(float),
- (void *)__gen_e_acsl_at_3,
- (void *)(& __gen_e_acsl_at_3));
- __e_acsl_assert(__gen_e_acsl_valid_read_4,(char *)"RTE",(char *)"bar",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_3)",
- 23);
- __gen_e_acsl_and = (long double)*__gen_e_acsl_at_3 < 0.85 * *__gen_e_acsl_at_4;
+ __gmpq_init(__gen_e_acsl_);
+ __gmpq_set_d(__gen_e_acsl_,(double)*__gen_e_acsl_at);
+ __gmpq_init(__gen_e_acsl__2);
+ __gmpq_set_d(__gen_e_acsl__2,(double)*__gen_e_acsl_at_2);
+ __gen_e_acsl_eq = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__2));
+ if (__gen_e_acsl_eq == 0) {
+ __e_acsl_mpq_t __gen_e_acsl__3;
+ __e_acsl_mpq_t __gen_e_acsl__4;
+ __e_acsl_mpq_t __gen_e_acsl__5;
+ __e_acsl_mpq_t __gen_e_acsl_mul;
+ int __gen_e_acsl_lt;
+ __gmpq_init(__gen_e_acsl__3);
+ __gmpq_set_d(__gen_e_acsl__3,(double)*__gen_e_acsl_at_3);
+ __gmpq_init(__gen_e_acsl__4);
+ __gmpq_set_str(__gen_e_acsl__4,"085/100",10);
+ __gmpq_init(__gen_e_acsl__5);
+ __gmpq_set_d(__gen_e_acsl__5,(double)*__gen_e_acsl_at_4);
+ __gmpq_init(__gen_e_acsl_mul);
+ __gmpq_mul(__gen_e_acsl_mul,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__4),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__5));
+ __gen_e_acsl_lt = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__3),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_mul));
+ __gen_e_acsl_and = __gen_e_acsl_lt < 0;
+ __gmpq_clear(__gen_e_acsl__3);
+ __gmpq_clear(__gen_e_acsl__4);
+ __gmpq_clear(__gen_e_acsl__5);
+ __gmpq_clear(__gen_e_acsl_mul);
}
else __gen_e_acsl_and = 0;
if (__gen_e_acsl_and) {
- int __gen_e_acsl_valid_read_5;
- __gen_e_acsl_valid_read_5 = __e_acsl_valid_read((void *)__gen_e_acsl_at_5,
- sizeof(float),
- (void *)__gen_e_acsl_at_5,
- (void *)(& __gen_e_acsl_at_5));
- __e_acsl_assert(__gen_e_acsl_valid_read_5,(char *)"RTE",(char *)"bar",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_5)",
- 23);
- __gen_e_acsl_if = (long double)*__gen_e_acsl_at_5 != 0.;
+ __e_acsl_mpq_t __gen_e_acsl__6;
+ __e_acsl_mpq_t __gen_e_acsl__7;
+ int __gen_e_acsl_ne;
+ __gmpq_init(__gen_e_acsl__6);
+ __gmpq_set_d(__gen_e_acsl__6,(double)*__gen_e_acsl_at_5);
+ __gmpq_init(__gen_e_acsl__7);
+ __gmpq_set_str(__gen_e_acsl__7,"0/1",10);
+ __gen_e_acsl_ne = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__6),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__7));
+ __gen_e_acsl_if = __gen_e_acsl_ne != 0;
+ __gmpq_clear(__gen_e_acsl__6);
+ __gmpq_clear(__gen_e_acsl__7);
}
else {
- int __gen_e_acsl_valid_read_6;
- __gen_e_acsl_valid_read_6 = __e_acsl_valid_read((void *)__gen_e_acsl_at_6,
- sizeof(float),
- (void *)__gen_e_acsl_at_6,
- (void *)(& __gen_e_acsl_at_6));
- __e_acsl_assert(__gen_e_acsl_valid_read_6,(char *)"RTE",(char *)"bar",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_6)",
- 23);
- __gen_e_acsl_if = 0.85 * *__gen_e_acsl_at_6 != 0.;
+ __e_acsl_mpq_t __gen_e_acsl__8;
+ __e_acsl_mpq_t __gen_e_acsl__9;
+ __e_acsl_mpq_t __gen_e_acsl_mul_2;
+ __e_acsl_mpq_t __gen_e_acsl__10;
+ int __gen_e_acsl_ne_2;
+ __gmpq_init(__gen_e_acsl__8);
+ __gmpq_set_str(__gen_e_acsl__8,"085/100",10);
+ __gmpq_init(__gen_e_acsl__9);
+ __gmpq_set_d(__gen_e_acsl__9,(double)*__gen_e_acsl_at_6);
+ __gmpq_init(__gen_e_acsl_mul_2);
+ __gmpq_mul(__gen_e_acsl_mul_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__8),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__9));
+ __gmpq_init(__gen_e_acsl__10);
+ __gmpq_set_str(__gen_e_acsl__10,"0/1",10);
+ __gen_e_acsl_ne_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_mul_2),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__10));
+ __gen_e_acsl_if = __gen_e_acsl_ne_2 != 0;
+ __gmpq_clear(__gen_e_acsl__8);
+ __gmpq_clear(__gen_e_acsl__9);
+ __gmpq_clear(__gen_e_acsl_mul_2);
+ __gmpq_clear(__gen_e_acsl__10);
}
__e_acsl_assert(__gen_e_acsl_if,(char *)"Postcondition",(char *)"bar",
(char *)"*\\old(Mtmin_out) == *\\old(Mtmin_in) < 0.85 * *\\old(Mwmin)?\n *\\old(Mtmin_in) != 0.:\n 0.85 * *\\old(Mwmin) != 0.",
- 23);
+ 26);
__e_acsl_delete_block((void *)(& Mtmin_out));
__e_acsl_delete_block((void *)(& Mwmin));
__e_acsl_delete_block((void *)(& Mtmin_in));
+ __gmpq_clear(__gen_e_acsl_);
+ __gmpq_clear(__gen_e_acsl__2);
return;
}
}
@@ -201,7 +219,7 @@ void __gen_e_acsl_bar(float *Mtmin_in, float *Mwmin, float *Mtmin_out)
behavior OverEstimate_Motoring:
assumes \true;
ensures
- *\old(Mtmax_out) ≡
+ *\old(Mtmax_out) ≢
*\old(Mtmax_in) + (5 - ((5 / 80) * *\old(Mwmax)) * 0.4);
*/
void __gen_e_acsl_foo(float *Mtmax_in, float *Mwmax, float *Mtmax_out)
@@ -236,36 +254,74 @@ void __gen_e_acsl_foo(float *Mtmax_in, float *Mwmax, float *Mtmax_out)
}
foo(Mtmax_in,Mwmax,Mtmax_out);
{
- int __gen_e_acsl_valid_read;
- int __gen_e_acsl_valid_read_2;
- int __gen_e_acsl_valid_read_3;
- __gen_e_acsl_valid_read = __e_acsl_valid_read((void *)__gen_e_acsl_at_3,
- sizeof(float),
- (void *)__gen_e_acsl_at_3,
- (void *)(& __gen_e_acsl_at_3));
- __e_acsl_assert(__gen_e_acsl_valid_read,(char *)"RTE",(char *)"foo",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_3)",11);
- __gen_e_acsl_valid_read_2 = __e_acsl_valid_read((void *)__gen_e_acsl_at_2,
- sizeof(float),
- (void *)__gen_e_acsl_at_2,
- (void *)(& __gen_e_acsl_at_2));
- __e_acsl_assert(__gen_e_acsl_valid_read_2,(char *)"RTE",(char *)"foo",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at_2)",11);
- __gen_e_acsl_valid_read_3 = __e_acsl_valid_read((void *)__gen_e_acsl_at,
- sizeof(float),
- (void *)__gen_e_acsl_at,
- (void *)(& __gen_e_acsl_at));
- __e_acsl_assert(__gen_e_acsl_valid_read_3,(char *)"RTE",(char *)"foo",
- (char *)"mem_access: \\valid_read(__gen_e_acsl_at)",11);
- __e_acsl_assert((long double)*__gen_e_acsl_at == *__gen_e_acsl_at_2 + (
- (long double)5 -
- ((long double)0 * *__gen_e_acsl_at_3) * 0.4),
- (char *)"Postcondition",(char *)"foo",
- (char *)"*\\old(Mtmax_out) == *\\old(Mtmax_in) + (5 - ((5 / 80) * *\\old(Mwmax)) * 0.4)",
+ __e_acsl_mpq_t __gen_e_acsl_;
+ __e_acsl_mpq_t __gen_e_acsl__2;
+ __e_acsl_mpq_t __gen_e_acsl__3;
+ __e_acsl_mpq_t __gen_e_acsl__4;
+ __e_acsl_mpq_t __gen_e_acsl__5;
+ __e_acsl_mpq_t __gen_e_acsl_div;
+ __e_acsl_mpq_t __gen_e_acsl__6;
+ __e_acsl_mpq_t __gen_e_acsl_mul;
+ __e_acsl_mpq_t __gen_e_acsl__7;
+ __e_acsl_mpq_t __gen_e_acsl_mul_2;
+ __e_acsl_mpq_t __gen_e_acsl_sub;
+ __e_acsl_mpq_t __gen_e_acsl_add;
+ int __gen_e_acsl_ne;
+ __gmpq_init(__gen_e_acsl_);
+ __gmpq_set_d(__gen_e_acsl_,(double)*__gen_e_acsl_at);
+ __gmpq_init(__gen_e_acsl__2);
+ __gmpq_set_d(__gen_e_acsl__2,(double)*__gen_e_acsl_at_2);
+ __gmpq_init(__gen_e_acsl__3);
+ __gmpq_set_str(__gen_e_acsl__3,"5",10);
+ __gmpq_init(__gen_e_acsl__4);
+ __gmpq_set_si(__gen_e_acsl__4,5L);
+ __gmpq_init(__gen_e_acsl__5);
+ __gmpq_set_si(__gen_e_acsl__5,80L);
+ __gmpq_init(__gen_e_acsl_div);
+ __gmpq_div(__gen_e_acsl_div,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__4),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__5));
+ __gmpq_init(__gen_e_acsl__6);
+ __gmpq_set_d(__gen_e_acsl__6,(double)*__gen_e_acsl_at_3);
+ __gmpq_init(__gen_e_acsl_mul);
+ __gmpq_mul(__gen_e_acsl_mul,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_div),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__6));
+ __gmpq_init(__gen_e_acsl__7);
+ __gmpq_set_str(__gen_e_acsl__7,"04/10",10);
+ __gmpq_init(__gen_e_acsl_mul_2);
+ __gmpq_mul(__gen_e_acsl_mul_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_mul),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__7));
+ __gmpq_init(__gen_e_acsl_sub);
+ __gmpq_sub(__gen_e_acsl_sub,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__3),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_mul_2));
+ __gmpq_init(__gen_e_acsl_add);
+ __gmpq_add(__gen_e_acsl_add,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__2),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_sub));
+ __gen_e_acsl_ne = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add));
+ __e_acsl_assert(__gen_e_acsl_ne != 0,(char *)"Postcondition",
+ (char *)"foo",
+ (char *)"*\\old(Mtmax_out) != *\\old(Mtmax_in) + (5 - ((5 / 80) * *\\old(Mwmax)) * 0.4)",
11);
__e_acsl_delete_block((void *)(& Mtmax_out));
__e_acsl_delete_block((void *)(& Mwmax));
__e_acsl_delete_block((void *)(& Mtmax_in));
+ __gmpq_clear(__gen_e_acsl_);
+ __gmpq_clear(__gen_e_acsl__2);
+ __gmpq_clear(__gen_e_acsl__3);
+ __gmpq_clear(__gen_e_acsl__4);
+ __gmpq_clear(__gen_e_acsl__5);
+ __gmpq_clear(__gen_e_acsl_div);
+ __gmpq_clear(__gen_e_acsl__6);
+ __gmpq_clear(__gen_e_acsl_mul);
+ __gmpq_clear(__gen_e_acsl__7);
+ __gmpq_clear(__gen_e_acsl_mul_2);
+ __gmpq_clear(__gen_e_acsl_sub);
+ __gmpq_clear(__gen_e_acsl_add);
return;
}
}
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/cast.0.res.oracle b/src/plugins/e-acsl/tests/gmp/oracle/cast.0.res.oracle
index 5c148f1d7d9..d8923c033f8 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/cast.0.res.oracle
+++ b/src/plugins/e-acsl/tests/gmp/oracle/cast.0.res.oracle
@@ -1,6 +1,7 @@
[e-acsl] beginning translation.
-[e-acsl] Warning: possibly unsafe cast from term '0.1' to type 'int'.
-[e-acsl] tests/gmp/cast.i:23: Warning: approximating a real number by a float
+[e-acsl] Warning: R to float: double rounding might cause unsoundness
+[e-acsl] tests/gmp/cast.i:23: Warning:
+ E-ACSL construct `R to TInt' is not yet supported. Ignoring annotation.
[e-acsl] translation done in project "e-acsl".
[eva] Analyzing a complete application starting at main
[eva] Computing initial state
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/cast.1.res.oracle b/src/plugins/e-acsl/tests/gmp/oracle/cast.1.res.oracle
index c64fa162695..57d1fdcd6fe 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/cast.1.res.oracle
+++ b/src/plugins/e-acsl/tests/gmp/oracle/cast.1.res.oracle
@@ -1,6 +1,7 @@
[e-acsl] beginning translation.
-[e-acsl] Warning: possibly unsafe cast from term '0.1' to type 'int'.
-[e-acsl] tests/gmp/cast.i:23: Warning: approximating a real number by a float
+[e-acsl] Warning: R to float: double rounding might cause unsoundness
+[e-acsl] tests/gmp/cast.i:23: Warning:
+ E-ACSL construct `R to TInt' is not yet supported. Ignoring annotation.
[e-acsl] translation done in project "e-acsl".
[eva] Analyzing a complete application starting at main
[eva] Computing initial state
@@ -31,10 +32,4 @@
function __e_acsl_assert: precondition got status unknown.
[eva:alarm] tests/gmp/cast.i:18: Warning:
function __e_acsl_assert: precondition got status unknown.
-[eva:alarm] tests/gmp/cast.i:23: Warning:
- function __e_acsl_assert: precondition got status unknown.
-[eva:alarm] tests/gmp/cast.i:23: Warning:
- accessing out of bounds index. assert 0 ≤ __gen_e_acsl_cast_9;
-[eva:alarm] tests/gmp/cast.i:23: Warning:
- accessing out of bounds index. assert __gen_e_acsl_cast_9 < 2;
[eva] done for function main
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/gen_cast.c b/src/plugins/e-acsl/tests/gmp/oracle/gen_cast.c
index 2518d42c41a..134e920276e 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/gen_cast.c
+++ b/src/plugins/e-acsl/tests/gmp/oracle/gen_cast.c
@@ -28,9 +28,7 @@ int main(void)
(char *)"(unsigned int)y != (unsigned int)0xfffffffffffffff",
18);
int t[2] = {0, 1};
- /*@ assert (float)x ≡ t[(int)0.1]; */
- __e_acsl_assert((float)x == (float)t[0],(char *)"Assertion",(char *)"main",
- (char *)"(float)x == t[(int)0.1]",23);
+ /*@ assert (float)x ≡ t[(int)0.1]; */ ;
__retres = 0;
return __retres;
}
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/gen_cast2.c b/src/plugins/e-acsl/tests/gmp/oracle/gen_cast2.c
index b511e029f62..30144953b68 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/gen_cast2.c
+++ b/src/plugins/e-acsl/tests/gmp/oracle/gen_cast2.c
@@ -135,38 +135,7 @@ int main(void)
__gmpz_clear(__gen_e_acsl__12);
}
int t[2] = {0, 1};
- /*@ assert (float)x ≡ t[(int)0.1]; */
- {
- __e_acsl_mpz_t __gen_e_acsl__13;
- long __gen_e_acsl_cast_9;
- __e_acsl_mpz_t __gen_e_acsl___gen_e_acsl_cast_9;
- __e_acsl_mpz_t __gen_e_acsl__14;
- int __gen_e_acsl_lt;
- __e_acsl_mpz_t __gen_e_acsl__15;
- int __gen_e_acsl_le;
- __gmpz_init_set_si(__gen_e_acsl__13,(long)0.1);
- __gen_e_acsl_cast_9 = __gmpz_get_si((__e_acsl_mpz_struct const *)(__gen_e_acsl__13));
- __gmpz_init_set_si(__gen_e_acsl___gen_e_acsl_cast_9,__gen_e_acsl_cast_9);
- __gmpz_init_set_si(__gen_e_acsl__14,2L);
- __gen_e_acsl_lt = __gmpz_cmp((__e_acsl_mpz_struct const *)(__gen_e_acsl___gen_e_acsl_cast_9),
- (__e_acsl_mpz_struct const *)(__gen_e_acsl__14));
- __e_acsl_assert(__gen_e_acsl_lt < 0,(char *)"RTE",(char *)"main",
- (char *)"index_bound: __gen_e_acsl_cast_9 < 2",23);
- __gmpz_init_set_si(__gen_e_acsl__15,0L);
- __gen_e_acsl_le = __gmpz_cmp((__e_acsl_mpz_struct const *)(__gen_e_acsl__15),
- (__e_acsl_mpz_struct const *)(__gen_e_acsl___gen_e_acsl_cast_9));
- __e_acsl_assert(__gen_e_acsl_le <= 0,(char *)"RTE",(char *)"main",
- (char *)"index_bound: 0 <= __gen_e_acsl_cast_9",23);
- /*@ assert Eva: index_bound: 0 ≤ __gen_e_acsl_cast_9; */
- /*@ assert Eva: index_bound: __gen_e_acsl_cast_9 < 2; */
- __e_acsl_assert((float)x == (float)t[__gen_e_acsl_cast_9],
- (char *)"Assertion",(char *)"main",
- (char *)"(float)x == t[(int)0.1]",23);
- __gmpz_clear(__gen_e_acsl__13);
- __gmpz_clear(__gen_e_acsl___gen_e_acsl_cast_9);
- __gmpz_clear(__gen_e_acsl__14);
- __gmpz_clear(__gen_e_acsl__15);
- }
+ /*@ assert (float)x ≡ t[(int)0.1]; */ ;
__retres = 0;
return __retres;
}
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/gen_let.c b/src/plugins/e-acsl/tests/gmp/oracle/gen_let.c
index 33945c99959..d5b5c352ae2 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/gen_let.c
+++ b/src/plugins/e-acsl/tests/gmp/oracle/gen_let.c
@@ -92,10 +92,19 @@ int main(void)
__e_acsl_full_init((void *)(& f));
/*@ assert \let u = f; u ≡ f; */
{
- float __gen_e_acsl_u_10;
- __gen_e_acsl_u_10 = f;
- __e_acsl_assert(__gen_e_acsl_u_10 == f,(char *)"Assertion",
- (char *)"main",(char *)"\\let u = f; u == f",27);
+ __e_acsl_mpq_t __gen_e_acsl_u_10;
+ __e_acsl_mpq_t __gen_e_acsl_f;
+ int __gen_e_acsl_eq;
+ __gmpq_init(__gen_e_acsl_u_10);
+ __gmpq_set_d(__gen_e_acsl_u_10,(double)f);
+ __gmpq_init(__gen_e_acsl_f);
+ __gmpq_set_d(__gen_e_acsl_f,(double)f);
+ __gen_e_acsl_eq = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_u_10),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_f));
+ __e_acsl_assert(__gen_e_acsl_eq == 0,(char *)"Assertion",(char *)"main",
+ (char *)"\\let u = f; u == f",27);
+ __gmpq_clear(__gen_e_acsl_u_10);
+ __gmpq_clear(__gen_e_acsl_f);
}
int t[4] = {1, 2, 3, 4};
/*@ assert \let u = &t[1]; 1 ≡ 1; */
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/gen_let2.c b/src/plugins/e-acsl/tests/gmp/oracle/gen_let2.c
index 4acc2f23cf5..bda19038bd3 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/gen_let2.c
+++ b/src/plugins/e-acsl/tests/gmp/oracle/gen_let2.c
@@ -206,22 +206,31 @@ int main(void)
__e_acsl_full_init((void *)(& f));
/*@ assert \let u = f; u ≡ f; */
{
- float __gen_e_acsl_u_14;
- __gen_e_acsl_u_14 = f;
- __e_acsl_assert(__gen_e_acsl_u_14 == f,(char *)"Assertion",
+ __e_acsl_mpq_t __gen_e_acsl_u_14;
+ __e_acsl_mpq_t __gen_e_acsl_f;
+ int __gen_e_acsl_eq_4;
+ __gmpq_init(__gen_e_acsl_u_14);
+ __gmpq_set_d(__gen_e_acsl_u_14,(double)f);
+ __gmpq_init(__gen_e_acsl_f);
+ __gmpq_set_d(__gen_e_acsl_f,(double)f);
+ __gen_e_acsl_eq_4 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_u_14),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_f));
+ __e_acsl_assert(__gen_e_acsl_eq_4 == 0,(char *)"Assertion",
(char *)"main",(char *)"\\let u = f; u == f",27);
+ __gmpq_clear(__gen_e_acsl_u_14);
+ __gmpq_clear(__gen_e_acsl_f);
}
int t[4] = {1, 2, 3, 4};
/*@ assert \let u = &t[1]; 1 ≡ 1; */
{
int * /*[4]*/ __gen_e_acsl_u_15;
__e_acsl_mpz_t __gen_e_acsl__10;
- int __gen_e_acsl_eq_4;
+ int __gen_e_acsl_eq_5;
__gen_e_acsl_u_15 = & t[1];
__gmpz_init_set_si(__gen_e_acsl__10,1L);
- __gen_e_acsl_eq_4 = __gmpz_cmp((__e_acsl_mpz_struct const *)(__gen_e_acsl__10),
+ __gen_e_acsl_eq_5 = __gmpz_cmp((__e_acsl_mpz_struct const *)(__gen_e_acsl__10),
(__e_acsl_mpz_struct const *)(__gen_e_acsl__10));
- __e_acsl_assert(__gen_e_acsl_eq_4 == 0,(char *)"Assertion",
+ __e_acsl_assert(__gen_e_acsl_eq_5 == 0,(char *)"Assertion",
(char *)"main",(char *)"\\let u = &t[1]; 1 == 1",30);
__gmpz_clear(__gen_e_acsl__10);
}
@@ -242,7 +251,7 @@ int main(void)
__e_acsl_mpz_t __gen_e_acsl__12;
__e_acsl_mpz_t __gen_e_acsl_add_5;
__e_acsl_mpz_t __gen_e_acsl__13;
- int __gen_e_acsl_eq_5;
+ int __gen_e_acsl_eq_6;
__gen_e_acsl_u_17 = r;
__gmpz_init_set_si(__gen_e_acsl__11,(long)__gen_e_acsl_u_17.x);
__gmpz_init_set_si(__gen_e_acsl__12,(long)__gen_e_acsl_u_17.y);
@@ -251,9 +260,9 @@ int main(void)
(__e_acsl_mpz_struct const *)(__gen_e_acsl__11),
(__e_acsl_mpz_struct const *)(__gen_e_acsl__12));
__gmpz_init_set_si(__gen_e_acsl__13,3L);
- __gen_e_acsl_eq_5 = __gmpz_cmp((__e_acsl_mpz_struct const *)(__gen_e_acsl_add_5),
+ __gen_e_acsl_eq_6 = __gmpz_cmp((__e_acsl_mpz_struct const *)(__gen_e_acsl_add_5),
(__e_acsl_mpz_struct const *)(__gen_e_acsl__13));
- __e_acsl_assert(__gen_e_acsl_eq_5 == 0,(char *)"Assertion",
+ __e_acsl_assert(__gen_e_acsl_eq_6 == 0,(char *)"Assertion",
(char *)"main",(char *)"\\let u = r; u.x + u.y == 3",35);
__gmpz_clear(__gen_e_acsl__11);
__gmpz_clear(__gen_e_acsl__12);
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/gen_reals.c b/src/plugins/e-acsl/tests/gmp/oracle/gen_reals.c
new file mode 100644
index 00000000000..6bba81c1a89
--- /dev/null
+++ b/src/plugins/e-acsl/tests/gmp/oracle/gen_reals.c
@@ -0,0 +1,355 @@
+/* Generated by Frama-C */
+#include "stdio.h"
+#include "stdlib.h"
+/*@ ensures \let delta = 1;
+ \let avg_real = (\old(a) + \old(b)) / 2;
+ avg_real - delta < \result < avg_real + delta;
+ */
+double __gen_e_acsl_avg(double a, double b);
+
+double avg(double a, double b)
+{
+ double __retres;
+ __retres = (a + b) / (double)2;
+ return __retres;
+}
+
+int main(void)
+{
+ int __retres;
+ __e_acsl_memory_init((int *)0,(char ***)0,(size_t)8);
+ /*@ assert 3 ≢ 1.5; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl_;
+ __e_acsl_mpq_t __gen_e_acsl__2;
+ int __gen_e_acsl_ne;
+ __gmpq_init(__gen_e_acsl_);
+ __gmpq_set_str(__gen_e_acsl_,"3",10);
+ __gmpq_init(__gen_e_acsl__2);
+ __gmpq_set_str(__gen_e_acsl__2,"15/10",10);
+ __gen_e_acsl_ne = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__2));
+ __e_acsl_assert(__gen_e_acsl_ne != 0,(char *)"Assertion",(char *)"main",
+ (char *)"3 != 1.5",14);
+ __gmpq_clear(__gen_e_acsl_);
+ __gmpq_clear(__gen_e_acsl__2);
+ }
+ /*@ assert 3 ≡ 1.5 + 1.5; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__3;
+ __e_acsl_mpq_t __gen_e_acsl__4;
+ __e_acsl_mpq_t __gen_e_acsl_add;
+ int __gen_e_acsl_eq;
+ __gmpq_init(__gen_e_acsl__3);
+ __gmpq_set_str(__gen_e_acsl__3,"3",10);
+ __gmpq_init(__gen_e_acsl__4);
+ __gmpq_set_str(__gen_e_acsl__4,"15/10",10);
+ __gmpq_init(__gen_e_acsl_add);
+ __gmpq_add(__gen_e_acsl_add,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__4),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__4));
+ __gen_e_acsl_eq = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__3),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add));
+ __e_acsl_assert(__gen_e_acsl_eq == 0,(char *)"Assertion",(char *)"main",
+ (char *)"3 == 1.5 + 1.5",15);
+ __gmpq_clear(__gen_e_acsl__3);
+ __gmpq_clear(__gen_e_acsl__4);
+ __gmpq_clear(__gen_e_acsl_add);
+ }
+ /*@ assert 0.1 ≡ 0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__5;
+ int __gen_e_acsl_eq_2;
+ __gmpq_init(__gen_e_acsl__5);
+ __gmpq_set_str(__gen_e_acsl__5,"01/10",10);
+ __gen_e_acsl_eq_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__5),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__5));
+ __e_acsl_assert(__gen_e_acsl_eq_2 == 0,(char *)"Assertion",
+ (char *)"main",(char *)"0.1 == 0.1",16);
+ __gmpq_clear(__gen_e_acsl__5);
+ }
+ /*@ assert (double)0.1 ≢ 0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__6;
+ double __gen_e_acsl_cast;
+ __e_acsl_mpq_t __gen_e_acsl__7;
+ int __gen_e_acsl_ne_2;
+ __gmpq_init(__gen_e_acsl__6);
+ __gmpq_set_str(__gen_e_acsl__6,"01/10",10);
+ __gen_e_acsl_cast = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__6));
+ __gmpq_init(__gen_e_acsl__7);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast); */
+ __gmpq_set_d(__gen_e_acsl__7,__gen_e_acsl_cast);
+ __gen_e_acsl_ne_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__7),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__6));
+ __e_acsl_assert(__gen_e_acsl_ne_2 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"(double)0.1 != 0.1",17);
+ __gmpq_clear(__gen_e_acsl__6);
+ __gmpq_clear(__gen_e_acsl__7);
+ }
+ /*@ assert (float)0.1 ≢ (double)0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__8;
+ double __gen_e_acsl_cast_2;
+ __e_acsl_mpq_t __gen_e_acsl__9;
+ double __gen_e_acsl_cast_3;
+ __e_acsl_mpq_t __gen_e_acsl__10;
+ int __gen_e_acsl_ne_3;
+ __gmpq_init(__gen_e_acsl__8);
+ __gmpq_set_str(__gen_e_acsl__8,"01/10",10);
+ __gen_e_acsl_cast_2 = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__8));
+ __gmpq_init(__gen_e_acsl__9);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast_2); */
+ /*@ assert
+ Eva: is_nan_or_infinite: \is_finite((float)__gen_e_acsl_cast_2);
+ */
+ __gmpq_set_d(__gen_e_acsl__9,(double)((float)__gen_e_acsl_cast_2));
+ __gen_e_acsl_cast_3 = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__8));
+ __gmpq_init(__gen_e_acsl__10);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast_3); */
+ __gmpq_set_d(__gen_e_acsl__10,__gen_e_acsl_cast_3);
+ __gen_e_acsl_ne_3 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__9),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__10));
+ __e_acsl_assert(__gen_e_acsl_ne_3 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"(float)0.1 != (double)0.1",18);
+ __gmpq_clear(__gen_e_acsl__8);
+ __gmpq_clear(__gen_e_acsl__9);
+ __gmpq_clear(__gen_e_acsl__10);
+ }
+ /*@ assert (double)1.1 ≢ 1 + 0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__11;
+ double __gen_e_acsl_cast_4;
+ __e_acsl_mpq_t __gen_e_acsl__12;
+ __e_acsl_mpq_t __gen_e_acsl__13;
+ __e_acsl_mpq_t __gen_e_acsl__14;
+ __e_acsl_mpq_t __gen_e_acsl_add_2;
+ int __gen_e_acsl_ne_4;
+ __gmpq_init(__gen_e_acsl__11);
+ __gmpq_set_str(__gen_e_acsl__11,"11/10",10);
+ __gen_e_acsl_cast_4 = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__11));
+ __gmpq_init(__gen_e_acsl__12);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast_4); */
+ __gmpq_set_d(__gen_e_acsl__12,__gen_e_acsl_cast_4);
+ __gmpq_init(__gen_e_acsl__13);
+ __gmpq_set_str(__gen_e_acsl__13,"1",10);
+ __gmpq_init(__gen_e_acsl__14);
+ __gmpq_set_str(__gen_e_acsl__14,"01/10",10);
+ __gmpq_init(__gen_e_acsl_add_2);
+ __gmpq_add(__gen_e_acsl_add_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__13),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__14));
+ __gen_e_acsl_ne_4 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__12),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add_2));
+ __e_acsl_assert(__gen_e_acsl_ne_4 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"(double)1.1 != 1 + 0.1",19);
+ __gmpq_clear(__gen_e_acsl__11);
+ __gmpq_clear(__gen_e_acsl__12);
+ __gmpq_clear(__gen_e_acsl__13);
+ __gmpq_clear(__gen_e_acsl__14);
+ __gmpq_clear(__gen_e_acsl_add_2);
+ }
+ /*@ assert 1 + 0.1 ≡ 2 - 0.9; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__15;
+ __e_acsl_mpq_t __gen_e_acsl__16;
+ __e_acsl_mpq_t __gen_e_acsl_add_3;
+ __e_acsl_mpq_t __gen_e_acsl__17;
+ __e_acsl_mpq_t __gen_e_acsl__18;
+ __e_acsl_mpq_t __gen_e_acsl_sub;
+ int __gen_e_acsl_eq_3;
+ __gmpq_init(__gen_e_acsl__15);
+ __gmpq_set_str(__gen_e_acsl__15,"1",10);
+ __gmpq_init(__gen_e_acsl__16);
+ __gmpq_set_str(__gen_e_acsl__16,"01/10",10);
+ __gmpq_init(__gen_e_acsl_add_3);
+ __gmpq_add(__gen_e_acsl_add_3,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__15),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__16));
+ __gmpq_init(__gen_e_acsl__17);
+ __gmpq_set_str(__gen_e_acsl__17,"2",10);
+ __gmpq_init(__gen_e_acsl__18);
+ __gmpq_set_str(__gen_e_acsl__18,"09/10",10);
+ __gmpq_init(__gen_e_acsl_sub);
+ __gmpq_sub(__gen_e_acsl_sub,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__17),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__18));
+ __gen_e_acsl_eq_3 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_add_3),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_sub));
+ __e_acsl_assert(__gen_e_acsl_eq_3 == 0,(char *)"Assertion",
+ (char *)"main",(char *)"1 + 0.1 == 2 - 0.9",20);
+ __gmpq_clear(__gen_e_acsl__15);
+ __gmpq_clear(__gen_e_acsl__16);
+ __gmpq_clear(__gen_e_acsl_add_3);
+ __gmpq_clear(__gen_e_acsl__17);
+ __gmpq_clear(__gen_e_acsl__18);
+ __gmpq_clear(__gen_e_acsl_sub);
+ }
+ float x = 0.2f;
+ float y = 0.3f;
+ float sum = x + y;
+ /*@ assert sum ≢ x * y; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl_sum;
+ __e_acsl_mpq_t __gen_e_acsl_x;
+ __e_acsl_mpq_t __gen_e_acsl_y;
+ __e_acsl_mpq_t __gen_e_acsl_mul;
+ int __gen_e_acsl_ne_5;
+ __gmpq_init(__gen_e_acsl_sum);
+ __gmpq_set_d(__gen_e_acsl_sum,(double)sum);
+ __gmpq_init(__gen_e_acsl_x);
+ __gmpq_set_d(__gen_e_acsl_x,(double)x);
+ __gmpq_init(__gen_e_acsl_y);
+ __gmpq_set_d(__gen_e_acsl_y,(double)y);
+ __gmpq_init(__gen_e_acsl_mul);
+ __gmpq_mul(__gen_e_acsl_mul,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_x),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_y));
+ __gen_e_acsl_ne_5 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_sum),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_mul));
+ __e_acsl_assert(__gen_e_acsl_ne_5 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"sum != x * y",24);
+ __gmpq_clear(__gen_e_acsl_sum);
+ __gmpq_clear(__gen_e_acsl_x);
+ __gmpq_clear(__gen_e_acsl_y);
+ __gmpq_clear(__gen_e_acsl_mul);
+ }
+ /*@ assert \let n = 1; 4 ≡ n + 3.0; */
+ {
+ int __gen_e_acsl_n;
+ __e_acsl_mpq_t __gen_e_acsl__19;
+ __e_acsl_mpq_t __gen_e_acsl_n_2;
+ __e_acsl_mpq_t __gen_e_acsl__20;
+ __e_acsl_mpq_t __gen_e_acsl_add_4;
+ int __gen_e_acsl_eq_4;
+ __gen_e_acsl_n = 1;
+ __gmpq_init(__gen_e_acsl__19);
+ __gmpq_set_str(__gen_e_acsl__19,"4",10);
+ __gmpq_init(__gen_e_acsl_n_2);
+ __gmpq_set_si(__gen_e_acsl_n_2,(long)__gen_e_acsl_n);
+ __gmpq_init(__gen_e_acsl__20);
+ __gmpq_set_str(__gen_e_acsl__20,"30/10",10);
+ __gmpq_init(__gen_e_acsl_add_4);
+ __gmpq_add(__gen_e_acsl_add_4,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_n_2),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__20));
+ __gen_e_acsl_eq_4 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__19),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add_4));
+ __e_acsl_assert(__gen_e_acsl_eq_4 == 0,(char *)"Assertion",
+ (char *)"main",(char *)"\\let n = 1; 4 == n + 3.0",25);
+ __gmpq_clear(__gen_e_acsl__19);
+ __gmpq_clear(__gen_e_acsl_n_2);
+ __gmpq_clear(__gen_e_acsl__20);
+ __gmpq_clear(__gen_e_acsl_add_4);
+ }
+ double d = 0.1;
+ __gen_e_acsl_avg(4.3,11.7);
+ long double ld = 0.1l;
+ /*@ assert d + 1 ≢ ld + 1; */ ;
+ /*@ assert 1.1d ≢ 1 + 0.1; */ ;
+ /*@ assert 3 ≢ 1e5; */ ;
+ /*@ assert \let n = 99999999999999999999999999; 4 ≢ n + 3.7; */ ;
+ __retres = 0;
+ return __retres;
+}
+
+/*@ ensures \let delta = 1;
+ \let avg_real = (\old(a) + \old(b)) / 2;
+ avg_real - delta < \result < avg_real + delta;
+ */
+double __gen_e_acsl_avg(double a, double b)
+{
+ __e_acsl_mpq_t __gen_e_acsl_at_2;
+ __e_acsl_mpq_t __gen_e_acsl_at;
+ double __retres;
+ {
+ __e_acsl_mpq_t __gen_e_acsl_b;
+ __gmpq_init(__gen_e_acsl_b);
+ __gmpq_set_d(__gen_e_acsl_b,b);
+ __gmpq_init(__gen_e_acsl_at_2);
+ __gmpq_set(__gen_e_acsl_at_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_b));
+ __gmpq_clear(__gen_e_acsl_b);
+ }
+ {
+ __e_acsl_mpq_t __gen_e_acsl_a;
+ __gmpq_init(__gen_e_acsl_a);
+ __gmpq_set_d(__gen_e_acsl_a,a);
+ __gmpq_init(__gen_e_acsl_at);
+ __gmpq_set(__gen_e_acsl_at,(__e_acsl_mpq_struct const *)(__gen_e_acsl_a));
+ __gmpq_clear(__gen_e_acsl_a);
+ }
+ __retres = avg(a,b);
+ {
+ int __gen_e_acsl_delta;
+ __e_acsl_mpq_t __gen_e_acsl_avg_real;
+ __e_acsl_mpq_t __gen_e_acsl_add;
+ __e_acsl_mpq_t __gen_e_acsl_;
+ __e_acsl_mpq_t __gen_e_acsl_div;
+ __e_acsl_mpq_t __gen_e_acsl_delta_2;
+ __e_acsl_mpq_t __gen_e_acsl_sub;
+ __e_acsl_mpq_t __gen_e_acsl_result;
+ int __gen_e_acsl_lt;
+ int __gen_e_acsl_and;
+ __gen_e_acsl_delta = 1;
+ __gmpq_init(__gen_e_acsl_add);
+ __gmpq_add(__gen_e_acsl_add,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_at),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_at_2));
+ __gmpq_init(__gen_e_acsl_);
+ __gmpq_set_str(__gen_e_acsl_,"2",10);
+ __gmpq_init(__gen_e_acsl_div);
+ __gmpq_div(__gen_e_acsl_div,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_));
+ __gmpq_init(__gen_e_acsl_avg_real);
+ __gmpq_set(__gen_e_acsl_avg_real,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_div));
+ __gmpq_init(__gen_e_acsl_delta_2);
+ __gmpq_set_si(__gen_e_acsl_delta_2,(long)__gen_e_acsl_delta);
+ __gmpq_init(__gen_e_acsl_sub);
+ __gmpq_sub(__gen_e_acsl_sub,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_avg_real),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_delta_2));
+ __gmpq_init(__gen_e_acsl_result);
+ __gmpq_set_d(__gen_e_acsl_result,__retres);
+ __gen_e_acsl_lt = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_sub),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_result));
+ if (__gen_e_acsl_lt < 0) {
+ __e_acsl_mpq_t __gen_e_acsl_result_2;
+ __e_acsl_mpq_t __gen_e_acsl_delta_3;
+ __e_acsl_mpq_t __gen_e_acsl_add_2;
+ int __gen_e_acsl_lt_2;
+ __gmpq_init(__gen_e_acsl_result_2);
+ __gmpq_set_d(__gen_e_acsl_result_2,__retres);
+ __gmpq_init(__gen_e_acsl_delta_3);
+ __gmpq_set_si(__gen_e_acsl_delta_3,(long)__gen_e_acsl_delta);
+ __gmpq_init(__gen_e_acsl_add_2);
+ __gmpq_add(__gen_e_acsl_add_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_avg_real),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_delta_3));
+ __gen_e_acsl_lt_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_result_2),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add_2));
+ __gen_e_acsl_and = __gen_e_acsl_lt_2 < 0;
+ __gmpq_clear(__gen_e_acsl_result_2);
+ __gmpq_clear(__gen_e_acsl_delta_3);
+ __gmpq_clear(__gen_e_acsl_add_2);
+ }
+ else __gen_e_acsl_and = 0;
+ __e_acsl_assert(__gen_e_acsl_and,(char *)"Postcondition",(char *)"avg",
+ (char *)"\\let delta = 1;\n\\let avg_real = (\\old(a) + \\old(b)) / 2;\n avg_real - delta < \\result < avg_real + delta",
+ 6);
+ __gmpq_clear(__gen_e_acsl_avg_real);
+ __gmpq_clear(__gen_e_acsl_add);
+ __gmpq_clear(__gen_e_acsl_);
+ __gmpq_clear(__gen_e_acsl_div);
+ __gmpq_clear(__gen_e_acsl_delta_2);
+ __gmpq_clear(__gen_e_acsl_sub);
+ __gmpq_clear(__gen_e_acsl_result);
+ __gmpq_clear(__gen_e_acsl_at);
+ __gmpq_clear(__gen_e_acsl_at_2);
+ return __retres;
+ }
+}
+
+
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/gen_reals2.c b/src/plugins/e-acsl/tests/gmp/oracle/gen_reals2.c
new file mode 100644
index 00000000000..6bba81c1a89
--- /dev/null
+++ b/src/plugins/e-acsl/tests/gmp/oracle/gen_reals2.c
@@ -0,0 +1,355 @@
+/* Generated by Frama-C */
+#include "stdio.h"
+#include "stdlib.h"
+/*@ ensures \let delta = 1;
+ \let avg_real = (\old(a) + \old(b)) / 2;
+ avg_real - delta < \result < avg_real + delta;
+ */
+double __gen_e_acsl_avg(double a, double b);
+
+double avg(double a, double b)
+{
+ double __retres;
+ __retres = (a + b) / (double)2;
+ return __retres;
+}
+
+int main(void)
+{
+ int __retres;
+ __e_acsl_memory_init((int *)0,(char ***)0,(size_t)8);
+ /*@ assert 3 ≢ 1.5; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl_;
+ __e_acsl_mpq_t __gen_e_acsl__2;
+ int __gen_e_acsl_ne;
+ __gmpq_init(__gen_e_acsl_);
+ __gmpq_set_str(__gen_e_acsl_,"3",10);
+ __gmpq_init(__gen_e_acsl__2);
+ __gmpq_set_str(__gen_e_acsl__2,"15/10",10);
+ __gen_e_acsl_ne = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__2));
+ __e_acsl_assert(__gen_e_acsl_ne != 0,(char *)"Assertion",(char *)"main",
+ (char *)"3 != 1.5",14);
+ __gmpq_clear(__gen_e_acsl_);
+ __gmpq_clear(__gen_e_acsl__2);
+ }
+ /*@ assert 3 ≡ 1.5 + 1.5; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__3;
+ __e_acsl_mpq_t __gen_e_acsl__4;
+ __e_acsl_mpq_t __gen_e_acsl_add;
+ int __gen_e_acsl_eq;
+ __gmpq_init(__gen_e_acsl__3);
+ __gmpq_set_str(__gen_e_acsl__3,"3",10);
+ __gmpq_init(__gen_e_acsl__4);
+ __gmpq_set_str(__gen_e_acsl__4,"15/10",10);
+ __gmpq_init(__gen_e_acsl_add);
+ __gmpq_add(__gen_e_acsl_add,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__4),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__4));
+ __gen_e_acsl_eq = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__3),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add));
+ __e_acsl_assert(__gen_e_acsl_eq == 0,(char *)"Assertion",(char *)"main",
+ (char *)"3 == 1.5 + 1.5",15);
+ __gmpq_clear(__gen_e_acsl__3);
+ __gmpq_clear(__gen_e_acsl__4);
+ __gmpq_clear(__gen_e_acsl_add);
+ }
+ /*@ assert 0.1 ≡ 0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__5;
+ int __gen_e_acsl_eq_2;
+ __gmpq_init(__gen_e_acsl__5);
+ __gmpq_set_str(__gen_e_acsl__5,"01/10",10);
+ __gen_e_acsl_eq_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__5),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__5));
+ __e_acsl_assert(__gen_e_acsl_eq_2 == 0,(char *)"Assertion",
+ (char *)"main",(char *)"0.1 == 0.1",16);
+ __gmpq_clear(__gen_e_acsl__5);
+ }
+ /*@ assert (double)0.1 ≢ 0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__6;
+ double __gen_e_acsl_cast;
+ __e_acsl_mpq_t __gen_e_acsl__7;
+ int __gen_e_acsl_ne_2;
+ __gmpq_init(__gen_e_acsl__6);
+ __gmpq_set_str(__gen_e_acsl__6,"01/10",10);
+ __gen_e_acsl_cast = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__6));
+ __gmpq_init(__gen_e_acsl__7);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast); */
+ __gmpq_set_d(__gen_e_acsl__7,__gen_e_acsl_cast);
+ __gen_e_acsl_ne_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__7),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__6));
+ __e_acsl_assert(__gen_e_acsl_ne_2 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"(double)0.1 != 0.1",17);
+ __gmpq_clear(__gen_e_acsl__6);
+ __gmpq_clear(__gen_e_acsl__7);
+ }
+ /*@ assert (float)0.1 ≢ (double)0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__8;
+ double __gen_e_acsl_cast_2;
+ __e_acsl_mpq_t __gen_e_acsl__9;
+ double __gen_e_acsl_cast_3;
+ __e_acsl_mpq_t __gen_e_acsl__10;
+ int __gen_e_acsl_ne_3;
+ __gmpq_init(__gen_e_acsl__8);
+ __gmpq_set_str(__gen_e_acsl__8,"01/10",10);
+ __gen_e_acsl_cast_2 = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__8));
+ __gmpq_init(__gen_e_acsl__9);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast_2); */
+ /*@ assert
+ Eva: is_nan_or_infinite: \is_finite((float)__gen_e_acsl_cast_2);
+ */
+ __gmpq_set_d(__gen_e_acsl__9,(double)((float)__gen_e_acsl_cast_2));
+ __gen_e_acsl_cast_3 = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__8));
+ __gmpq_init(__gen_e_acsl__10);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast_3); */
+ __gmpq_set_d(__gen_e_acsl__10,__gen_e_acsl_cast_3);
+ __gen_e_acsl_ne_3 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__9),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__10));
+ __e_acsl_assert(__gen_e_acsl_ne_3 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"(float)0.1 != (double)0.1",18);
+ __gmpq_clear(__gen_e_acsl__8);
+ __gmpq_clear(__gen_e_acsl__9);
+ __gmpq_clear(__gen_e_acsl__10);
+ }
+ /*@ assert (double)1.1 ≢ 1 + 0.1; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__11;
+ double __gen_e_acsl_cast_4;
+ __e_acsl_mpq_t __gen_e_acsl__12;
+ __e_acsl_mpq_t __gen_e_acsl__13;
+ __e_acsl_mpq_t __gen_e_acsl__14;
+ __e_acsl_mpq_t __gen_e_acsl_add_2;
+ int __gen_e_acsl_ne_4;
+ __gmpq_init(__gen_e_acsl__11);
+ __gmpq_set_str(__gen_e_acsl__11,"11/10",10);
+ __gen_e_acsl_cast_4 = __gmpq_get_d((__e_acsl_mpq_struct const *)(__gen_e_acsl__11));
+ __gmpq_init(__gen_e_acsl__12);
+ /*@ assert Eva: is_nan_or_infinite: \is_finite(__gen_e_acsl_cast_4); */
+ __gmpq_set_d(__gen_e_acsl__12,__gen_e_acsl_cast_4);
+ __gmpq_init(__gen_e_acsl__13);
+ __gmpq_set_str(__gen_e_acsl__13,"1",10);
+ __gmpq_init(__gen_e_acsl__14);
+ __gmpq_set_str(__gen_e_acsl__14,"01/10",10);
+ __gmpq_init(__gen_e_acsl_add_2);
+ __gmpq_add(__gen_e_acsl_add_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__13),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__14));
+ __gen_e_acsl_ne_4 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__12),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add_2));
+ __e_acsl_assert(__gen_e_acsl_ne_4 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"(double)1.1 != 1 + 0.1",19);
+ __gmpq_clear(__gen_e_acsl__11);
+ __gmpq_clear(__gen_e_acsl__12);
+ __gmpq_clear(__gen_e_acsl__13);
+ __gmpq_clear(__gen_e_acsl__14);
+ __gmpq_clear(__gen_e_acsl_add_2);
+ }
+ /*@ assert 1 + 0.1 ≡ 2 - 0.9; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl__15;
+ __e_acsl_mpq_t __gen_e_acsl__16;
+ __e_acsl_mpq_t __gen_e_acsl_add_3;
+ __e_acsl_mpq_t __gen_e_acsl__17;
+ __e_acsl_mpq_t __gen_e_acsl__18;
+ __e_acsl_mpq_t __gen_e_acsl_sub;
+ int __gen_e_acsl_eq_3;
+ __gmpq_init(__gen_e_acsl__15);
+ __gmpq_set_str(__gen_e_acsl__15,"1",10);
+ __gmpq_init(__gen_e_acsl__16);
+ __gmpq_set_str(__gen_e_acsl__16,"01/10",10);
+ __gmpq_init(__gen_e_acsl_add_3);
+ __gmpq_add(__gen_e_acsl_add_3,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__15),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__16));
+ __gmpq_init(__gen_e_acsl__17);
+ __gmpq_set_str(__gen_e_acsl__17,"2",10);
+ __gmpq_init(__gen_e_acsl__18);
+ __gmpq_set_str(__gen_e_acsl__18,"09/10",10);
+ __gmpq_init(__gen_e_acsl_sub);
+ __gmpq_sub(__gen_e_acsl_sub,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__17),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__18));
+ __gen_e_acsl_eq_3 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_add_3),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_sub));
+ __e_acsl_assert(__gen_e_acsl_eq_3 == 0,(char *)"Assertion",
+ (char *)"main",(char *)"1 + 0.1 == 2 - 0.9",20);
+ __gmpq_clear(__gen_e_acsl__15);
+ __gmpq_clear(__gen_e_acsl__16);
+ __gmpq_clear(__gen_e_acsl_add_3);
+ __gmpq_clear(__gen_e_acsl__17);
+ __gmpq_clear(__gen_e_acsl__18);
+ __gmpq_clear(__gen_e_acsl_sub);
+ }
+ float x = 0.2f;
+ float y = 0.3f;
+ float sum = x + y;
+ /*@ assert sum ≢ x * y; */
+ {
+ __e_acsl_mpq_t __gen_e_acsl_sum;
+ __e_acsl_mpq_t __gen_e_acsl_x;
+ __e_acsl_mpq_t __gen_e_acsl_y;
+ __e_acsl_mpq_t __gen_e_acsl_mul;
+ int __gen_e_acsl_ne_5;
+ __gmpq_init(__gen_e_acsl_sum);
+ __gmpq_set_d(__gen_e_acsl_sum,(double)sum);
+ __gmpq_init(__gen_e_acsl_x);
+ __gmpq_set_d(__gen_e_acsl_x,(double)x);
+ __gmpq_init(__gen_e_acsl_y);
+ __gmpq_set_d(__gen_e_acsl_y,(double)y);
+ __gmpq_init(__gen_e_acsl_mul);
+ __gmpq_mul(__gen_e_acsl_mul,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_x),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_y));
+ __gen_e_acsl_ne_5 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_sum),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_mul));
+ __e_acsl_assert(__gen_e_acsl_ne_5 != 0,(char *)"Assertion",
+ (char *)"main",(char *)"sum != x * y",24);
+ __gmpq_clear(__gen_e_acsl_sum);
+ __gmpq_clear(__gen_e_acsl_x);
+ __gmpq_clear(__gen_e_acsl_y);
+ __gmpq_clear(__gen_e_acsl_mul);
+ }
+ /*@ assert \let n = 1; 4 ≡ n + 3.0; */
+ {
+ int __gen_e_acsl_n;
+ __e_acsl_mpq_t __gen_e_acsl__19;
+ __e_acsl_mpq_t __gen_e_acsl_n_2;
+ __e_acsl_mpq_t __gen_e_acsl__20;
+ __e_acsl_mpq_t __gen_e_acsl_add_4;
+ int __gen_e_acsl_eq_4;
+ __gen_e_acsl_n = 1;
+ __gmpq_init(__gen_e_acsl__19);
+ __gmpq_set_str(__gen_e_acsl__19,"4",10);
+ __gmpq_init(__gen_e_acsl_n_2);
+ __gmpq_set_si(__gen_e_acsl_n_2,(long)__gen_e_acsl_n);
+ __gmpq_init(__gen_e_acsl__20);
+ __gmpq_set_str(__gen_e_acsl__20,"30/10",10);
+ __gmpq_init(__gen_e_acsl_add_4);
+ __gmpq_add(__gen_e_acsl_add_4,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_n_2),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl__20));
+ __gen_e_acsl_eq_4 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl__19),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add_4));
+ __e_acsl_assert(__gen_e_acsl_eq_4 == 0,(char *)"Assertion",
+ (char *)"main",(char *)"\\let n = 1; 4 == n + 3.0",25);
+ __gmpq_clear(__gen_e_acsl__19);
+ __gmpq_clear(__gen_e_acsl_n_2);
+ __gmpq_clear(__gen_e_acsl__20);
+ __gmpq_clear(__gen_e_acsl_add_4);
+ }
+ double d = 0.1;
+ __gen_e_acsl_avg(4.3,11.7);
+ long double ld = 0.1l;
+ /*@ assert d + 1 ≢ ld + 1; */ ;
+ /*@ assert 1.1d ≢ 1 + 0.1; */ ;
+ /*@ assert 3 ≢ 1e5; */ ;
+ /*@ assert \let n = 99999999999999999999999999; 4 ≢ n + 3.7; */ ;
+ __retres = 0;
+ return __retres;
+}
+
+/*@ ensures \let delta = 1;
+ \let avg_real = (\old(a) + \old(b)) / 2;
+ avg_real - delta < \result < avg_real + delta;
+ */
+double __gen_e_acsl_avg(double a, double b)
+{
+ __e_acsl_mpq_t __gen_e_acsl_at_2;
+ __e_acsl_mpq_t __gen_e_acsl_at;
+ double __retres;
+ {
+ __e_acsl_mpq_t __gen_e_acsl_b;
+ __gmpq_init(__gen_e_acsl_b);
+ __gmpq_set_d(__gen_e_acsl_b,b);
+ __gmpq_init(__gen_e_acsl_at_2);
+ __gmpq_set(__gen_e_acsl_at_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_b));
+ __gmpq_clear(__gen_e_acsl_b);
+ }
+ {
+ __e_acsl_mpq_t __gen_e_acsl_a;
+ __gmpq_init(__gen_e_acsl_a);
+ __gmpq_set_d(__gen_e_acsl_a,a);
+ __gmpq_init(__gen_e_acsl_at);
+ __gmpq_set(__gen_e_acsl_at,(__e_acsl_mpq_struct const *)(__gen_e_acsl_a));
+ __gmpq_clear(__gen_e_acsl_a);
+ }
+ __retres = avg(a,b);
+ {
+ int __gen_e_acsl_delta;
+ __e_acsl_mpq_t __gen_e_acsl_avg_real;
+ __e_acsl_mpq_t __gen_e_acsl_add;
+ __e_acsl_mpq_t __gen_e_acsl_;
+ __e_acsl_mpq_t __gen_e_acsl_div;
+ __e_acsl_mpq_t __gen_e_acsl_delta_2;
+ __e_acsl_mpq_t __gen_e_acsl_sub;
+ __e_acsl_mpq_t __gen_e_acsl_result;
+ int __gen_e_acsl_lt;
+ int __gen_e_acsl_and;
+ __gen_e_acsl_delta = 1;
+ __gmpq_init(__gen_e_acsl_add);
+ __gmpq_add(__gen_e_acsl_add,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_at),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_at_2));
+ __gmpq_init(__gen_e_acsl_);
+ __gmpq_set_str(__gen_e_acsl_,"2",10);
+ __gmpq_init(__gen_e_acsl_div);
+ __gmpq_div(__gen_e_acsl_div,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_));
+ __gmpq_init(__gen_e_acsl_avg_real);
+ __gmpq_set(__gen_e_acsl_avg_real,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_div));
+ __gmpq_init(__gen_e_acsl_delta_2);
+ __gmpq_set_si(__gen_e_acsl_delta_2,(long)__gen_e_acsl_delta);
+ __gmpq_init(__gen_e_acsl_sub);
+ __gmpq_sub(__gen_e_acsl_sub,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_avg_real),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_delta_2));
+ __gmpq_init(__gen_e_acsl_result);
+ __gmpq_set_d(__gen_e_acsl_result,__retres);
+ __gen_e_acsl_lt = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_sub),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_result));
+ if (__gen_e_acsl_lt < 0) {
+ __e_acsl_mpq_t __gen_e_acsl_result_2;
+ __e_acsl_mpq_t __gen_e_acsl_delta_3;
+ __e_acsl_mpq_t __gen_e_acsl_add_2;
+ int __gen_e_acsl_lt_2;
+ __gmpq_init(__gen_e_acsl_result_2);
+ __gmpq_set_d(__gen_e_acsl_result_2,__retres);
+ __gmpq_init(__gen_e_acsl_delta_3);
+ __gmpq_set_si(__gen_e_acsl_delta_3,(long)__gen_e_acsl_delta);
+ __gmpq_init(__gen_e_acsl_add_2);
+ __gmpq_add(__gen_e_acsl_add_2,
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_avg_real),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_delta_3));
+ __gen_e_acsl_lt_2 = __gmpq_cmp((__e_acsl_mpq_struct const *)(__gen_e_acsl_result_2),
+ (__e_acsl_mpq_struct const *)(__gen_e_acsl_add_2));
+ __gen_e_acsl_and = __gen_e_acsl_lt_2 < 0;
+ __gmpq_clear(__gen_e_acsl_result_2);
+ __gmpq_clear(__gen_e_acsl_delta_3);
+ __gmpq_clear(__gen_e_acsl_add_2);
+ }
+ else __gen_e_acsl_and = 0;
+ __e_acsl_assert(__gen_e_acsl_and,(char *)"Postcondition",(char *)"avg",
+ (char *)"\\let delta = 1;\n\\let avg_real = (\\old(a) + \\old(b)) / 2;\n avg_real - delta < \\result < avg_real + delta",
+ 6);
+ __gmpq_clear(__gen_e_acsl_avg_real);
+ __gmpq_clear(__gen_e_acsl_add);
+ __gmpq_clear(__gen_e_acsl_);
+ __gmpq_clear(__gen_e_acsl_div);
+ __gmpq_clear(__gen_e_acsl_delta_2);
+ __gmpq_clear(__gen_e_acsl_sub);
+ __gmpq_clear(__gen_e_acsl_result);
+ __gmpq_clear(__gen_e_acsl_at);
+ __gmpq_clear(__gen_e_acsl_at_2);
+ return __retres;
+ }
+}
+
+
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/let.0.res.oracle b/src/plugins/e-acsl/tests/gmp/oracle/let.0.res.oracle
index eb489ce6c25..2d54fe6c596 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/let.0.res.oracle
+++ b/src/plugins/e-acsl/tests/gmp/oracle/let.0.res.oracle
@@ -35,6 +35,12 @@
[eva] using specification for function __e_acsl_store_block
[eva] using specification for function __e_acsl_full_init
[eva:alarm] tests/gmp/let.c:27: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_init
+[eva] using specification for function __gmpq_set_d
+[eva] using specification for function __gmpq_cmp
+[eva:alarm] tests/gmp/let.c:27: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_clear
[eva:alarm] tests/gmp/let.c:30: Warning: assertion got status unknown.
[eva] tests/gmp/let.c:32:
cannot evaluate ACSL term, unsupported ACSL construct: \let bindings
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/let.1.res.oracle b/src/plugins/e-acsl/tests/gmp/oracle/let.1.res.oracle
index e59e6930976..bbae66240bf 100644
--- a/src/plugins/e-acsl/tests/gmp/oracle/let.1.res.oracle
+++ b/src/plugins/e-acsl/tests/gmp/oracle/let.1.res.oracle
@@ -49,6 +49,12 @@
[eva] using specification for function __e_acsl_store_block
[eva] using specification for function __e_acsl_full_init
[eva:alarm] tests/gmp/let.c:27: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_init
+[eva] using specification for function __gmpq_set_d
+[eva] using specification for function __gmpq_cmp
+[eva:alarm] tests/gmp/let.c:27: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_clear
[eva:alarm] tests/gmp/let.c:30: Warning: assertion got status unknown.
[eva:alarm] tests/gmp/let.c:30: Warning:
function __e_acsl_assert: precondition got status unknown.
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/reals.0.res.oracle b/src/plugins/e-acsl/tests/gmp/oracle/reals.0.res.oracle
new file mode 100644
index 00000000000..a78fea8aefe
--- /dev/null
+++ b/src/plugins/e-acsl/tests/gmp/oracle/reals.0.res.oracle
@@ -0,0 +1,84 @@
+[kernel:parser:decimal-float] tests/gmp/reals.c:21: Warning:
+ Floating-point constant 0.2f is not represented exactly. Will use 0x1.99999a0000000p-3.
+ (warn-once: no further messages from category 'parser:decimal-float' will be emitted)
+[e-acsl] beginning translation.
+[e-acsl] Warning: R to float: double rounding might cause unsoundness
+[e-acsl] tests/gmp/reals.c:33: Warning:
+ E-ACSL construct `creating gmp from long double' is not yet supported.
+ Ignoring annotation.
+[e-acsl] tests/gmp/reals.c:34: Warning:
+ E-ACSL construct `number not written in decimal expansion'
+ is not yet supported.
+ Ignoring annotation.
+[e-acsl] tests/gmp/reals.c:35: Warning:
+ E-ACSL construct `number not written in decimal expansion'
+ is not yet supported.
+ Ignoring annotation.
+[e-acsl] tests/gmp/reals.c:37: Warning:
+ E-ACSL construct `reals: creating Q from Z' is not yet supported.
+ Ignoring annotation.
+[e-acsl] translation done in project "e-acsl".
+[eva] Analyzing a complete application starting at main
+[eva] Computing initial state
+[eva] Initial state computed
+[eva:initial-state] Values of globals at initialization
+ __e_acsl_init ∈ [--..--]
+ __e_acsl_heap_allocation_size ∈ [--..--]
+ __e_acsl_math_HUGE_VAL ∈ [-1.79769313486e+308 .. 1.79769313486e+308]
+ __e_acsl_math_HUGE_VALF ∈ [-3.40282346639e+38 .. 3.40282346639e+38]
+ __e_acsl_math_INFINITY ∈ [-1.79769313486e+308 .. 1.79769313486e+308]
+[eva] using specification for function __e_acsl_memory_init
+[eva] using specification for function __gmpq_init
+[eva] using specification for function __gmpq_set_str
+[eva] using specification for function __gmpq_cmp
+[eva] using specification for function __e_acsl_assert
+[eva:alarm] tests/gmp/reals.c:14: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_clear
+[eva] using specification for function __gmpq_add
+[eva:alarm] tests/gmp/reals.c:15: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:16: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:16: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:17: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_get_d
+[eva:alarm] tests/gmp/reals.c:17: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast);
+[eva] using specification for function __gmpq_set_d
+[eva:alarm] tests/gmp/reals.c:17: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast_2);
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ non-finite float value. assert \is_finite((float)__gen_e_acsl_cast_2);
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast_3);
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:19: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:19: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast_4);
+[eva:alarm] tests/gmp/reals.c:19: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:20: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_sub
+[eva:alarm] tests/gmp/reals.c:20: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_mul
+[eva:alarm] tests/gmp/reals.c:24: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:25: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_set_si
+[eva:alarm] tests/gmp/reals.c:25: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_set
+[eva] using specification for function __gmpq_div
+[eva:alarm] tests/gmp/reals.c:6: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:6: Warning:
+ function __gen_e_acsl_avg: postcondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:33: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:34: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:36: Warning: assertion got status unknown.
+[eva] done for function main
diff --git a/src/plugins/e-acsl/tests/gmp/oracle/reals.1.res.oracle b/src/plugins/e-acsl/tests/gmp/oracle/reals.1.res.oracle
new file mode 100644
index 00000000000..a78fea8aefe
--- /dev/null
+++ b/src/plugins/e-acsl/tests/gmp/oracle/reals.1.res.oracle
@@ -0,0 +1,84 @@
+[kernel:parser:decimal-float] tests/gmp/reals.c:21: Warning:
+ Floating-point constant 0.2f is not represented exactly. Will use 0x1.99999a0000000p-3.
+ (warn-once: no further messages from category 'parser:decimal-float' will be emitted)
+[e-acsl] beginning translation.
+[e-acsl] Warning: R to float: double rounding might cause unsoundness
+[e-acsl] tests/gmp/reals.c:33: Warning:
+ E-ACSL construct `creating gmp from long double' is not yet supported.
+ Ignoring annotation.
+[e-acsl] tests/gmp/reals.c:34: Warning:
+ E-ACSL construct `number not written in decimal expansion'
+ is not yet supported.
+ Ignoring annotation.
+[e-acsl] tests/gmp/reals.c:35: Warning:
+ E-ACSL construct `number not written in decimal expansion'
+ is not yet supported.
+ Ignoring annotation.
+[e-acsl] tests/gmp/reals.c:37: Warning:
+ E-ACSL construct `reals: creating Q from Z' is not yet supported.
+ Ignoring annotation.
+[e-acsl] translation done in project "e-acsl".
+[eva] Analyzing a complete application starting at main
+[eva] Computing initial state
+[eva] Initial state computed
+[eva:initial-state] Values of globals at initialization
+ __e_acsl_init ∈ [--..--]
+ __e_acsl_heap_allocation_size ∈ [--..--]
+ __e_acsl_math_HUGE_VAL ∈ [-1.79769313486e+308 .. 1.79769313486e+308]
+ __e_acsl_math_HUGE_VALF ∈ [-3.40282346639e+38 .. 3.40282346639e+38]
+ __e_acsl_math_INFINITY ∈ [-1.79769313486e+308 .. 1.79769313486e+308]
+[eva] using specification for function __e_acsl_memory_init
+[eva] using specification for function __gmpq_init
+[eva] using specification for function __gmpq_set_str
+[eva] using specification for function __gmpq_cmp
+[eva] using specification for function __e_acsl_assert
+[eva:alarm] tests/gmp/reals.c:14: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_clear
+[eva] using specification for function __gmpq_add
+[eva:alarm] tests/gmp/reals.c:15: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:16: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:16: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:17: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_get_d
+[eva:alarm] tests/gmp/reals.c:17: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast);
+[eva] using specification for function __gmpq_set_d
+[eva:alarm] tests/gmp/reals.c:17: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast_2);
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ non-finite float value. assert \is_finite((float)__gen_e_acsl_cast_2);
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast_3);
+[eva:alarm] tests/gmp/reals.c:18: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:19: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:19: Warning:
+ non-finite double value. assert \is_finite(__gen_e_acsl_cast_4);
+[eva:alarm] tests/gmp/reals.c:19: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:20: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_sub
+[eva:alarm] tests/gmp/reals.c:20: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_mul
+[eva:alarm] tests/gmp/reals.c:24: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:25: Warning: assertion got status unknown.
+[eva] using specification for function __gmpq_set_si
+[eva:alarm] tests/gmp/reals.c:25: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva] using specification for function __gmpq_set
+[eva] using specification for function __gmpq_div
+[eva:alarm] tests/gmp/reals.c:6: Warning:
+ function __e_acsl_assert: precondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:6: Warning:
+ function __gen_e_acsl_avg: postcondition got status unknown.
+[eva:alarm] tests/gmp/reals.c:33: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:34: Warning: assertion got status unknown.
+[eva:alarm] tests/gmp/reals.c:36: Warning: assertion got status unknown.
+[eva] done for function main
diff --git a/src/plugins/e-acsl/tests/gmp/reals.c b/src/plugins/e-acsl/tests/gmp/reals.c
new file mode 100644
index 00000000000..928cfdd7db5
--- /dev/null
+++ b/src/plugins/e-acsl/tests/gmp/reals.c
@@ -0,0 +1,38 @@
+/* run.config
+ COMMENT: real numbers
+*/
+
+/*@ ensures
+ \let delta = 1;
+ \let avg_real = (a+b)/2;
+ avg_real - delta < \result < avg_real + delta; */
+double avg(double a, double b) {
+ return (a+b)/2;
+}
+
+int main(void) {
+ /*@ assert 3 != 1.5; */ ;
+ /*@ assert 3 == 1.5 + 1.5; */ ;
+ /*@ assert 0.1 == 0.1; */ ;
+ /*@ assert (double)0.1 != 0.1; */ ;
+ /*@ assert (float)0.1 != (double)0.1; */ ;
+ /*@ assert (double)1.1 != 1 + 0.1 ;*/ ;
+ /*@ assert 1 + 0.1 == 2 - 0.9; */ ;
+ float x = 0.2f,
+ y = 0.3f,
+ sum = x + y;
+ /*@ assert sum != x * y; */ ;
+ /*@ assert \let n = 1; 4 == n + 3.0; */ ;
+
+ double d = 0.1;
+
+ avg(4.3, 11.7);
+
+ // Not yet:
+ long double ld = 0.1l;
+ /*@ assert d + 1 != ld + 1; */ ; // long double
+ /*@ assert 1.1d != 1 + 0.1; */ ; // number not written in decimal expansion form
+ /*@ assert 3 != 1e5; */ ; // number not written in decimal expansion form
+ /*@ assert \let n = 99999999999999999999999999;
+ 4 != n + 3.7; */ ; // creating Q from Z
+}
\ No newline at end of file
diff --git a/src/plugins/e-acsl/tests/gmp/reals1.c.notest b/src/plugins/e-acsl/tests/gmp/reals1.c.notest
new file mode 100644
index 00000000000..d5bd43dc37b
--- /dev/null
+++ b/src/plugins/e-acsl/tests/gmp/reals1.c.notest
@@ -0,0 +1,16 @@
+/* run.config
+ COMMENT: real numbers
+*/
+
+/*@ ensures
+ \let delta = 1;
+ \let third_real = a/3;
+ third_real - delta < \result < third_real + delta; */
+double third(double a) {
+ return a/3;
+}
+
+int main(void) {
+ int n = 1;
+ third(11.7);
+}
\ No newline at end of file
diff --git a/src/plugins/e-acsl/translate.ml b/src/plugins/e-acsl/translate.ml
index 3ec80d68bb4..3d10c8444d3 100644
--- a/src/plugins/e-acsl/translate.ml
+++ b/src/plugins/e-acsl/translate.ml
@@ -51,27 +51,6 @@ let relation_to_binop = function
| Req -> Eq
| Rneq -> Ne
-let name_of_binop = function
- | Lt -> "lt"
- | Gt -> "gt"
- | Le -> "le"
- | Ge -> "ge"
- | Eq -> "eq"
- | Ne -> "ne"
- | LOr -> "or"
- | LAnd -> "and"
- | BOr -> "bor"
- | BXor -> "bxor"
- | BAnd -> "band"
- | Shiftrt -> "shiftr"
- | Shiftlt -> "shiftl"
- | Mod -> "mod"
- | Div -> "div"
- | Mult -> "mul"
- | PlusA -> "add"
- | MinusA -> "sub"
- | MinusPP | MinusPI | IndexPI | PlusPI -> assert false
-
let name_of_mpz_arith_bop = function
| PlusA -> "__gmpz_add"
| MinusA -> "__gmpz_sub"
@@ -81,42 +60,60 @@ let name_of_mpz_arith_bop = function
| Lt | Gt | Le | Ge | Eq | Ne | BAnd | BXor | BOr | LAnd | LOr
| Shiftlt | Shiftrt | PlusPI | IndexPI | MinusPI | MinusPP -> assert false
+type strnum_ty = (* TYpe of a STRing that represents a NUMber *)
+ | StrZ
+ | StrR
+ | Not_a_strnum (* C numbers (integers AND floats) included *)
+
(* convert [e] in a way that it is compatible with the given typing context. *)
-let add_cast ~loc ?name env ctx is_mpz_string t_opt e =
+let add_cast ~loc ?name env ctx sty t_opt e =
let mk_mpz e =
- let _, e, env =
- Env.new_var
- ~loc
- ?name
- env
- t_opt
- (Gmpz.t ())
- (fun lv v -> [ Gmpz.init_set ~loc (Cil.var lv) v e ])
+ let _, e, env = Env.new_var
+ ~loc
+ ?name
+ env
+ t_opt
+ (Gmp.z_t ())
+ (fun lv v -> [ Gmp.init_set ~loc (Cil.var lv) v e ])
in
e, env
in
- let e, env = if is_mpz_string then mk_mpz e else e, env in
+ let e, env = match sty with
+ | StrZ -> mk_mpz e
+ | StrR -> Libr.mk_real ~loc ?name e env t_opt
+ | Not_a_strnum -> e, env
+ in
match ctx with
- | None -> e, env
+ | None ->
+ e, env
| Some ctx ->
let ty = Cil.typeOf e in
- if Gmpz.is_t ctx then
- if Gmpz.is_t ty then
+ if Gmp.is_z_t ctx then
+ if Gmp.is_z_t ty then
e, env
+ else if Libr.is_t ty then
+ Libr.cast_to_z ~loc ?name e env
else
(* Convert the C integer into a mpz.
Remember: very long integer constants have been temporary converted
into strings;
- also possible to get a non integralType (or Gmpz.t) with a non-one in
+ also possible to get a non integralType (or Gmp.z_t) with a non-one in
the case of \null *)
let e =
- if Cil.isIntegralType ty || is_mpz_string then e
- else Cil.mkCast e Cil.longType (* \null *)
+ if Cil.isIntegralType ty || sty = StrZ then
+ e
+ else if not (Cil.isIntegralType ty) && sty = Not_a_strnum then
+ Cil.mkCast e Cil.longType (* \null *)
+ else (* Remaining: not (Cil.isIntegralType ty) && sty = StrR *)
+ assert false
in
mk_mpz e
+ else if Libr.is_t ctx then
+ if Libr.is_t (Cil.typeOf e) then e, env
+ else Libr.mk_real ~loc ?name e env t_opt
else
(* handle a C-integer context *)
- if (Gmpz.is_t ty || is_mpz_string) then
+ if Gmp.is_z_t ty || sty = StrZ then
(* we get an mpz, but it fits into a C integer: convert it *)
let fname, new_ty =
if Cil.isSignedInteger ctx then
@@ -134,21 +131,34 @@ let add_cast ~loc ?name env ctx is_mpz_string t_opt e =
(fun v _ -> [ Misc.mk_call ~loc ~result:(Cil.var v) fname [ e ] ])
in
e, env
+ else if Libr.is_t ty || sty = StrR then
+ Libr.add_cast ~loc ?name e env ctx
else
Cil.mkCastT ~force:false ~e ~oldt:ty ~newt:ctx, env
-let constant_to_exp ~loc t = function
+let constant_to_exp ~loc t c =
+ let mk_real s =
+ let s = Libr.normalize_str s in
+ Cil.mkString ~loc s, StrR
+ in
+ match c with
| Integer(n, _repr) ->
(try
- let ity = Typing.get_integer_ty t in
+ let ity = Typing.get_number_ty t in
match ity with
- | Typing.Other -> assert false
- | Typing.Gmp -> raise Cil.Not_representable
+ | Typing.Nan ->
+ assert false
+ | Typing.Libr ->
+ mk_real (Integer.to_string n)
+ | Typing.Gmpz ->
+ raise Cil.Not_representable
| Typing.C_type kind ->
let cast = Typing.get_cast t in
match cast, kind with
- | Some ty, (ILongLong | IULongLong) when Gmpz.is_t ty ->
+ | Some ty, (ILongLong | IULongLong) when Gmp.is_z_t ty ->
raise Cil.Not_representable
+ | Some ty, (ILongLong | IULongLong) when Libr.is_t ty ->
+ mk_real (Integer.to_string n)
| (None | Some _), _ ->
(* do not keep the initial string representation because the
generated constant must reflect its type computed by the type
@@ -156,19 +166,16 @@ let constant_to_exp ~loc t = function
generate a [long long] addition and so [1LL]. If we keep the
initial string representation, the kind would be ignored in the
generated code and so [1] would be generated. *)
- Cil.kinteger64 ~loc ~kind n, false
+ Cil.kinteger64 ~loc ~kind n, Not_a_strnum
with Cil.Not_representable ->
(* too big integer *)
- Cil.mkString ~loc (Integer.to_string n), true)
- | LStr s -> Cil.new_exp ~loc (Const (CStr s)), false
- | LWStr s -> Cil.new_exp ~loc (Const (CWStr s)), false
- | LChr c -> Cil.new_exp ~loc (Const (CChr c)), false
- | LReal {r_literal=s; r_nearest=f; r_lower=l; r_upper=u} ->
- if l <> u then
- Options.warning ~current:true ~once:true
- "approximating a real number by a float";
- Cil.new_exp ~loc (Const (CReal (f, FLongDouble, Some s))), false
- | LEnum e -> Cil.new_exp ~loc (Const (CEnum e)), false
+ Cil.mkString ~loc (Integer.to_string n), StrZ)
+ | LStr s -> Cil.new_exp ~loc (Const (CStr s)), Not_a_strnum
+ | LWStr s -> Cil.new_exp ~loc (Const (CWStr s)), Not_a_strnum
+ | LChr c -> Cil.new_exp ~loc (Const (CChr c)), Not_a_strnum
+ | LReal {r_literal=s; r_nearest=_; r_lower=_; r_upper=_} ->
+ mk_real s
+ | LEnum e -> Cil.new_exp ~loc (Const (CEnum e)), Not_a_strnum
let conditional_to_exp ?(name="if") loc t_opt e1 (e2, env2) (e3, env3) =
let env = Env.pop (Env.pop env3) in
@@ -191,7 +198,11 @@ let conditional_to_exp ?(name="if") loc t_opt e1 (e2, env2) (e3, env3) =
ty
(fun v ev ->
let lv = Cil.var v in
- let affect e = Gmpz.init_set ~loc lv ev e in
+ let ty = Cil.typeOf ev in
+ let init_set =
+ if Libr.is_t ty then Libr.init_set else Gmp.init_set
+ in
+ let affect e = init_set ~loc lv ev e in
let then_block, _ =
let s = affect e2 in
Env.pop_and_get env2 s ~global_clear:false Env.Middle
@@ -204,26 +215,6 @@ let conditional_to_exp ?(name="if") loc t_opt e1 (e2, env2) (e3, env3) =
in
e, env
-(* If [e] is inserted in a context of type [float] or equivalent, then an
- explicit cast must be introduced (an explicit coercion is required in C, but
- it is implicit in the logic world).
- [lty] is the type of the logic context, while [lty_t] is the logic type of
- the term which [e] comes from. *)
-let cast_integer_to_float lty lty_t e =
- if Cil.isIntegralType (Cil.typeOf e) then
- let ty, correct = match lty, lty_t with
- | Ctype ty, _ -> ty, true
- | Lreal, Linteger -> Cil.longDoubleType, false
- | Lreal, _ -> Cil.longDoubleType, true
- | (Ltype _ | Lvar _ | Linteger | Larrow _), _ -> assert false
- in
- if not correct then
- Options.warning
- "casting an integer to a long double without verification";
- Cil.mkCast ~force:false ~e ~newt:ty
- else
- e
-
let rec thost_to_host kf env th = match th with
| TVar { lv_origin = Some v } ->
Var (Visitor_behavior.Get.varinfo (Env.get_behavior env) v), env, v.vname
@@ -264,24 +255,25 @@ and context_insensitive_term_to_exp kf env t =
let loc = t.term_loc in
match t.term_node with
| TConst c ->
- let c, is_mpz_string = constant_to_exp ~loc t c in
- c, env, is_mpz_string, ""
+ let c, strnum = constant_to_exp ~loc t c in
+ c, env, strnum, ""
| TLval lv ->
let lv, env, name = tlval_to_lval kf env lv in
- Cil.new_exp ~loc (Lval lv), env, false, name
- | TSizeOf ty -> Cil.sizeOf ~loc ty, env, false, "sizeof"
+ Cil.new_exp ~loc (Lval lv), env, Not_a_strnum, name
+ | TSizeOf ty -> Cil.sizeOf ~loc ty, env, Not_a_strnum, "sizeof"
| TSizeOfE t ->
let e, env = term_to_exp kf env t in
- Cil.sizeOf ~loc (Cil.typeOf e), env, false, "sizeof"
- | TSizeOfStr s -> Cil.new_exp ~loc (SizeOfStr s), env, false, "sizeofstr"
- | TAlignOf ty -> Cil.new_exp ~loc (AlignOf ty), env, false, "alignof"
+ Cil.sizeOf ~loc (Cil.typeOf e), env, Not_a_strnum, "sizeof"
+ | TSizeOfStr s ->
+ Cil.new_exp ~loc (SizeOfStr s), env, Not_a_strnum, "sizeofstr"
+ | TAlignOf ty -> Cil.new_exp ~loc (AlignOf ty), env, Not_a_strnum, "alignof"
| TAlignOfE t ->
let e, env = term_to_exp kf env t in
- Cil.new_exp ~loc (AlignOfE e), env, false, "alignof"
+ Cil.new_exp ~loc (AlignOfE e), env, Not_a_strnum, "alignof"
| TUnOp(Neg | BNot as op, t') ->
let ty = Typing.get_typ t in
let e, env = term_to_exp kf env t' in
- if Gmpz.is_t ty then
+ if Gmp.is_z_t ty then
let name, vname = match op with
| Neg -> "__gmpz_neg", "neg"
| BNot -> "__gmpz_com", "bnot"
@@ -295,53 +287,57 @@ and context_insensitive_term_to_exp kf env t =
(Some t)
(fun _ ev -> [ Misc.mk_call ~loc name [ ev; e ] ])
in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
+ else if Libr.is_t ty then
+ not_yet env "reals: Neg | BNot"
else
- Cil.new_exp ~loc (UnOp(op, e, ty)), env, false, ""
+ Cil.new_exp ~loc (UnOp(op, e, ty)), env, Not_a_strnum, ""
| TUnOp(LNot, t) ->
let ty = Typing.get_op t in
- if Gmpz.is_t ty then
+ if Gmp.is_z_t ty then
(* [!t] is converted into [t == 0] *)
let zero = Logic_const.tinteger 0 in
- let ctx = Typing.get_integer_ty t in
+ let ctx = Typing.get_number_ty t in
Typing.type_term ~use_gmp_opt:true ~ctx zero;
- let e, env =
- comparison_to_exp kf ~loc ~name:"not" env Typing.gmp Eq t zero (Some t)
+ let e, env = comparison_to_exp
+ kf ~loc ~name:"not" env Typing.gmpz Eq t zero (Some t)
in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
+ else if Libr.is_t ty then
+ not_yet env "reals: LNot"
else begin
assert (Cil.isIntegralType ty);
let e, env = term_to_exp kf env t in
- Cil.new_exp ~loc (UnOp(LNot, e, Cil.intType)), env, false, ""
+ Cil.new_exp ~loc (UnOp(LNot, e, Cil.intType)), env, Not_a_strnum, ""
end
| TBinOp(PlusA | MinusA | Mult as bop, t1, t2) ->
let ty = Typing.get_typ t in
let e1, env = term_to_exp kf env t1 in
let e2, env = term_to_exp kf env t2 in
- if Gmpz.is_t ty then
+ if Gmp.is_z_t ty then
let name = name_of_mpz_arith_bop bop in
let mk_stmts _ e = [ Misc.mk_call ~loc name [ e; e1; e2 ] ] in
- let name = name_of_binop bop in
+ let name = Misc.name_of_binop bop in
let _, e, env =
Env.new_var_and_mpz_init ~loc ~name env (Some t) mk_stmts
in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
+ else if Libr.is_t ty then
+ let e, env = Libr.mk_binop ~loc bop e1 e2 env (Some t) in
+ e, env, Not_a_strnum, ""
else
if Logic_typing.is_integral_type t.term_type then
- Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, false, ""
+ Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, Not_a_strnum, ""
else
- (* floating point context: casting the arguments potentially required *)
- let e1 = cast_integer_to_float t.term_type t1.term_type e1 in
- let e2 = cast_integer_to_float t.term_type t2.term_type e2 in
- Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, false, ""
+ not_yet env "floating-point context (?)"
| TBinOp(Div | Mod as bop, t1, t2) ->
let ty = Typing.get_typ t in
let e1, env = term_to_exp kf env t1 in
let e2, env = term_to_exp kf env t2 in
- if Gmpz.is_t ty then
+ if Gmp.is_z_t ty then
(* TODO: preventing division by zero should not be required anymore.
RTE should do this automatically. *)
- let ctx = Typing.get_integer_ty t in
+ let ctx = Typing.get_number_ty t in
let t = Some t in
let name = name_of_mpz_arith_bop bop in
(* [TODO] can now do better since the type system got some info about
@@ -351,12 +347,12 @@ and context_insensitive_term_to_exp kf env t =
Typing.type_term ~use_gmp_opt:true ~ctx zero;
(* do not generate [e2] from [t2] twice *)
let guard, env =
- let name = name_of_binop bop ^ "_guard" in
+ let name = Misc.name_of_binop bop ^ "_guard" in
comparison_to_exp
- ~loc kf env Typing.gmp ~e1:e2 ~name Eq t2 zero t
+ ~loc kf env Typing.gmpz ~e1:e2 ~name Eq t2 zero t
in
let mk_stmts _v e =
- assert (Gmpz.is_t ty);
+ assert (Gmp.is_z_t ty);
let vis = Env.get_visitor env in
let kf = Extlib.the vis#current_kf in
let cond =
@@ -370,23 +366,23 @@ and context_insensitive_term_to_exp kf env t =
let instr = Misc.mk_call ~loc name [ e; e1; e2 ] in
[ cond; instr ]
in
- let name = name_of_binop bop in
+ let name = Misc.name_of_binop bop in
let _, e, env = Env.new_var_and_mpz_init ~loc ~name env t mk_stmts in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
+ else if Libr.is_t ty then
+ let e, env = Libr.mk_binop ~loc bop e1 e2 env (Some t) in
+ e, env, Not_a_strnum, ""
else
(* no guard required since RTEs are generated separately *)
if Logic_typing.is_integral_type t.term_type then
- Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, false, ""
+ Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, Not_a_strnum, ""
else
- (* floating point context: casting the arguments potentially required *)
- let e1 = cast_integer_to_float t.term_type t1.term_type e1 in
- let e2 = cast_integer_to_float t.term_type t2.term_type e2 in
- Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, false, ""
+ not_yet env "floating-point context (?)"
| TBinOp(Lt | Gt | Le | Ge | Eq | Ne as bop, t1, t2) ->
(* comparison operators *)
let ity = Typing.get_integer_op t in
let e, env = comparison_to_exp ~loc kf env ity bop t1 t2 (Some t) in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
| TBinOp((Shiftlt | Shiftrt), _, _) ->
(* left/right shift *)
not_yet env "left/right shift"
@@ -398,7 +394,7 @@ and context_insensitive_term_to_exp kf env t =
let e, env =
conditional_to_exp ~name:"or" loc (Some t) e1 (Cil.one loc, env') res2
in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
| TBinOp(LAnd, t1, t2) ->
(* t1 && t2 <==> if t1 then t2 else false *)
let e1, env1 = term_to_exp kf (Env.rte env true) t1 in
@@ -407,7 +403,7 @@ and context_insensitive_term_to_exp kf env t =
let e, env =
conditional_to_exp ~name:"and" loc (Some t) e1 res2 (Cil.zero loc, env3)
in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
| TBinOp((BOr | BXor | BAnd), _, _) ->
(* other logic/arith operators *)
not_yet env "missing binary bitwise operator"
@@ -424,30 +420,32 @@ and context_insensitive_term_to_exp kf env t =
in
let e1, env = term_to_exp kf env t1 in
let e2, env = term_to_exp kf env t2 in
- Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, false, ""
+ Cil.new_exp ~loc (BinOp(bop, e1, e2, ty)), env, Not_a_strnum, ""
| TBinOp(MinusPP, t1, t2) ->
- begin match Typing.get_integer_ty t with
+ begin match Typing.get_number_ty t with
| Typing.C_type _ ->
let e1, env = term_to_exp kf env t1 in
let e2, env = term_to_exp kf env t2 in
let ty = Typing.get_typ t in
- Cil.new_exp ~loc (BinOp(MinusPP, e1, e2, ty)), env, false, ""
- | Typing.Gmp ->
+ Cil.new_exp ~loc (BinOp(MinusPP, e1, e2, ty)), env, Not_a_strnum, ""
+ | Typing.Gmpz ->
not_yet env "pointer subtraction resulting in gmp"
- | Typing.Other ->
+ | Typing.Libr | Typing.Nan ->
assert false
end
| TCastE(ty, t') ->
let e, env = term_to_exp kf env t' in
- let e, env = add_cast ~loc ~name:"cast" env (Some ty) false (Some t) e in
- e, env, false, ""
+ let e, env =
+ add_cast ~loc ~name:"cast" env (Some ty) Not_a_strnum (Some t) e
+ in
+ e, env, Not_a_strnum, ""
| TLogic_coerce _ -> assert false (* handle in [term_to_exp] *)
| TAddrOf lv ->
let lv, env, _ = tlval_to_lval kf env lv in
- Cil.mkAddrOf ~loc lv, env, false, "addrof"
+ Cil.mkAddrOf ~loc lv, env, Not_a_strnum, "addrof"
| TStartOf lv ->
let lv, env, _ = tlval_to_lval kf env lv in
- Cil.mkAddrOrStartOf ~loc lv, env, false, "startof"
+ Cil.mkAddrOrStartOf ~loc lv, env, Not_a_strnum, "startof"
| Tapp(li, [], targs) ->
let fname = li.l_var_info.lv_name in
(* build the varinfo (as an expression) which stores the result of the
@@ -482,12 +480,13 @@ and context_insensitive_term_to_exp kf env t =
List.fold_right
(fun targ (params_ty, args, env) ->
let e, env = term_to_exp kf env targ in
- let param_ty = Typing.get_integer_ty targ in
+ let param_ty = Typing.get_number_ty targ in
let e, env =
try
- let ty = Typing.typ_of_integer_ty param_ty in
- add_cast loc env (Some ty) false (Some targ) e
- with Typing.Not_an_integer ->
+ let ty = Typing.typ_of_number_ty param_ty in
+ (* TODO RATIONAL: check [Not_a_strnum] *)
+ add_cast loc env (Some ty) Not_a_strnum (Some targ) e
+ with Typing.Not_a_number ->
e, env
in
param_ty :: params_ty, e :: args, env)
@@ -499,7 +498,7 @@ and context_insensitive_term_to_exp kf env t =
in
Logic_functions.tapp_to_exp ~loc gen_fname env t li params_ty args
in
- e, env, false, "app"
+ e, env, Not_a_strnum, "app"
| Tapp(_, _ :: _, _) ->
not_yet env "logic functions with labels"
| Tlambda _ -> not_yet env "functional"
@@ -509,38 +508,39 @@ and context_insensitive_term_to_exp kf env t =
let (_, env2 as res2) = term_to_exp kf (Env.push env1) t2 in
let res3 = term_to_exp kf (Env.push env2) t3 in
let e, env = conditional_to_exp loc (Some t) e1 res2 res3 in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
| Tat(t, BuiltinLabel Here) ->
let e, env = term_to_exp kf env t in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
| Tat(t', label) ->
let lscope = Env.Logic_scope.get env in
let pot = Misc.PoT_term t' in
if Lscope.is_used lscope pot then
let e, env = At_with_lscope.to_exp ~loc kf env pot label in
- e, env, false, ""
+ e, env, Not_a_strnum, ""
else
let e, env = term_to_exp kf (Env.push env) t' in
- let e, env, is_mpz_string = at_to_exp_no_lscope env (Some t) label e in
- e, env, is_mpz_string, ""
+ let e, env, sty = at_to_exp_no_lscope env (Some t) label e in
+ e, env, sty, ""
| Tbase_addr(BuiltinLabel Here, t) ->
let name = "base_addr" in
let e, env = Mmodel_translate.call ~loc kf name Cil.voidPtrType env t in
- e, env, false, name
+ e, env, Not_a_strnum, name
| Tbase_addr _ -> not_yet env "labeled \\base_addr"
| Toffset(BuiltinLabel Here, t) ->
let size_t = Cil.theMachine.Cil.typeOfSizeOf in
let name = "offset" in
let e, env = Mmodel_translate.call ~loc kf name size_t env t in
- e, env, false, name
+ e, env, Not_a_strnum, name
| Toffset _ -> not_yet env "labeled \\offset"
| Tblock_length(BuiltinLabel Here, t) ->
let size_t = Cil.theMachine.Cil.typeOfSizeOf in
let name = "block_length" in
let e, env = Mmodel_translate.call ~loc kf name size_t env t in
- e, env, false, name
+ e, env, Not_a_strnum, name
| Tblock_length _ -> not_yet env "labeled \\block_length"
- | Tnull -> Cil.mkCast (Cil.zero ~loc) (TPtr(TVoid [], [])), env, false, "null"
+ | Tnull ->
+ Cil.mkCast (Cil.zero ~loc) (TPtr(TVoid [], [])), env, Not_a_strnum, "null"
| TUpdate _ -> not_yet env "functional update"
| Ttypeof _ -> not_yet env "typeof"
| Ttype _ -> not_yet env "C type"
@@ -555,7 +555,7 @@ and context_insensitive_term_to_exp kf env t =
let env = env_of_li li kf env loc in
let e, env = term_to_exp kf env t in
Interval.Env.remove li.l_var_info;
- e, env, false, ""
+ e, env, Not_a_strnum, ""
(* Convert an ACSL term into a corresponding C expression (if any) in the given
environment. Also extend this environment in order to include the generating
@@ -566,9 +566,7 @@ and term_to_exp kf env t =
Printer.pp_term t generate_rte;
let env = Env.rte env false in
let t = match t.term_node with TLogic_coerce(_, t) -> t | _ -> t in
- let e, env, is_mpz_string, name =
- context_insensitive_term_to_exp kf env t
- in
+ let e, env, sty, name = context_insensitive_term_to_exp kf env t in
let env = if generate_rte then translate_rte kf env e else env in
let cast = Typing.get_cast t in
let name = if name = "" then None else Some name in
@@ -577,13 +575,13 @@ and term_to_exp kf env t =
?name
env
cast
- is_mpz_string
+ sty
(Some t)
e
(* generate the C code equivalent to [t1 bop t2]. *)
and comparison_to_exp
- ~loc ?e1 kf env ity bop ?(name=name_of_binop bop) t1 t2 t_opt =
+ ~loc ?e1 kf env ity bop ?(name=Misc.name_of_binop bop) t1 t2 t_opt =
let e1, env = match e1 with
| None ->
let e1, env = term_to_exp kf env t1 in
@@ -593,20 +591,21 @@ and comparison_to_exp
in
let e2, env = term_to_exp kf env t2 in
match ity with
- | Typing.Gmp ->
- let _, e, env =
- Env.new_var
- ~loc
- env
- t_opt
- ~name
- Cil.intType
- (fun v _ ->
- [ Misc.mk_call ~loc ~result:(Cil.var v) "__gmpz_cmp" [ e1; e2 ] ])
+ | Typing.C_type _ | Typing.Nan ->
+ Cil.mkBinOp ~loc bop e1 e2, env
+ | Typing.Gmpz ->
+ let _, e, env = Env.new_var
+ ~loc
+ env
+ t_opt
+ ~name
+ Cil.intType
+ (fun v _ ->
+ [ Misc.mk_call ~loc ~result:(Cil.var v) "__gmpz_cmp" [ e1; e2 ] ])
in
Cil.new_exp ~loc (BinOp(bop, e, Cil.zero ~loc, Cil.intType)), env
- | Typing.C_type _ | Typing.Other ->
- Cil.mkBinOp ~loc bop e1 e2, env
+ | Typing.Libr ->
+ Libr.cmp ~loc bop e1 e2 env t_opt
and at_to_exp_no_lscope env t_opt label e =
let stmt = E_acsl_label.get_stmt (Env.get_visitor env) label in
@@ -632,9 +631,11 @@ and at_to_exp_no_lscope env t_opt label e =
let o = object
inherit Visitor.frama_c_inplace
method !vstmt_aux stmt =
- (* either a standard C affectation or an mpz one according to type of
+ (* either a standard C affectation or something else according to type of
[e] *)
- let new_stmt = Gmpz.init_set ~loc (Cil.var res_v) res e in
+ let ty = Cil.typeOf e in
+ let init_set = if Libr.is_t ty then Libr.init_set else Gmp.init_set in
+ let new_stmt = init_set ~loc (Cil.var res_v) res e in
assert (!env_ref == new_env);
(* generate the new block of code for the labeled statement and the
corresponding environment *)
@@ -646,19 +647,24 @@ and at_to_exp_no_lscope env t_opt label e =
end
in
let bhv = Env.get_behavior new_env in
- ignore( Visitor.visitFramacStmt o (Visitor_behavior.Get.stmt bhv stmt));
- res, !env_ref, false
+ let new_stmt =
+ Visitor.visitFramacStmt o (Visitor_behavior.Get.stmt bhv stmt)
+ in
+ Visitor_behavior.Set.stmt bhv stmt new_stmt;
+ res, !env_ref, Not_a_strnum
and env_of_li li kf env loc =
- let li_t = Misc.term_of_li li in
- let ty = Typing.get_typ li_t in
+ let t = Misc.term_of_li li in
+ let ty = Typing.get_typ t in
let vi, vi_e, env = Env.Logic_binding.add ~ty env li.l_var_info in
- let li_e, env = term_to_exp kf env li_t in
- let stmt = match Typing.get_integer_ty li_t with
- | Typing.C_type _ | Typing.Other ->
- Cil.mkStmtOneInstr (Set (Cil.var vi, li_e, loc))
- | Typing.Gmp ->
- Gmpz.init_set ~loc (Cil.var vi) vi_e li_e
+ let e, env = term_to_exp kf env t in
+ let stmt = match Typing.get_number_ty t with
+ | Typing.C_type _ | Typing.Nan ->
+ Cil.mkStmtOneInstr (Set (Cil.var vi, e, loc))
+ | Typing.Gmpz ->
+ Gmp.init_set ~loc (Cil.var vi) vi_e e
+ | Typing.Libr ->
+ Libr.init_set ~loc (Cil.var vi) vi_e e
in
Env.add_stmt env stmt
@@ -749,8 +755,8 @@ and named_predicate_content_to_exp ?name kf env p =
else begin
(* convert [t'] to [e] in a separated local env *)
let e, env = named_predicate_to_exp kf (Env.push env) p' in
- let e, env, is_string = at_to_exp_no_lscope env None label e in
- assert (not is_string);
+ let e, env, sty = at_to_exp_no_lscope env None label e in
+ assert (sty = Not_a_strnum);
e, env
end
| Pvalid_read(BuiltinLabel Here as llabel, t) as pc
@@ -818,7 +824,7 @@ and named_predicate_to_exp ?name kf ?rte env p =
?name
env
cast
- false
+ Not_a_strnum
None
e
@@ -898,11 +904,13 @@ exception No_simple_translation of term
let term_to_exp typ t =
(* infer a context from the given [typ] whenever possible *)
let ctx_of_typ ty =
- if Gmpz.is_t ty then Typing.gmp
+ if Gmp.is_z_t ty then Typing.gmpz
+ else if Libr.is_t ty then Typing.libr
else
match ty with
| TInt(ik, _) -> Typing.ikind ik
- | _ -> Typing.other
+ | TFloat _ -> Typing.libr
+ | _ -> Typing.nan
in
let ctx = Extlib.opt_map ctx_of_typ typ in
Typing.type_term ~use_gmp_opt:true ?ctx t;
diff --git a/src/plugins/e-acsl/typing.ml b/src/plugins/e-acsl/typing.ml
index ad6e28a2f20..9caa4380d37 100644
--- a/src/plugins/e-acsl/typing.ml
+++ b/src/plugins/e-acsl/typing.ml
@@ -36,24 +36,28 @@ let compute_quantif_guards_ref
(** Datatype and constructor *)
(******************************************************************************)
-type integer_ty =
- | Gmp
+type number_ty =
| C_type of ikind
- | Other
+ | Gmpz
+ | Libr
+ | Nan
-let gmp = Gmp
let c_int = C_type IInt
let ikind ik = C_type ik
-let other = Other
+let gmpz = Gmpz
+let libr = Libr
+let nan = Nan
module D =
Datatype.Make_with_collections
(struct
- type t = integer_ty
+ type t = number_ty
let name = "E_ACSL.New_typing.t"
- let reprs = [ Gmp; c_int ]
+ let reprs = [ Gmpz; c_int ]
include Datatype.Undefined
+ (* TODO RATIONAL: re-implement this datatype *)
+ (*
let compare ty1 ty2 = match ty1, ty2 with
| C_type i1, C_type i2 ->
if i1 = i2 then 0
@@ -72,7 +76,7 @@ module D =
let pretty fmt = function
| Gmp -> Format.pp_print_string fmt "GMP"
| C_type k -> Printer.pp_ikind fmt k
- | Other -> Format.pp_print_string fmt "OTHER"
+ | Other -> Format.pp_print_string fmt "OTHER"*)
end)
(******************************************************************************)
@@ -80,12 +84,18 @@ module D =
(******************************************************************************)
let join ty1 ty2 = match ty1, ty2 with
- | Other, Other -> Other
- | Other, (Gmp | C_type _) | (Gmp | C_type _), Other ->
- Options.fatal "[typing] join failure: integer and non integer type"
- | Gmp, _ | _, Gmp -> Gmp
+ | Nan, Nan ->
+ Nan
+ | Nan, Libr | Libr, Nan ->
+ Options.fatal "[typing] join failure: real and nan"
+ | Libr, Libr -> Libr
+ | Libr, (Gmpz | C_type _) | (Gmpz | C_type _), Libr ->
+ Libr
+ | Nan, (Gmpz | C_type _) | (Gmpz | C_type _), Nan ->
+ Options.fatal "[typing] join failure: integer and nan"
+ | Gmpz, _ | _, Gmpz -> Gmpz
| C_type i1, C_type i2 ->
- if Options.Gmp_only.get () then Gmp
+ if Options.Gmp_only.get () then Gmpz
else
let ty = Cil.arithmeticConversion (TInt(i1, [])) (TInt(i2, [])) in
match ty with
@@ -94,16 +104,19 @@ let join ty1 ty2 = match ty1, ty2 with
Options.fatal "[typing] join failure: unexpected result %a"
Printer.pp_typ ty
-exception Not_an_integer
-let typ_of_integer_ty = function
- | Gmp -> Gmpz.t ()
+exception Not_a_number
+let typ_of_number_ty = function
| C_type ik -> TInt(ik, [])
- | Other -> raise Not_an_integer
+ | Gmpz -> Gmp.z_t ()
+ | Libr -> Libr.t ()
+ | Nan -> raise Not_a_number
let typ_of_lty = function
| Ctype cty -> cty
- | Linteger -> Gmpz.t ()
- | Lreal -> Error.not_yet "real numbers"
+ | Linteger -> Gmp.z_t ()
+ | Lreal ->
+ (* TODO RATIONAL: implement this case *)
+ assert false
| Ltype _ | Lvar _ | Larrow _ -> Options.fatal "unexpected logic type"
(******************************************************************************)
@@ -169,15 +182,17 @@ end
(******************************************************************************)
let ty_of_logic_ty = function
- | Linteger -> Gmp
+ | Linteger -> Gmpz
| Ctype ty -> (match Cil.unrollType ty with
| TInt(ik, _) -> C_type ik
- | _ -> Other)
- | Lreal | Larrow _ -> Other
+ | TFloat _ -> Libr
+ | _ -> Nan)
+ | Lreal -> Libr
+ | Larrow _ -> Nan
| Ltype _ -> Error.not_yet "user-defined logic type"
| Lvar _ -> Error.not_yet "type variable"
-let integer_ty_of_typ ty = ty_of_logic_ty (Ctype ty)
+let number_ty_of_typ ty = ty_of_logic_ty (Ctype ty)
(* Compute the smallest type (bigger than [int]) which can contain the whole
interval. It is the \theta operator of the JFLA's paper. *)
@@ -187,11 +202,14 @@ let ty_of_interv ?ctx i =
(* ctx type whenever possible to prevent superfluous casts in the generated
code *)
(match ctx with
- | None | Some (Gmp | Other) -> C_type kind
+ | None | Some (Gmpz | Nan) -> C_type kind
| Some (C_type ik as ctx) ->
- if Cil.intTypeIncluded kind ik then ctx else C_type kind)
+ if Cil.intTypeIncluded kind ik then ctx else C_type kind
+ | Some Libr -> Libr)
with Cil.Not_representable ->
- Gmp
+ match ctx with
+ | Some (Libr) -> Libr
+ | None | Some _ -> Gmpz
(* compute a new {!computed_info} by coercing the given type [ty] to the given
context [ctx]. [op] is the type for the operator. *)
@@ -205,21 +223,24 @@ let coerce ~arith_operand ~ctx ~op ty =
or if the term corresponding to [ty] is an operand of an arithmetic
operation which must be explicitly coerced in order to force the
operation to be of the expected type. *)
- if (ctx = Gmp && ty <> Gmp) || arith_operand
+ if (ctx = Gmpz && ty <> Gmpz) || arith_operand
then { ty; op; cast = Some ctx }
else { ty; op; cast = None }
-(* the integer_ty corresponding to [t] whenever use as an offset.
+(* the number_ty corresponding to [t] whenever use as an offset.
In that case, it cannot be a GMP, so it must be coerced to an integral type
in that case *)
let offset_ty t =
try
let i = Interval.infer t in
match ty_of_interv i with
- | Gmp -> C_type ILongLong (* largest possible type *)
+ | Gmpz -> C_type ILongLong (* largest possible type *)
| ty -> ty
- with Interval.Not_an_integer ->
- Options.fatal "expected an integral type for %a" Printer.pp_term t
+ with
+ | Interval.Is_a_real ->
+ C_type ILongLong
+ | Interval.Not_a_number ->
+ Options.fatal "expected an integral type for %a" Printer.pp_term t
(******************************************************************************)
(** {2 Type system} *)
@@ -228,16 +249,16 @@ let offset_ty t =
(* generate a context [c]. Take --e-acsl-gmp-only into account iff [use_gmp_opt]
is true. *)
let mk_ctx ~use_gmp_opt = function
- | Other | Gmp as c -> c
- | C_type _ as c -> if use_gmp_opt && Options.Gmp_only.get () then Gmp else c
+ | C_type _ as c -> if use_gmp_opt && Options.Gmp_only.get () then Gmpz else c
+ | Gmpz | Libr | Nan as c -> c
let infer_if_integer li =
let li_t = Misc.term_of_li li in
match ty_of_logic_ty li_t.term_type with
- | C_type _ | Gmp ->
+ | C_type _ | Gmpz ->
let i = Interval.infer li_t in
Interval.Env.add li.l_var_info i
- | Other ->
+ | Libr | Nan ->
()
(* type the term [t] in a context [ctx] by taking --e-acsl-gmp-only into account
@@ -262,7 +283,11 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
(* this pattern matching implements the formal rules of the JFLA's paper
(and of course also covers the missing cases). Also enforce the invariant
that every subterm is typed, even if it is not an integer. *)
+ try
match t.term_node with
+ | TConst (LReal _) ->
+ (* TODO: real: irrationals raise not_yet *)
+ dup libr
| TConst (Integer _ | LChr _ | LEnum _)
| TSizeOf _
| TSizeOfStr _
@@ -271,8 +296,8 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
try
let i = Interval.infer t in
ty_of_interv ?ctx i
- with Interval.Not_an_integer ->
- Other
+ with Interval.Not_a_number ->
+ nan
in
dup ty
| TLval tlv ->
@@ -280,8 +305,9 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
try
let i = Interval.infer t in
ty_of_interv ?ctx i
- with Interval.Not_an_integer ->
- Other
+ with
+ | Interval.Not_a_number -> nan
+ | Interval.Is_a_real -> libr
in
type_term_lval tlv;
dup ty
@@ -294,9 +320,9 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
try
let i = Interval.infer t in
(* [t'] must be typed, but it is a pointer *)
- ignore (type_term ~use_gmp_opt:true ~ctx:Other t');
+ ignore (type_term ~use_gmp_opt:true ~ctx:nan t');
ty_of_interv ?ctx i
- with Interval.Not_an_integer ->
+ with Interval.Not_a_number ->
assert false (* this term is an integer *)
in
dup ty
@@ -306,10 +332,10 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
try
let i = Interval.infer t in
(* [t1] and [t2] must be typed, but they are pointers *)
- ignore (type_term ~use_gmp_opt:true ~ctx:Other t1);
- ignore (type_term ~use_gmp_opt:true ~ctx:Other t2);
+ ignore (type_term ~use_gmp_opt:true ~ctx:nan t1);
+ ignore (type_term ~use_gmp_opt:true ~ctx:nan t2);
ty_of_interv ?ctx i
- with Interval.Not_an_integer ->
+ with Interval.Not_a_number ->
assert false (* this term is an integer *)
in
dup ty
@@ -320,8 +346,11 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
let i = Interval.infer t in
let i' = Interval.infer t' in
compute_ctx ?ctx (Ival.join i i')
- with Interval.Not_an_integer ->
- dup Other (* real *)
+ with
+ | Interval.Not_a_number ->
+ assert false (* only Is_a_real could be raised *)
+ | Interval.Is_a_real ->
+ libr, libr
in
ignore (type_term ~use_gmp_opt:true ~arith_operand:true ~ctx t');
(match unop with
@@ -335,8 +364,11 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
let i1 = Interval.infer t1 in
let i2 = Interval.infer t2 in
compute_ctx ?ctx (Ival.join i (Ival.join i1 i2))
- with Interval.Not_an_integer ->
- dup Other (* real *)
+ with
+ | Interval.Is_a_real ->
+ dup libr
+ | Interval.Not_a_number ->
+ assert false (* only Is_a_real could be raised *)
in
(* it is enough to explicitly coerce when required one operand to [ctx]
(through [arith_operand]) in order to force the type of the operation.
@@ -360,14 +392,17 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
let i1 = Interval.infer t1 in
let i2 = Interval.infer t2 in
mk_ctx ~use_gmp_opt:true (ty_of_interv ?ctx (Ival.join i1 i2))
- with Interval.Not_an_integer ->
- Other
+ with
+ | Interval.Is_a_real ->
+ libr
+ | Interval.Not_a_number ->
+ nan
in
ignore (type_term ~use_gmp_opt:true ~ctx t1);
ignore (type_term ~use_gmp_opt:true ~ctx t2);
let ty = match ctx with
- | Other -> c_int
- | Gmp | C_type _ -> ctx
+ | Nan -> c_int
+ | Libr | Gmpz | C_type _ -> ctx
in
c_int, ty
@@ -377,8 +412,8 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
let i1 = Interval.infer t1 in
let i2 = Interval.infer t2 in
ty_of_interv ?ctx (Ival.join i1 i2)
- with Interval.Not_an_integer ->
- Other
+ with Interval.Not_a_number ->
+ nan
in
(* both operands fit in an int. *)
ignore (type_term ~use_gmp_opt:true ~ctx:c_int t1);
@@ -397,8 +432,9 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
(* nothing more to do: [i] is already more precise than what we
could infer from the arguments of the cast. *)
ty_of_interv ?ctx i
- with Interval.Not_an_integer ->
- Other
+ with
+ | Interval.Not_a_number -> nan
+ | Interval.Is_a_real -> libr
in
ignore (type_term ~use_gmp_opt:true ~ctx t');
dup ctx
@@ -415,8 +451,8 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
let i3 = Interval.infer t3 in
let ctx = ty_of_interv ?ctx (Ival.join i (Ival.join i2 i3)) in
mk_ctx ~use_gmp_opt:true ctx
- with Interval.Not_an_integer ->
- Other
+ with Interval.Not_a_number ->
+ nan
in
ignore (type_term ~use_gmp_opt:true ~ctx t2);
ignore (type_term ~use_gmp_opt:true ~ctx t3);
@@ -430,19 +466,19 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
| TStartOf tlv ->
(* it is a pointer, but subterms must be typed. *)
type_term_lval tlv;
- dup Other
+ dup nan
| Tbase_addr (_, t) ->
(* it is a pointer, but subterms must be typed. *)
- ignore (type_term ~use_gmp_opt:true ~ctx:Other t);
- dup Other
+ ignore (type_term ~use_gmp_opt:true ~ctx:nan t);
+ dup nan
| TBinOp ((PlusPI | IndexPI | MinusPI), t1, t2) ->
(* both [t1] and [t2] must be typed. *)
- ignore (type_term ~use_gmp_opt:true ~ctx:Other t1);
+ ignore (type_term ~use_gmp_opt:true ~ctx:nan t1);
let ctx = offset_ty t2 in
ignore (type_term ~use_gmp_opt:false ~ctx t2);
- dup Other
+ dup nan
| Tapp(li, _, args) ->
if Builtins.mem li.l_var_info.lv_name then
@@ -475,15 +511,18 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
match lty with
| Linteger ->
let i = Interval.infer t in
- if Options.Gmp_only.get () then dup Gmp else dup (ty_of_interv i)
+ if Options.Gmp_only.get () then dup Gmpz else dup (ty_of_interv i)
| Ctype TInt(ik, _ ) ->
dup (C_type ik)
| Ctype TFloat _ -> (* TODO: handle in MR !226 *)
- dup Other
+ (* TODO RATIONAL: re-implement this case *)
+ assert false (* dup Other *)
| Lreal ->
+ (* TODO RATIONAL: implement this case *)
Error.not_yet "real numbers"
| Ctype _ ->
- dup Other
+ (* TODO RATIONAL: re-implement this case *)
+ assert false (* dup Other *)
| Ltype _ | Lvar _ | Larrow _ ->
Options.fatal "unexpected type"
end
@@ -516,10 +555,12 @@ let rec type_term ~use_gmp_opt ?(arith_operand=false) ?ctx t =
| TUpdate (_,_,_) -> Error.not_yet "update"
| Tnull
- | TConst (LStr _ | LWStr _ | LReal _)
+ | TConst (LStr _ | LWStr _)
| Ttypeof _
| Ttype _
- | Tempty_set -> dup Other
+ | Tempty_set -> dup nan
+ with Interval.Is_a_real ->
+ Error.not_yet "reals: typing: term using unsupported construct"
in
Memo.memo
(fun t ->
@@ -536,7 +577,7 @@ and type_term_lval (host, offset) =
and type_term_lhost = function
| TVar _
| TResult _ -> ()
- | TMem t -> ignore (type_term ~use_gmp_opt:false ~ctx:Other t)
+ | TMem t -> ignore (type_term ~use_gmp_opt:false ~ctx:nan t)
and type_term_offset = function
| TNoOffset -> ()
@@ -550,7 +591,8 @@ and type_term_offset = function
let rec type_predicate p =
Cil.CurrentLoc.set p.pred_loc;
(* this pattern matching also follows the formal rules of the JFLA's paper *)
- let op = match p.pred_content with
+ let op =
+ match p.pred_content with
| Pfalse | Ptrue -> c_int
| Papp(li, _, _) ->
begin match li.l_body with
@@ -573,14 +615,15 @@ let rec type_predicate p =
let i2 = Interval.infer t2 in
let i = Ival.join i1 i2 in
mk_ctx ~use_gmp_opt:true (ty_of_interv ~ctx:c_int i)
- with Interval.Not_an_integer ->
- Other
+ with
+ | Interval.Not_a_number -> nan
+ | Interval.Is_a_real -> libr
in
ignore (type_term ~use_gmp_opt:true ~ctx t1);
ignore (type_term ~use_gmp_opt:true ~ctx t2);
(match ctx with
- | Other -> c_int
- | Gmp | C_type _ -> ctx)
+ | Nan -> c_int
+ | Libr | Gmpz | C_type _ -> ctx)
| Pand(p1, p2)
| Por(p1, p2)
| Pxor(p1, p2)
@@ -625,7 +668,7 @@ let rec type_predicate p =
in
let i = Ival.join i1 i2 in
let ctx = match x.lv_type with
- | Linteger -> mk_ctx ~use_gmp_opt:true (ty_of_interv ~ctx:Gmp i)
+ | Linteger -> mk_ctx ~use_gmp_opt:true (ty_of_interv ~ctx:Gmpz i)
| Ctype ty ->
(match Cil.unrollType ty with
| TInt(ik, _) -> mk_ctx ~use_gmp_opt:true (C_type ik)
@@ -646,8 +689,9 @@ let rec type_predicate p =
guarantee that [x] will be a GMP when typing the goal *)
let i = match ctx with
| C_type _ -> i
- | Gmp -> Ival.inject_range None None (* [ -\infty; +\infty ] *)
- | Other -> assert false
+ | Gmpz -> Ival.inject_range None None (* [ -\infty; +\infty ] *)
+ | Nan -> assert false
+ | Libr -> Error.not_yet "reals: quantification"
in
Interval.Env.add x i)
guards;
@@ -659,7 +703,7 @@ let rec type_predicate p =
| Pvalid(_, t)
| Pvalid_read(_, t)
| Pvalid_function t ->
- ignore (type_term ~use_gmp_opt:false ~ctx:Other t);
+ ignore (type_term ~use_gmp_opt:false ~ctx:nan t);
c_int
| Pforall _ -> Error.not_yet "unguarded \\forall quantification"
@@ -692,18 +736,21 @@ let unsafe_set t ?ctx ty =
(** {2 Getters} *)
(******************************************************************************)
-let get_integer_ty t = (Memo.get t).ty
+let get_number_ty t = (Memo.get t).ty
let get_integer_op t = (Memo.get t).op
let get_integer_op_of_predicate p = (type_predicate p).op
(* {!typ_of_integer}, but handle the not-integer cases. *)
let extract_typ t ty =
- try typ_of_integer_ty ty
- with Not_an_integer ->
+ try typ_of_number_ty ty
+ with Not_a_number ->
let lty = t.term_type in
match lty with
- | Ctype _ -> Logic_utils.logicCType lty
- | Ltype _ | Lvar _ | Linteger | Lreal | Larrow _ ->
+ | Ctype _ ->
+ Logic_utils.logicCType lty
+ | Lreal ->
+ Libr.t ()
+ | Ltype _ | Lvar _ | Linteger | Larrow _ ->
if Cil.isLogicRealType lty then TFloat(FLongDouble, [])
else if Cil.isLogicFloatType lty then Logic_utils.logicCType lty
else Error.not_yet "unsupported logic type"
@@ -718,13 +765,13 @@ let get_op t =
let get_cast t =
let info = Memo.get t in
- try Extlib.opt_map typ_of_integer_ty info.cast
- with Not_an_integer -> None
+ try Extlib.opt_map typ_of_number_ty info.cast
+ with Not_a_number -> None
let get_cast_of_predicate p =
let info = type_predicate p in
- try Extlib.opt_map typ_of_integer_ty info.cast
- with Not_an_integer -> assert false
+ try Extlib.opt_map typ_of_number_ty info.cast
+ with Not_a_number -> assert false
let clear = Memo.clear
diff --git a/src/plugins/e-acsl/typing.mli b/src/plugins/e-acsl/typing.mli
index a6387e848d2..1c674dca7fd 100644
--- a/src/plugins/e-acsl/typing.mli
+++ b/src/plugins/e-acsl/typing.mli
@@ -50,46 +50,50 @@ open Cil_types
(** {2 Datatypes} *)
(******************************************************************************)
-(** Possible types inferred by the system. *)
-type integer_ty = private
- | Gmp
+(** Possible types infered by the system. *)
+
+type number_ty = private
| C_type of ikind
- | Other (** Any non-integral type *)
+ | Gmpz
+ | Libr
+ | Nan
-module Datatype: Datatype.S_with_collections with type t = integer_ty
+module Datatype: Datatype.S_with_collections with type t = number_ty
(** {3 Smart constructors} *)
-val gmp: integer_ty
-val c_int: integer_ty
-val ikind: ikind -> integer_ty
-val other: integer_ty
+val c_int: number_ty
+val ikind: ikind -> number_ty
+val gmpz: number_ty
+val libr: number_ty
+val nan: number_ty
-(** {3 Useful operations over {!integer_ty}} *)
+(** {3 Useful operations over {!number_ty}} *)
-exception Not_an_integer
-val typ_of_integer_ty: integer_ty -> typ
-(** @return the C type corresponding to an {!integer_ty}. That is [Gmpz.t ()]
- for [Gmp] and [TInt(ik, [[]])] for [Ctype ik].
- @raise Not_an_integer in case of {!Other}. *)
+exception Not_a_number
+val typ_of_number_ty: number_ty -> typ
+(** @return the C type corresponding to an {!number_ty}. That is [Gmp.z_t ()]
+ for [Gmpz], [Libr.t ()] for [Libr] and [TInt(ik, [[]])] for [Ctype ik].
+ @raise Not_a_number in case of [Nan]. *)
-val integer_ty_of_typ: typ -> integer_ty
-(** Reverse of [typ_of_integer_ty] *)
+val number_ty_of_typ: typ -> number_ty
+(** Reverse of [typ_of_number_ty] *)
-val ty_of_logic_ty: logic_type -> integer_ty
+val ty_of_logic_ty: logic_type -> number_ty
(** @return the {!integer_ty} that correponds to the given logic type. *)
-val join: integer_ty -> integer_ty -> integer_ty
-(** {!integer_ty} is a join-semi-lattice if you do not consider [Other]. If
+val join: number_ty -> number_ty -> number_ty
+(** {!number_ty} is a join-semi-lattice if you do not consider [Other]. If
there is no [Other] in argument, this function computes the join of this
semi-lattice. If one of the argument is {!Other}, the function assumes that
- the other argument is also {!Other}. In this case, the result is [Other]. *)
+ the other argument is also {!Other}. In this case, the result is [Other].
+ TODO: is now extended to support reals *)
(******************************************************************************)
(** {2 Typing} *)
(******************************************************************************)
-val type_term: use_gmp_opt:bool -> ?ctx:integer_ty -> term -> unit
+val type_term: use_gmp_opt:bool -> ?ctx:number_ty -> term -> unit
(** Compute the type of each subterm of the given term in the given context. If
[use_gmp_opt] is false, then the conversion to the given context is done
even if -e-acsl-gmp-only is set. *)
@@ -107,16 +111,16 @@ val clear: unit -> unit
{!type_named_predicate} has been previously computed for the given term or
predicate. *)
-val get_integer_ty: term -> integer_ty
-(** @return the inferred type for the given term. *)
+val get_number_ty: term -> number_ty
+(** @return the infered type for the given term. *)
-val get_integer_op: term -> integer_ty
-(** @return the inferred type for the top operation of the given term.
+val get_integer_op: term -> number_ty
+(** @return the infered type for the top operation of the given term.
It is meaningless to call this function over a non-arithmetical/logical
operator. *)
-val get_integer_op_of_predicate: predicate -> integer_ty
-(** @return the inferred type for the top operation of the given predicate. *)
+val get_integer_op_of_predicate: predicate -> number_ty
+(** @return the infered type for the top operation of the given predicate. *)
val get_typ: term -> typ
(** Get the type which the given term must be generated to. *)
@@ -131,7 +135,7 @@ val get_cast: term -> typ option
val get_cast_of_predicate: predicate -> typ option
(** Like {!get_cast}, but for predicates. *)
-val unsafe_set: term -> ?ctx:integer_ty -> integer_ty -> unit
+val unsafe_set: term -> ?ctx:number_ty -> number_ty -> unit
(** Register that the given term has the given type in the given context (if
any). No verification is done. *)
@@ -139,7 +143,7 @@ val unsafe_set: term -> ?ctx:integer_ty -> integer_ty -> unit
(** {2 Typing/types-related utils} *)
(*****************************************************************************)
-val ty_of_interv: ?ctx:integer_ty -> Ival.t -> integer_ty
+val ty_of_interv: ?ctx:number_ty -> Ival.t -> number_ty
(* Compute the smallest type (bigger than [int]) which can contain the whole
interval. It is the \theta operator of the JFLA's paper. *)
--
GitLab